{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
module Graphics.Layout.Grid(Grid(..), GridItem(..), Alignment(..), Name,
        buildGrid, setCellBox, enumerate,
        gridMinWidth, gridMinHeight, gridNatWidth, gridNatHeight,
        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],
    rowMins :: [Double],
    rowNats :: [Double],
    subgridRows :: Int,
    columns :: [Either n Double],
    colMins :: [Double],
    colNats :: [Double],
    subgridColumns :: Int,
    gap :: 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,
    rowMins = [], rowNats = [],
    subgridRows = 0, -- disables
    columns = columns,
    colMins = [], colNats = [],
    subgridColumns = 0, -- disables
    gap = Size (Pixels 0) (Pixels 0)
}
-- 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'

gridMinWidth :: (n -> Double) -> Grid m n -> Double
gridMinWidth cb self@Grid { colMins = [] } =
    sum $ intersperse (cb $ inline $ gap self) [cb x | Left x <- columns self]
gridMinWidth cb self = sum $ intersperse (cb $ inline $ gap self) $ colMins self
gridMinHeight :: (m -> Double) -> Grid m n -> Double
gridMinHeight cb self@Grid { rowMins = [] } =
    sum $ intersperse (cb $ block $ gap self) [cb x | Left x <- rows self]
gridMinHeight cb self = sum $ intersperse (cb $ block $ gap self) $ rowMins self
gridNatWidth :: (n -> Double) -> Grid m n -> Double
gridNatWidth cb self@Grid { colMins = [] } =
    sum $ intersperse (cb $ inline $ gap self) [cb x | Left x <- columns self]
gridNatWidth cb self = sum $ intersperse (cb $ inline $ gap self) $ colNats self
gridNatHeight :: (m -> Double) -> Grid m n -> Double
gridNatHeight cb self@Grid { rowNats = [] } =
    sum $ intersperse (cb $ block $ gap self) [cb x | Left x <- rows self]
gridNatHeight cb self = sum $ intersperse (cb $ block $ gap self) $ rowNats self

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 = sum $ intersperse (lowerLength 0 $ inline $ gap self) maxs
  where
    maxs = gridMaxWidths zeroBox self mins nats
    mins = gridMinWidths 0 self childs
    nats = gridNatWidths 0 self childs
gridMinWidths :: Double -> Grid b Length -> [GridItem y Double] -> [Double]
gridMinWidths parent self childs = map colMinWidth $ enumerate $ columns self
  where
    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]
gridNatWidths parent self childs = map colNatWidth $ enumerate $ columns self
  where
    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]
gridMaxWidths parent self submins subnats = map (colMaxWidth fr) $ zip subwidths $ columns self
  where
    subwidths = zip submins subnats
    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]
gridWidths parent self submins subnats = map (colWidth fr) $ zip subwidths $ columns self
  where
    subwidths = zip submins subnats
    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]
gridNatHeights parent self childs = map rowNatHeight $ enumerate $ rows self
  where
    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]
gridMinHeights parent self childs = map rowMinHeight $ enumerate $ rows self
  where
    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]
gridMaxHeights parent self submins subnats = map (colMaxHeight fr) $ zip subheights $ rows self
  where
    subheights = zip submins subnats
    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]
gridHeights parent self submins subnats = map (colHeight fr) $ zip subheights $ rows self
  where
    subheights = zip submins subnats
    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',
        rowMins = rowMins', rowNats = rowNats',
        columns = map Left cols',
        colMins = colMins', colNats = colNats',
        gap = Size (lowerLength width' gapX) (lowerLength width' gapY)
      }
    Size gapX gapY = gap self

    height' = gridNatHeight (lowerLength $ block $ B.size parent) self0
    rows' = gridHeights parent self0 rowMins' rowNats'
    rowMins' = gridMinHeights width' self0 childs
    rowNats' = gridNatHeights width' self0 childs

    self0 = self {
        columns = map Left cols',
        colMins = colMins', colNats = colNats',
        gap = Size (lowerLength width' gapX) gapY
      }
    width' = gridNatWidth (lowerLength $ inline $ B.size parent) self
    cols' = gridWidths parent self 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