{-# LANGUAGE RecordWildCards, OverloadedStrings #-}
module Graphics.Layout.Grid(Grid(..), Track(..), GridItem(..), GridItem'(..), Alignment(..),
        buildTrack, buildGrid, setCellBox, enumerate, gridItemBox, cellSize,
        trackMin, trackNat, gridEstWidth, sizeTrackMins, sizeTrackNats, sizeTrackMaxs,
        trackPosition, gridPosition, trackLayout, gridLayout) where

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

import Debug.Trace (trace)

type Grid m n = Size (Track m) (Track n)
data Track x = Track {
    cells :: [Either x Double],
    trackMins :: [Double],
    trackNats :: [Double],
    gap :: x
}
type GridItem = Size GridItem' GridItem'
data GridItem' = GridItem {
    cellStart :: Int, cellEnd :: Int, alignment :: Alignment,
    minSize :: Double, natSize :: Double
}
data Alignment = Start | Mid | End

buildTrack :: CastDouble x => [Either x Double] -> Track x
buildTrack cells = Track cells [] [] $ fromDouble 0
buildGrid :: (CastDouble m, CastDouble n) =>
        [Either m Double] -> [Either n Double] -> Grid m n
buildGrid rows cols = Size (buildTrack cols) (buildTrack rows)

verifyTrack :: Track x -> [GridItem'] -> Bool
verifyTrack track cells' = and [
    cellStart cell < length (cells track) && cellStart cell >= 0 &&
    cellEnd cell < length (cells track) && cellEnd cell > cellStart cell
  | cell <- cells']
verifyGrid :: Grid m n -> [GridItem] -> Bool
verifyGrid grid cells =
    verifyTrack (inline grid) (map inline cells) && verifyTrack (block grid) (map block cells)

trackMin :: (n -> Double) -> Track n -> Double
trackMin cb self@Track { trackMins = [] } =
    sum $ intersperse (cb $ gap self) [cb x | Left x <- cells self]
trackMin cb self = sum $ intersperse (cb $ gap self) $ trackMins self
trackNat :: (n -> Double) -> Track n -> Double
trackNat cb self@Track { trackNats = [] } =
    sum $ intersperse (cb $ gap self) [cb x | Left x <- cells self]
trackNat cb self = sum $ intersperse (cb $ gap self) $ trackNats self

cellsForIndex :: [GridItem'] -> Int -> [GridItem']
cellsForIndex cells ix =
    [cell | cell <- cells, cellStart cell == ix, cellStart cell == pred (cellEnd cell)]
setCellBox :: (CastDouble m, CastDouble n) => GridItem -> PaddedBox m n -> GridItem
setCellBox (Size x y) box = Size x {
    minSize = toDouble $ inline $ B.min box,
    natSize = toDouble $ inline $ B.size box
  } y {
    minSize = toDouble $ block $ B.min box,
    natSize = toDouble $ inline $ B.size box
  }

gridEstWidth :: Grid y Length -> [GridItem] -> Double
gridEstWidth (Size cols _) childs = trackNat toDouble cols {
    trackMins = sizeTrackMins 0 cols $ map inline childs,
    trackNats = sizeTrackNats 0 cols $ map inline childs
  }
sizeTrackMins :: Double -> Track Length -> [GridItem'] -> [Double]
sizeTrackMins parent track childs = map inner $ enumerate $ cells track
  where
    inner (_, Left (Pixels x)) = x
    inner (_, Left (Percent x)) = x * parent
    inner arg@(ix, Left Preferred) =
        maximum $ (0:) $ map natSize $ cellsForIndex childs ix
    inner (ix, _) =
        maximum $ (0:) $ map minSize $ cellsForIndex childs ix
sizeTrackNats :: Double -> Track Length -> [GridItem'] -> [Double]
sizeTrackNats parent track childs = map inner $ enumerate $ cells track
  where
    inner (_, Left (Pixels x)) = x
    inner (_, Left (Percent x)) = x * parent
    inner arg@(ix, Left Min) =
        maximum $ (0:) $ map minSize $ cellsForIndex childs ix
    inner (ix, _) =
        maximum $ (0:) $ map natSize $ cellsForIndex childs ix
sizeTrackMaxs :: Double -> Track Length -> [Double]
sizeTrackMaxs parent track = map (inner fr) $ zip subsizes $ cells track
  where
    subsizes = zip (trackMins track) (trackNats track)
    fr = Prelude.max 0 fr'
    fr' = (parent - estimate)/(countFRs $ cells track)
    estimate = sum $ intersperse (lowerLength parent $ gap track) $
            map (inner 0) $ zip subsizes $ cells track
    inner _ (_, Left (Pixels x)) = x
    inner _ (_, Left (Percent x)) = x*parent
    inner _ ((_, nat), Left Preferred) = nat
    inner _ ((min, _), Left Min) = min
    inner fr ((_, nat), Left Auto) = Prelude.min nat fr
    inner fr (_, Right x) = x*fr

trackPosition :: Track Double -> [GridItem'] -> [Double]
trackPosition self childs = map gridCellPosition childs
  where
    gridCellPosition child = track (cellStart child) + align whitespace (alignment child)
      where
        whitespace = track (cellEnd child) - track (cellStart child) - natSize child
    track = flip track' $ cells 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
cellSize :: CastDouble x => Track x -> GridItem' -> Double
cellSize self child = track (cellEnd child) - track (cellStart child)
  where
    track = flip track' $ cells self
    track' ix (size:sizes) =
        (toDouble $ fromRight (fromDouble 0) size) + track' (pred ix) sizes
    track' 0 _ = 0
    track' ix [] = trace "WARNING! Malformed input table!" 0
gridItemBox :: (CastDouble x, CastDouble y) => Grid y x -> GridItem -> PaddedBox Double Double
gridItemBox (Size cols rows) cell =
    size2box (cellSize cols (inline cell) `Size` cellSize rows (block cell))
  where
    size2box size = zero { B.min = size, B.max = size, B.size = size }
gridPosition :: Grid Double Double -> [GridItem] -> [(Double, Double)]
gridPosition (Size cols rows) childs =
    trackPosition rows (map inline childs) `zip` trackPosition cols (map block childs)
trackLayout :: Double -> Double -> Track Length -> [GridItem'] ->
        (Track Double, [(Double, GridItem')])
trackLayout parent width self childs = (self', zip positions childs)
  where
    positions = trackPosition self' childs
    self' = self {
        cells = map Left sizes,
        trackMins = mins, trackNats = nats,
        gap = lowerLength width $ gap self
      }
    sizes = sizeTrackMaxs parent self { trackMins = mins, trackNats = nats }
    mins = sizeTrackMins parent self childs
    nats = sizeTrackNats parent self childs
gridLayout :: Size Double Double -> Grid Length Length -> [GridItem] ->
        (Grid Double Double, [((Double, Double), GridItem)])
gridLayout parent (Size cols rows) childs = (self', zip positions childs)
  where
    positions = gridPosition self' childs
    self' = Size cols' { gap = lowerLength width $ gap cols } rows'
    (rows', _) = trackLayout (block parent) width rows $ map block childs
    width = trackNat id cols'
    (cols', _) = trackLayout (inline parent) 0 cols $ map inline childs

enumerate = zip [0..]

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