{-# LANGUAGE OverloadedStrings #-}
module Graphics.Layout.Grid.CSS(CSSGrid(..), Axis(..), CSSCell(..), Placement(..), finalizeGrid) where

import Stylist (PropertyParser(..))
import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
import Data.Text (Text)
import qualified Data.Text as Txt
import Data.Char (isAlphaNum)
import Data.Maybe (fromMaybe)

import Graphics.Layout.CSS.Length
import Graphics.Layout.Box
import Graphics.Layout.Grid
import Graphics.Layout

data CSSGrid = CSSGrid {
    autoColumns :: Unitted,
    autoFlow :: Axis,
    autoFlowDense :: Bool,
    autoRows :: Unitted,
    templateAreas :: [[Text]],
    templateColumns :: Either [([Text], Unitted)] [[Text]],
    templateRows :: Either [([Text], Unitted)] [[Text]],
    cssGap :: Size Unitted Unitted,
    alignItems :: Size Alignment Alignment
}
data Axis = Row | Col deriving Eq
data CSSCell = CSSCell {
    columnStart :: Placement,
    columnEnd :: Placement,
    rowStart :: Placement,
    rowEnd :: Placement,
    alignSelf :: Size (Maybe Alignment) (Maybe Alignment)
}
data Placement = Autoplace | Named Text | Numbered Int (Maybe Text) |
        Span Int (Maybe Text)

instance PropertyParser CSSGrid where
    temp = CSSGrid {
        autoColumns = auto,
        autoFlow = Row,
        autoFlowDense = False,
        autoRows = auto,
        templateAreas = [],
        templateColumns = Left [],
        templateRows = Left [],
        cssGap = Size (0,"px") (0,"px"),
        alignItems = Size Start Start -- FIXME: Should be stretch, unsupported.
    }
    inherit _ = temp

    longhand _ s "grid-auto-columns" toks | Just x <- parseFR toks = Just s {autoColumns=x}
    longhand _ s "grid-auto-rows" toks | Just x <- parseFR toks = Just s {autoColumns = x}

    longhand _ self "grid-auto-flow" [Ident "row"] = Just self {
        autoFlow = Row, autoFlowDense = False
      }
    longhand _ self "grid-auto-flow" [Ident "column"] = Just self {
        autoFlow = Col, autoFlowDense = False
      }
    longhand _ self "grid-auto-flow" [Ident "row", Ident "dense"] = Just self {
        autoFlow = Row, autoFlowDense = True
      }
    longhand _ self "grid-auto-flow" [Ident "column", Ident "dense"] = Just self {
        autoFlow = Col, autoFlowDense = True
      }

    longhand _ self "grid-template-areas" [Ident "none"] = Just self {templateAreas = []}
    longhand _ self "grid-template-areas" [Ident "initial"] = Just self {templateAreas=[]}
    longhand _ self "grid-template-areas" toks
        | all isString toks, validate [Txt.words x | String x <- toks] =
            Just self { templateAreas = [Txt.words x | String x <- toks] }
      where
        isString (String _) = True
        isString _ = False
        validate grid@(row:rows) =
            all isValidName (concat grid) && all (\x -> length row == length x) rows
        validate [] = False
        isValidName name = Txt.all (\c -> isAlphaNum c || c == '-') name

    longhand _ self "grid-template-columns" toks | Just x <- parseTemplate toks =
        Just self { templateColumns = x }
    longhand _ self "grid-template-rows" toks | Just x <- parseTemplate toks =
        Just self { templateRows = x}

    longhand _ self "row-gap" toks | Just x <- parseLength toks =
        Just self { cssGap = (cssGap self) { inline = x } }
    longhand _ self "column-gap" toks | Just x <- parseLength toks =
        Just self { cssGap = (cssGap self) { block = x } }

    longhand _ self "justify-items" [Ident "start"] =
        Just self { alignItems = (alignItems self) { inline = Start } }
    longhand _ self "justify-items" [Ident "flex-start"] =
        Just self { alignItems = (alignItems self) { inline = Start } }
    longhand _ self "justify-items" [Ident "self-start"] =
        Just self { alignItems = (alignItems self) { inline = Start } }
    longhand _ self "justify-items" [Ident "left"] =
        Just self { alignItems = (alignItems self) { inline = Start } }
    longhand _ self "justify-items" [Ident "center"] =
        Just self { alignItems = (alignItems self) { inline = Mid } }
    longhand _ self "justify-items" [Ident "end"] =
        Just self { alignItems = (alignItems self) { inline = End } }
    longhand _ self "justify-items" [Ident "flex-end"] =
        Just self { alignItems = (alignItems self) { inline = End } }
    longhand _ self "justify-items" [Ident "self-end"] =
        Just self { alignItems = (alignItems self) { inline = End } }
    longhand _ self "justify-items" [Ident "right"] =
        Just self { alignItems = (alignItems self) { inline = End } }
    longhand parent self "justify-items" (Ident "unsafe":toks) =
        longhand parent self "justify-items" toks
    longhand _ self "justify-items" [Ident "normal"] = -- FIXME Should be stretch, unsupported.
        Just self { alignItems = (alignItems self) { inline = Start } }
    longhand _ self "justify-items" [Ident "initial"] = -- FIXME Should be stretch, unsupported.
        Just self { alignItems = (alignItems self) { inline = Start } }

    longhand _ self "align-items" [Ident "start"] =
        Just self { alignItems = (alignItems self) { block = Start } }
    longhand _ self "align-items" [Ident "flex-start"] =
        Just self { alignItems = (alignItems self) { block = Start } }
    longhand _ self "align-items" [Ident "self-start"] =
        Just self { alignItems = (alignItems self) { block = Start } }
    longhand _ self "align-items" [Ident "center"] =
        Just self { alignItems = (alignItems self) { block = Mid } }
    longhand _ self "align-items" [Ident "end"] =
        Just self { alignItems = (alignItems self) { block = End } }
    longhand _ self "align-items" [Ident "flex-end"] =
        Just self { alignItems = (alignItems self) { block = End } }
    longhand _ self "align-items" [Ident "self-end"] =
        Just self { alignItems = (alignItems self) { block = End } }
    longhand parent self "align-items" (Ident "unsafe":toks) =
        longhand parent self "align-items" toks
    longhand _ self "align-items" [Ident "normal"] = -- FIXME Should be stretch, unsupported.
        Just self { alignItems = (alignItems self) { block = Start } }
    longhand _ self "align-items" [Ident "initial"] = -- FIXME Should be stretch, unsupported.
        Just self { alignItems = (alignItems self) { block = Start } }

    longhand _ _ _ _ = Nothing

instance PropertyParser CSSCell where
    temp = CSSCell {
        columnStart = Autoplace,
        columnEnd = Autoplace,
        rowStart = Autoplace,
        rowEnd = Autoplace,
        alignSelf = Size Nothing Nothing
    }
    inherit _ = temp

    longhand _ self "grid-column-start" toks | Just x <- placement toks =
        Just self { columnStart = x}
    longhand _ s "grid-column-end" toks | Just x <- placement toks = Just s {columnEnd=x}
    longhand _ s "grid-row-start" toks | Just x <- placement toks = Just s {rowStart = x}
    longhand _ s "grid-row-end" toks | Just x <- placement toks = Just s { rowEnd = x }

    longhand _ self "align-self" [Ident "start"] =
        Just self { alignSelf = (alignSelf self) { block = Just Start } }
    longhand _ self "align-self" [Ident "self-start"] =
        Just self { alignSelf = (alignSelf self) { block = Just Start } }
    longhand _ self "align-self" [Ident "flex-start"] =
        Just self { alignSelf = (alignSelf self) { block = Just Start } }
    longhand _ self "align-self" [Ident "center"] =
        Just self { alignSelf = (alignSelf self) { block = Just Mid } }
    longhand _ self "align-self" [Ident "end"] =
        Just self { alignSelf = (alignSelf self) { block = Just End } }
    longhand _ self "align-self" [Ident "self-end"] =
        Just self { alignSelf = (alignSelf self) { block = Just End } }
    longhand _ self "align-self" [Ident "flex-end"] =
        Just self { alignSelf = (alignSelf self) { block = Just End } }
    longhand _ self "align-self" [Ident "normal"] = -- FIXME should be stretch, unsupported
        Just self { alignSelf = (alignSelf self) { block = Just Start } }
    longhand parent self "align-self" (Ident "unsafe":toks) =
        longhand parent self "align-self" toks
    longhand _ self "align-self" [Ident "auto"] =
        Just self { alignSelf = (alignSelf self) { block = Nothing } }
    longhand _ self "align-self" [Ident "initial"] =
        Just self { alignSelf = (alignSelf self) { block = Nothing } }

    longhand _ self "justify-self" [Ident "start"] =
        Just self { alignSelf = (alignSelf self) { inline = Just Start } }
    longhand _ self "justify-self" [Ident "self-start"] =
        Just self { alignSelf = (alignSelf self) { inline = Just Start } }
    longhand _ self "justify-self" [Ident "flex-start"] =
        Just self { alignSelf = (alignSelf self) { inline = Just Start } }
    longhand _ self "justify-self" [Ident "left"] =
        Just self { alignSelf = (alignSelf self) { inline = Just Start } }
    longhand _ self "justify-self" [Ident "center"] =
        Just self { alignSelf = (alignSelf self) { inline = Just Mid } }
    longhand _ self "justify-self" [Ident "end"] =
        Just self { alignSelf = (alignSelf self) { inline = Just End } }
    longhand _ self "justify-self" [Ident "self-end"] =
        Just self { alignSelf = (alignSelf self) { inline = Just End } }
    longhand _ self "justify-self" [Ident "flex-end"] =
        Just self { alignSelf = (alignSelf self) { inline = Just End } }
    longhand _ self "justify-self" [Ident "right"] =
        Just self { alignSelf = (alignSelf self) { inline = Just End } }
    longhand _ self "justify-self" [Ident "normal"] = -- FIXME should be stretch, unsupported
        Just self { alignSelf = (alignSelf self) { inline = Just Start } }
    longhand parent self "justify-self" (Ident "unsafe":toks) =
        longhand parent self "justify-self" toks
    longhand _ self "justify-self" [Ident "auto"] =
        Just self { alignSelf = (alignSelf self) { inline = Nothing } }
    longhand _ self "justify-self" [Ident "initial"] =
        Just self { alignSelf = (alignSelf self) { inline = Nothing } }

    longhand _ _ _ _ = Nothing

parseFR [Dimension _ x "fr"] = Just (n2f x,"fr")
parseFR toks = parseLength toks
parseFR' [Dimension _ x "fr"] = Just (n2f x,"fr")
parseFR' toks = parseLength' toks

placement [Ident "auto"] = Just $ Autoplace
placement [Ident x] = Just $ Named x
placement [Number _ (NVInteger x)] = Just $ Numbered (fromEnum x) Nothing
placement [Number _ (NVInteger x), Ident y] = Just $ Numbered (fromEnum x) (Just y)
placement [Ident "span", Number _ (NVInteger x)]
    | x > 0 = Just $ Span (fromEnum x) Nothing
placement [Ident "span", Ident x] = Just $ Span 1 $ Just x
placement [Ident "span", Number _ (NVInteger x), Ident y]
    | x > 0 = Just $ Span (fromEnum x) (Just y)
placement [Ident "span", Ident y, Number _ (NVInteger x)]
    | x > 0 = Just $ Span (fromEnum x) (Just y)
placement _ = Nothing

parseTemplate [Ident "none"] = Just $ Left []
parseTemplate [Ident "initial"] = Just $ Left []
parseTemplate toks | (tracks@(_:_), []) <- parseTrack toks = Just $ Left tracks
parseTemplate (Ident "subgrid":toks)
    | (names@(_:_), []) <- parseSubgrid toks = Just $ Right names
parseTemplate _ = Nothing
parseTrack (LeftSquareBracket:toks)
    | Just (names', toks') <- parseNames toks,
        ((names,size):cells,toks) <- parseTrack toks' = ((names' ++ names,size):cells,toks)
    | Just (names', toks') <- parseNames toks = ([(names',(0,"end"))],toks')
parseTrack (tok:toks) | Just x <- parseFR' [tok] =
    (([], x):fst (parseTrack toks), snd $ parseTrack toks)
parseTrack (Function "repeat":Number _ (NVInteger x):Comma:toks)
    | x > 0, (tracks@(_:_), RightParen:toks') <- parseTrack toks =
        (concat $ replicate (fromEnum x) tracks, toks')
parseTrack toks = ([], toks)
parseSubgrid (LeftSquareBracket:toks)
    | Just (names', toks') <- parseNames toks, (names,toks'') <- parseSubgrid toks' =
        (names' : names, toks')
parseSubgrid (Function "repeat":Number _ (NVInteger x):Comma:toks)
    | x > 0, (names@(_:_), RightParen:toks') <- parseSubgrid toks =
        (concat $ replicate (fromEnum x) names, toks')
parseSubgrid toks = ([], toks)
parseNames (Ident x:toks)
    | Just (names,toks') <- parseNames toks = Just (x:names,toks')
parseNames (RightSquareBracket:toks) = Just ([], toks)
parseNames _ = Nothing

finalizeGrid :: PropertyParser x => CSSGrid -> Font' ->
    [CSSCell] -> [LayoutItem Length Length x] -> LayoutItem Length Length x
finalizeGrid self@CSSGrid {
        templateColumns = Left cols', templateRows = Left rows'
    } font cells childs = LayoutGrid temp self' cells' childs
  where
    self' = Grid {
        rows = map finalizeFR $ map snd rows0,
        rowMins = [], rowNats = [],
        subgridRows = 0, -- disable
        columns = map finalizeFR $ map snd cols0,
        colMins = [], colNats = [],
        subgridColumns = 0, -- disable
        gap = Size (finalizeLength (inline $ cssGap self) font)
            (finalizeLength (block $ cssGap self) font)
    }

    (cells', rows0, cols0) = finalizeCells cells rows' cols'
    finalizeCells :: [CSSCell] -> [([Text], Unitted)] -> [([Text], Unitted)] ->
            ([GridItem Length Length], [([Text], Unitted)], [([Text], Unitted)])
    finalizeCells (cell:cells) rows cols = (cell':cells', rows_, cols_)
      where
        (cell', rows0, cols0) = finalizeCell cell rows cols
        (cells', rows_, cols_) = finalizeCells cells rows0 cols0
    finalizeCells [] rows cols = ([], rows, cols)
    finalizeCell :: CSSCell -> [([Text], Unitted)] -> [([Text], Unitted)] ->
            (GridItem Length Length, [([Text], Unitted)], [([Text], Unitted)])
    finalizeCell cell@CSSCell {
            rowStart = Autoplace, columnStart = Autoplace
        } rows cols | autoFlow self == Row =
            finalizeCell cell { columnStart = Numbered 1 Nothing } rows cols
        | autoFlow self == Col =
            finalizeCell cell { rowStart = Numbered 1 Nothing } rows cols
    finalizeCell cell rows cols = (GridItem {
            startRow = startRow', endRow = endRow',
            startCol = startCol', endCol = endCol',
            gridItemBox = lengthBox,
            alignment = Size
                (fromMaybe (inline $ alignItems self) (inline $ alignSelf cell))
                (fromMaybe (inline $ alignItems self) (inline $ alignSelf cell))
        }, rows', cols')
      where
        (startRow', endRow', rows') = lowerTrack2 rows ([], autoRows self)
                (rowStart cell) (rowEnd cell)
        (startCol', endCol', cols') = lowerTrack2 cols ([], autoColumns self) 
                (columnStart cell) (columnEnd cell)

    lowerTrack2 tracks auto start Autoplace = lowerTrack2 tracks auto start $ Span 1 Nothing
    lowerTrack2 tracks auto start@(Span _ _) end@(Span _ _) =
        lowerTrack2 tracks auto start $ Numbered (pred $ length tracks) Nothing
    lowerTrack2 tracks auto start@(Span _ _) end = (start', end', tracks')
      where
        (end', tracks0) = lowerTrack tracks auto 0 end -- Already checked for spans.
        (start', tracks') = lowerTrack tracks auto (negate end') start
    lowerTrack2 tracks auto start end = (start', end', tracks')
      where
        (start', tracks0) = lowerTrack tracks auto 0 start -- already checked for spans.
        (end', tracks') = lowerTrack tracks auto start' end
    lowerTrack tracks auto _ (Named name)
        | ix:_ <- [ix | (ix, (names, _)) <- enumerate tracks, name `elem` names] = (ix, tracks)
        | otherwise = (length tracks, tracks ++ [auto])

    -- TODO Take into account placement strategy.
    lowerTrack tracks auto _ Autoplace = (length tracks, tracks ++ [auto])
    lowerTrack tracks _ _ (Numbered ix Nothing) = (ix, tracks)
    lowerTrack tracks auto _ (Numbered ix (Just name))
        | ix < length tracks' = (tracks' !! ix, tracks)
        | otherwise = (length tracks, tracks ++ [auto])
      where tracks' = [ix | (ix, (names, _)) <- enumerate tracks, name `elem` names]
    lowerTrack tracks _ start (Span x Nothing)
        | start > 0 = (start + x,tracks)
        | otherwise = (-start - x,tracks)
    lowerTrack tracks (_, auto) start (Span x (Just name)) = (tracks' !! x,tracks)
      where
        tracks0 | start < 0 = reverse tracks
            | otherwise = tracks
        tracks' = [ix | (ix, (names, _)) <-
            drop (abs start) $ enumerate (tracks0 ++ repeat ([name],auto)),
            name `elem` names]

    finalizeFR (x,"fr") = Right x
    finalizeFR x = Left $ finalizeLength x font
finalizeGrid self@CSSGrid { templateColumns = Right colnames } font cells childs =
    LayoutGrid val' self' { subgridColumns = length colnames } cells' childs'
  where
    LayoutGrid val' self' cells' childs' = finalizeGrid self {
        templateColumns = Left $ zip colnames $ repeat (1,"fr")
      } font cells childs
finalizeGrid self@CSSGrid { templateRows = Right rownames } font cells childs =
    LayoutGrid val' self' { subgridRows = length rownames } cells' childs'
  where
    LayoutGrid val' self' cells' childs' = finalizeGrid self {
        templateRows = Left $ zip rownames $ repeat (1,"fr")
      } font cells childs