{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
module Graphics.Layout.Grid(Grid(..), GridItem(..), Alignment(..), Name,
        buildGrid, setCellBox, enumerate,
        gridEstWidth, gridNatWidths, gridMinWidths, gridMaxWidths, gridWidths,
        gridNatHeights, gridMinHeights, gridMaxHeights, gridHeights,
        gridPosition, gridLayout) where

import Data.Either (fromRight)
import Data.Text (Text)
import Data.List (intersperse)
import Graphics.Layout.Box as B

import Debug.Trace (trace)

-- TODO implement subgrid support...
data Grid m n = Grid {
    rows :: [Either m Double],
    rowBounds :: [(Double, Double)],
    subgridRows :: Int,
    columns :: [Either n Double],
    colBounds :: [(Double, Double)],
    subgridColumns :: Int,
    gap :: Size m n,
    containerSize :: Size m n, -- wrap in a Flow box to get padding, etc.
    containerMin :: Size m n,
    containerMax :: Size m n
}
data GridItem m n = GridItem {
    startRow :: Int, endRow :: Int, startCol :: Int, endCol :: Int,
    alignment :: Size Alignment Alignment,
    gridItemBox :: PaddedBox m n
}
data Alignment = Start | Mid | End

type Name = Text

buildGrid rows columns = Grid {
    rows = rows,
    rowBounds = [],
    subgridRows = 0, -- disables
    columns = columns,
    colBounds = [],
    subgridColumns = 0, -- disables
    gap = Size (Pixels 0) (Pixels 0),
    containerSize = Size Auto Auto,
    containerMin = Size Auto Auto,
    containerMax = Size Auto Auto
}
-- Created to address typesystem issues with record syntax.
setCellBox :: PaddedBox mm nn -> GridItem m n -> GridItem mm nn
setCellBox box' GridItem {..} = GridItem startRow endRow startCol endCol alignment box'

cellsForCol :: [GridItem y x] -> Int -> [GridItem y x]
cellsForCol cells ix =
    [cell | cell <- cells, startCol cell == ix, startCol cell == pred (endCol cell)]
cellsForRow :: [GridItem y x] -> Int -> [GridItem y x]
cellsForRow cells ix =
    [cell | cell <- cells, startRow cell == ix, startRow cell == pred (endRow cell)]
verifyGrid self childs = and [
    startRow < width && startRow >= 0 && endRow < width && endRow >= 0 &&
    endCol > startCol && endRow > startRow &&
    startCol < height && startCol >= 0 && endCol < height && endCol >= 0 |
    GridItem {..} <- childs]
  where
    width = length $ columns self
    height = length $ rows self

gridEstWidth :: Grid b Length -> [GridItem y Double] -> Double
gridEstWidth self childs = fst $ gridMaxWidths zeroBox self $ zip mins nats
  where
    mins = snd $ gridMinWidths 0 self childs
    nats = snd $ gridNatWidths 0 self childs
gridMinWidths :: Double -> Grid b Length -> [GridItem y Double] -> (Double, [Double])
gridMinWidths parent self childs =
    (sum $ intersperse (lowerLength parent $ inline $ gap self) ret, ret)
  where
    ret = map colMinWidth $ enumerate $ columns self
    colMinWidth (_, Left (Pixels x)) = x
    colMinWidth (_, Left (Percent x)) = x * parent
    colMinWidth arg@(ix, Left Preferred) =
        maximum $ (0:) $ map (inline . size . gridItemBox) $ cellsForCol childs ix
    colMinWidth (ix, _) =
        maximum $ (0:) $ map (inline . B.min . gridItemBox) $ cellsForCol childs ix
gridNatWidths :: Double -> Grid b Length -> [GridItem y Double] -> (Double, [Double])
gridNatWidths parent self childs =
    (sum $ intersperse (lowerLength parent $ inline $ gap self) ret, ret)
  where
    ret = map colNatWidth $ enumerate $ columns self
    colNatWidth (_, Left (Pixels x)) = x
    colNatWidth (_, Left (Percent x)) = x * parent
    colNatWidth arg@(ix, Left Min) =
        maximum $ (0:) $ map (inline . B.min . gridItemBox) $ cellsForCol childs ix
    colNatWidth (ix, _) =
        maximum $ (0:) $ map (inline . size . gridItemBox) $ cellsForCol childs ix
gridMaxWidths :: PaddedBox b Double -> Grid y Length -> [(Double, Double)] -> (Double, [Double])
gridMaxWidths parent self subwidths =
    (sum $ intersperse (lowerLength outerwidth $ inline $ gap self) ret, ret)
  where
    ret = map (colMaxWidth fr) $ zip subwidths $ columns self
    fr = Prelude.max 0 fr'
    fr' = (outerwidth - estimate)/(countFRs $ columns self)
    outerwidth = inline $ size parent
    estimate = sum $ intersperse (lowerLength outerwidth $ inline $ gap self) $
        map (colMaxWidth 0) $ zip subwidths $ columns self
    colMaxWidth _ (_, Left (Pixels x)) = x
    colMaxWidth _ (_, Left (Percent x)) = x*(inline $ size parent)
    colMaxWidth _ ((_, nat), Left Preferred) = nat
    colMaxWidth _ ((min, _), Left Min) = min
    colMaxWidth fr (_, Left Auto) = fr
    colMaxWidth fr (_, Right x) = x*fr
gridWidths :: PaddedBox b Double -> Grid y Length -> [(Double, Double)] -> (Double, [Double])
gridWidths parent self subwidths =
    (sum $ intersperse (lowerLength outerwidth $ inline $ gap self) ret, ret)
  where
    ret = map (colWidth fr) $ zip subwidths $ columns self
    fr = (outerwidth - estimate)/(countFRs $ columns self)
    outerwidth = inline $ size parent
    estimate = sum $ intersperse (lowerLength outerwidth $ inline $ gap self) $
        map (colWidth 0) $ zip subwidths $ columns self
    colWidth fr ((min, nat), size) = Prelude.max min $ colWidth' fr ((min, nat), size)
    colWidth' _ (_, Left (Pixels x)) = x
    colWidth' _ (_, Left (Percent x)) = x*(inline $ size parent)
    colWidth' _ ((_, nat), Left Preferred) = nat
    colWidth' _ ((min, _), Left Min) = min
    colWidth' fr ((_, nat), Left Auto) = Prelude.min nat fr
    colWidth' fr (_, Right x) = x*fr

gridNatHeights :: Double -> Grid Length Double -> [GridItem Double Double] -> (Double, [Double])
gridNatHeights parent self childs =
    (sum $ intersperse (lowerLength parent $ block $ gap self) ret, ret)
  where
    ret = map rowNatHeight $ enumerate $ rows self
    rowNatHeight (_, Left (Pixels x)) = x
    rowNatHeight (_, Left (Percent x)) = x * parent
    rowNatHeight arg@(ix, Left Min) =
        maximum $ (0:) $ map (block . B.min . gridItemBox) $ cellsForCol childs ix
    rowNatHeight (ix, _) =
        maximum $ (0:) $ map (block . size . gridItemBox) $ cellsForCol childs ix
gridMinHeights :: Double -> Grid Length Double -> [GridItem Double Double] -> (Double, [Double])
gridMinHeights parent self childs =
    (sum $ intersperse (lowerLength parent $ block $ gap self) ret, ret)
  where
    ret = map rowMinHeight $ enumerate $ rows self
    rowMinHeight (_, Left (Pixels x)) = x
    rowMinHeight (_, Left (Percent x)) = x * parent
    rowMinHeight arg@(ix, Left Preferred) =
        maximum $ (0:) $ map (block . size . gridItemBox) $ cellsForCol childs ix
    rowMinHeight (ix, _) =
        maximum $ (0:) $ map (block . B.min . gridItemBox) $ cellsForCol childs ix
gridMaxHeights :: PaddedBox Double Double -> Grid Length Double ->
    [(Double, Double)] -> (Double, [Double])
gridMaxHeights parent self subheights = (sum $ intersperse (inline $ gap self) ret, ret)
  where
    ret = map (colMaxHeight fr) $ zip subheights $ rows self
    fr = (outerheight - estimate)/(countFRs $ rows self)
    outerwidth = inline $ size parent
    outerheight = block $ size parent
    estimate = sum $ intersperse (inline $ gap self) $
        map (colMaxHeight 0) $ zip subheights $ rows self
    colMaxHeight _ (_, Left (Pixels x)) = x
    colMaxHeight _ (_, Left (Percent x)) = x*outerwidth
    colMaxHeight _ ((_, nat), Left Preferred) = nat
    colMaxHeight _ ((min, _), Left Min) = min
    colMaxHeight fr (_, Left Auto) = fr
    colMaxHeight fr (_, Right x) = x*fr
gridHeights :: PaddedBox Double Double -> Grid Length Double ->
    [(Double, Double)] -> (Double, [Double])
gridHeights parent self subheights = (sum $ intersperse (inline $ gap self) ret, ret)
  where
    ret = map (colHeight fr) $ zip subheights $ rows self
    fr = (outerheight - estimate)/(countFRs $ rows self)
    outerwidth = inline $ size parent
    outerheight = block $ size parent
    estimate = sum $ intersperse (inline $ gap self) $
        map (colHeight 0) $ zip subheights $ rows self
    colHeight fr ((min, nat), size) = Prelude.max min $ colHeight' fr ((min, nat), size)
    colHeight' _ (_, Left (Pixels x)) = x
    colHeight' _ (_, Left (Percent x)) = x*outerwidth
    colHeight' _ ((_, nat), Left Preferred) = nat
    colHeight' _ ((min, _), Left Min) = min
    colHeight' fr ((min, nat), Left Auto) = Prelude.min fr nat
    colHeight' fr (_, Right x) = x*fr

gridPosition :: Grid Double Double -> [GridItem Double Double] -> [Size Double Double]
gridPosition self childs = map gridCellPosition childs
  where
    gridCellPosition child =
        Size (x + align extraWidth alignX) (y + align extraHeight alignY)
      where
        Size x y = gridCellPosition' child
        Size alignX alignY = alignment child
        width = track (endCol child) (columns self) - track (startCol child) (columns self)
        height = track (endRow child) (rows self) - track (startRow child) (columns self)
        extraWidth = width - inline (size $ gridItemBox child)
        extraHeight = height - block (size $ gridItemBox child)
    gridCellPosition' child =
        Size (startCol child `track` columns self) (startRow child `track` rows self)
    track ix (size:sizes) = fromRight 0 size + track (pred ix) sizes
    track 0 _ = 0
    track ix [] = trace "WARNING! Malformed input table!" 0
    align _ Start = 0
    align excess Mid = excess/2
    align excess End = excess
gridLayout :: PaddedBox Double Double -> Grid Length Length ->
        [GridItem Double Double] -> Bool ->
        (Grid Double Double, [(Size Double Double, GridItem Double Double)])
gridLayout parent self childs paginate = (self', zip positions childs)
  where
    positions = gridPosition self' childs
    self' = self {
        rows = map Left rows',
        rowBounds = rowBounds',
        columns = map Left cols',
        colBounds = colBounds',
        gap = Size (lowerLength width' gapX) (lowerLength width' gapY),
        containerSize = Size width' height',
        containerMin = Size width' height',
        containerMax = Size width' height'
      }
    Size gapX gapY = gap self

    (height', rows') = gridHeights parent self0 rowBounds'
    rowBounds' = zip rowMins rowNats
    (_, rowMins) = gridMinHeights width' self0 childs
    (_, rowNats) = gridNatHeights width' self0 childs

    self0 = self {
        columns = map Left cols',
        colBounds = colBounds',
        gap = Size (lowerLength width' gapX) gapY,
        containerSize = let Size _ y = containerSize self in Size width' y,
        containerMin = let Size _ y = containerSize self in Size width' y,
        containerMax = let Size _ y = containerSize self in Size width' y
      }
    (width', cols') = gridWidths parent self colBounds'
    colBounds' = zip colMins colNats
    (_, colMins) = gridMinWidths estWidth self childs
    (_, colNats) = gridNatWidths estWidth self childs
    estWidth = gridEstWidth self childs

enumerate = zip [0..]

countFRs (Left Auto:rest) = succ $ countFRs rest
countFRs (Right x:rest) = x + countFRs rest
countFRs (_:rest) = countFRs rest
countFRs [] = 0