{-# LANGUAGE OverloadedStrings, ViewPatterns #-}
module Graphics.Layout.Grid.Table where

import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
import Stylist (PropertyParser(..))
import Graphics.Layout.CSS.Length (Unitted, parseLength, Font', finalizeLength)
import Graphics.Layout.Box (Length(..), PaddedBox(..), zero, mapX, mapY)
import Graphics.Layout.Grid (Alignment(..))
import Data.Text.Glyphize (Direction(..))
import Data.Text.ParagraphLayout.Rich (
        ParagraphOptions(..), ParagraphAlignment(..))

import Text.Read (readMaybe)
import Data.Text (unpack)

type Overflowed = [Int]

emptyRow :: Overflowed
emptyRow = []

commitRow :: Overflowed -> Overflowed
commitRow = map $ Prelude.max 0 . pred

allocCol :: Int -> Overflowed -> Int
allocCol ix cols = ix + length (span (> 0) $ drop ix cols)

insertCell :: Int -> Int -> Int -> Overflowed -> Overflowed
insertCell ix colspan rowspan cols =
    before ++ replicate colspan rowspan ++ drop colspan after
  where (before, after) = splitAt ix cols

data TableOptions = TableOptions {
    -- | HTML rowspan attribute
    rowspan :: Int,
    -- | HTML colspan attribute
    colspan :: Int,
    -- | Parsed CSS caption-side.
    captionBelow :: Bool,
    -- | Parsed CSS border-collapse
    borderCollapse :: Bool,
    -- | Semi-parsed border-spacing, horizontal axis
    borderHSpacing :: Unitted,
    -- | Semi-parsed border-spacing, vertical axis
    borderVSpacing :: Unitted,
    -- TODO: Implement `table-layout: fixed`, that needs its own layout formula...
    -- | Parsed CSS vertical-align
    verticalAlign :: Unitted
}

instance PropertyParser TableOptions where
    temp = TableOptions {
        rowspan = 1, colspan = 1,
        captionBelow = False, borderCollapse = False,
        borderHSpacing = (0,"px"), borderVSpacing = (0,"px"),
        verticalAlign = (0,"baseline")
    }
    inherit = id

    longhand _ self "-argo-rowspan" [Ident "initial"] = Just self { rowspan = 1 }
    longhand _ self "-argo-rowspan" [String x]
        | Just y <- readMaybe $ unpack x, y >= 1 = Just self { rowspan = y }
    longhand _ self "-argo-rowspan" [Number _ (NVInteger x)]
        | x >= 1 = Just self { rowspan = fromEnum x }
    longhand _ self "-argo-colspan" [Ident "initial"] = Just self { colspan = 1 }
    longhand _ self "-argo-colspan" [String x]
        | Just y <- readMaybe $ unpack x, y >= 1 = Just self { colspan = y }
    longhand _ self "-argo-colspan" [Number _ (NVInteger x)]
        | x >= 1 = Just self { colspan = fromEnum x }

    longhand _ self "caption-side" [Ident "top"] = Just self { captionBelow = False }
    longhand _ self "caption-side" [Ident "bottom"] = Just self { captionBelow = True }
    longhand _ self "caption-side" [Ident "initial"] = Just self {captionBelow = False}

    longhand _ self "border-collapse" [Ident "collapse"] =
        Just self { borderCollapse = True }
    longhand _ self "border-collapse" [Ident "separate"] =
        Just self { borderCollapse = False }
    longhand _ self "border-collapse" [Ident "initial"] =
        Just self { borderCollapse = False }

    longhand _ self "border-spacing" v@[Dimension _ _ _] | Just x <- parseLength v =
        Just self { borderHSpacing = x, borderVSpacing = x }
    longhand _ self "border-spacing" [x@(Dimension _ _ _), y@(Dimension _ _ _)]
            | Just x' <- parseLength [x], Just y' <- parseLength [y] =
        Just self { borderHSpacing = x', borderVSpacing = y' }
    longhand _ self "border-spacing" [Ident "initial"] =
        Just self { borderHSpacing = (0,"px"), borderVSpacing = (0,"px") }

    longhand _ self "vertical-align" [Ident x]
        | x `elem` ["baseline", "sub", "super", "text-top", "text-bottom",
            "middle", "top", "bottom"] = Just self { verticalAlign = (0,x) }
        | x == "initial" = Just self { verticalAlign = (0,"baseline") }
        | otherwise = Nothing
    longhand _ self "vertical-align" v | Just x <- parseLength v =
        Just self { verticalAlign = x }

    longhand _ _ _ _ = Nothing

finalizeGap :: TableOptions -> Font' -> (Length, Length)
finalizeGap TableOptions { borderCollapse = True } _ = (Pixels 0, Pixels 0)
finalizeGap TableOptions { borderHSpacing = x, borderVSpacing = y } font =
    (finalizeLength x font, finalizeLength y font)

type UPaddedBox = PaddedBox Unitted Unitted
collapseBorders :: TableOptions -> UPaddedBox -> UPaddedBox
collapseBorders TableOptions { borderCollapse = False } ret = ret
collapseBorders _ box = box {
    margin = zero,
    border = mapX half $ mapY half $ border box
  }
collapseTBorders :: TableOptions -> UPaddedBox -> UPaddedBox
collapseTBorders TableOptions { borderCollapse = False } ret = ret
collapseTBorders _ box = box {
    padding = zero,
    border = mapX half $ mapY half $ border box
  }
half (x,u) = (x/2,u)

finalizeVAlign :: TableOptions -> Alignment
finalizeVAlign TableOptions { verticalAlign = (_,"top") } = Start
finalizeVAlign TableOptions { verticalAlign = (_,"middle") } = Mid
finalizeVAlign TableOptions { verticalAlign = (_,"bottom") } = End
finalizeVAlign _ = Start -- FIXME: Support baseline alignment!
finalizeHAlign :: ParagraphOptions -> Direction -> Alignment
finalizeHAlign (paragraphAlignment -> AlignStart) _ = Start
finalizeHAlign (paragraphAlignment -> AlignEnd) _ = End
finalizeHAlign (paragraphAlignment -> AlignLeft) DirLTR = Start
finalizeHAlign (paragraphAlignment -> AlignLeft) _ = End
finalizeHAlign (paragraphAlignment -> AlignRight) DirLTR = End
finalizeHAlign (paragraphAlignment -> AlignRight) _ = Start
finalizeHAlign (paragraphAlignment -> AlignCentreH) _ = Mid