{-# 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 :: [Int]
emptyRow = []
commitRow :: Overflowed -> Overflowed
commitRow :: [Int] -> [Int]
commitRow = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
Prelude.max Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> a
pred
allocCol :: Int -> Overflowed -> Int
allocCol :: Int -> [Int] -> Int
allocCol Int
ix [Int]
cols = Int
ix forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
ix [Int]
cols)
insertCell :: Int -> Int -> Int -> Overflowed -> Overflowed
insertCell :: Int -> Int -> Int -> [Int] -> [Int]
insertCell Int
ix Int
colspan Int
rowspan [Int]
cols = [Int]
before forall a. [a] -> [a] -> [a]
++ Int -> [Int] -> [Int]
inner Int
colspan [Int]
after
where
([Int]
before, [Int]
after) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
ix [Int]
cols
inner :: Int -> [Int] -> [Int]
inner Int
x [Int]
cols' | Int
x forall a. Ord a => a -> a -> Bool
<= Int
0 = [Int]
cols'
inner Int
colspan (Int
col:[Int]
cols') = forall a. Ord a => a -> a -> a
Prelude.max Int
col Int
rowspanforall a. a -> [a] -> [a]
:Int -> [Int] -> [Int]
inner (forall a. Enum a => a -> a
pred Int
colspan) [Int]
cols'
inner Int
x [] = forall a. Int -> a -> [a]
replicate Int
x Int
colspan
data TableOptions = TableOptions {
TableOptions -> Int
rowspan :: Int,
TableOptions -> Int
colspan :: Int,
TableOptions -> Bool
captionBelow :: Bool,
TableOptions -> Bool
borderCollapse :: Bool,
TableOptions -> Unitted
borderHSpacing :: Unitted,
TableOptions -> Unitted
borderVSpacing :: Unitted,
TableOptions -> Unitted
verticalAlign :: Unitted
}
instance PropertyParser TableOptions where
temp :: TableOptions
temp = TableOptions {
rowspan :: Int
rowspan = Int
1, colspan :: Int
colspan = Int
1,
captionBelow :: Bool
captionBelow = Bool
False, borderCollapse :: Bool
borderCollapse = Bool
False,
borderHSpacing :: Unitted
borderHSpacing = (Double
0,Text
"px"), borderVSpacing :: Unitted
borderVSpacing = (Double
0,Text
"px"),
verticalAlign :: Unitted
verticalAlign = (Double
0,Text
"baseline")
}
inherit :: TableOptions -> TableOptions
inherit = forall a. a -> a
id
longhand :: TableOptions
-> TableOptions -> Text -> [Token] -> Maybe TableOptions
longhand TableOptions
_ TableOptions
self Text
"-argo-rowspan" [Ident Text
"initial"] = forall a. a -> Maybe a
Just TableOptions
self { rowspan :: Int
rowspan = Int
1 }
longhand TableOptions
_ TableOptions
self Text
"-argo-rowspan" [String Text
x]
| Just Int
y <- forall a. Read a => String -> Maybe a
readMaybe forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
x, Int
y forall a. Ord a => a -> a -> Bool
>= Int
1 = forall a. a -> Maybe a
Just TableOptions
self { rowspan :: Int
rowspan = Int
y }
longhand TableOptions
_ TableOptions
self Text
"-argo-rowspan" [Number Text
_ (NVInteger Integer
x)]
| Integer
x forall a. Ord a => a -> a -> Bool
>= Integer
1 = forall a. a -> Maybe a
Just TableOptions
self { rowspan :: Int
rowspan = forall a. Enum a => a -> Int
fromEnum Integer
x }
longhand TableOptions
_ TableOptions
self Text
"-argo-colspan" [Ident Text
"initial"] = forall a. a -> Maybe a
Just TableOptions
self { colspan :: Int
colspan = Int
1 }
longhand TableOptions
_ TableOptions
self Text
"-argo-colspan" [String Text
x]
| Just Int
y <- forall a. Read a => String -> Maybe a
readMaybe forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
x, Int
y forall a. Ord a => a -> a -> Bool
>= Int
1 = forall a. a -> Maybe a
Just TableOptions
self { colspan :: Int
colspan = Int
y }
longhand TableOptions
_ TableOptions
self Text
"-argo-colspan" [Number Text
_ (NVInteger Integer
x)]
| Integer
x forall a. Ord a => a -> a -> Bool
>= Integer
1 = forall a. a -> Maybe a
Just TableOptions
self { colspan :: Int
colspan = forall a. Enum a => a -> Int
fromEnum Integer
x }
longhand TableOptions
_ TableOptions
self Text
"caption-side" [Ident Text
"top"] = forall a. a -> Maybe a
Just TableOptions
self { captionBelow :: Bool
captionBelow = Bool
False }
longhand TableOptions
_ TableOptions
self Text
"caption-side" [Ident Text
"bottom"] = forall a. a -> Maybe a
Just TableOptions
self { captionBelow :: Bool
captionBelow = Bool
True }
longhand TableOptions
_ TableOptions
self Text
"caption-side" [Ident Text
"initial"] = forall a. a -> Maybe a
Just TableOptions
self {captionBelow :: Bool
captionBelow = Bool
False}
longhand TableOptions
_ TableOptions
self Text
"border-collapse" [Ident Text
"collapse"] =
forall a. a -> Maybe a
Just TableOptions
self { borderCollapse :: Bool
borderCollapse = Bool
True }
longhand TableOptions
_ TableOptions
self Text
"border-collapse" [Ident Text
"separate"] =
forall a. a -> Maybe a
Just TableOptions
self { borderCollapse :: Bool
borderCollapse = Bool
False }
longhand TableOptions
_ TableOptions
self Text
"border-collapse" [Ident Text
"initial"] =
forall a. a -> Maybe a
Just TableOptions
self { borderCollapse :: Bool
borderCollapse = Bool
False }
longhand TableOptions
_ TableOptions
self Text
"border-spacing" v :: [Token]
v@[Dimension Text
_ NumericValue
_ Text
_] | Just Unitted
x <- [Token] -> Maybe Unitted
parseLength [Token]
v =
forall a. a -> Maybe a
Just TableOptions
self { borderHSpacing :: Unitted
borderHSpacing = Unitted
x, borderVSpacing :: Unitted
borderVSpacing = Unitted
x }
longhand TableOptions
_ TableOptions
self Text
"border-spacing" [x :: Token
x@(Dimension Text
_ NumericValue
_ Text
_), y :: Token
y@(Dimension Text
_ NumericValue
_ Text
_)]
| Just Unitted
x' <- [Token] -> Maybe Unitted
parseLength [Token
x], Just Unitted
y' <- [Token] -> Maybe Unitted
parseLength [Token
y] =
forall a. a -> Maybe a
Just TableOptions
self { borderHSpacing :: Unitted
borderHSpacing = Unitted
x', borderVSpacing :: Unitted
borderVSpacing = Unitted
y' }
longhand TableOptions
_ TableOptions
self Text
"border-spacing" [Ident Text
"initial"] =
forall a. a -> Maybe a
Just TableOptions
self { borderHSpacing :: Unitted
borderHSpacing = (Double
0,Text
"px"), borderVSpacing :: Unitted
borderVSpacing = (Double
0,Text
"px") }
longhand TableOptions
_ TableOptions
self Text
"vertical-align" [Ident Text
x]
| Text
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"baseline", Text
"sub", Text
"super", Text
"text-top", Text
"text-bottom",
Text
"middle", Text
"top", Text
"bottom"] = forall a. a -> Maybe a
Just TableOptions
self { verticalAlign :: Unitted
verticalAlign = (Double
0,Text
x) }
| Text
x forall a. Eq a => a -> a -> Bool
== Text
"initial" = forall a. a -> Maybe a
Just TableOptions
self { verticalAlign :: Unitted
verticalAlign = (Double
0,Text
"baseline") }
| Bool
otherwise = forall a. Maybe a
Nothing
longhand TableOptions
_ TableOptions
self Text
"vertical-align" [Token]
v | Just Unitted
x <- [Token] -> Maybe Unitted
parseLength [Token]
v =
forall a. a -> Maybe a
Just TableOptions
self { verticalAlign :: Unitted
verticalAlign = Unitted
x }
longhand TableOptions
_ TableOptions
_ Text
_ [Token]
_ = forall a. Maybe a
Nothing
finalizeGap :: TableOptions -> Font' -> (Length, Length)
finalizeGap :: TableOptions -> Font' -> (Length, Length)
finalizeGap TableOptions { borderCollapse :: TableOptions -> Bool
borderCollapse = Bool
True } Font'
_ = (Double -> Length
Pixels Double
0, Double -> Length
Pixels Double
0)
finalizeGap TableOptions { borderHSpacing :: TableOptions -> Unitted
borderHSpacing = Unitted
x, borderVSpacing :: TableOptions -> Unitted
borderVSpacing = Unitted
y } Font'
font =
(Unitted -> Font' -> Length
finalizeLength Unitted
x Font'
font, Unitted -> Font' -> Length
finalizeLength Unitted
y Font'
font)
type UPaddedBox = PaddedBox Unitted Unitted
collapseBorders :: TableOptions -> UPaddedBox -> UPaddedBox
collapseBorders :: TableOptions -> UPaddedBox -> UPaddedBox
collapseBorders TableOptions { borderCollapse :: TableOptions -> Bool
borderCollapse = Bool
False } UPaddedBox
ret = UPaddedBox
ret
collapseBorders TableOptions
_ UPaddedBox
box = UPaddedBox
box {
margin :: Border Unitted Unitted
margin = forall a. Zero a => a
zero,
border :: Border Unitted Unitted
border = forall n nn m. (n -> nn) -> Border m n -> Border m nn
mapX forall {a} {b}. Fractional a => (a, b) -> (a, b)
half forall a b. (a -> b) -> a -> b
$ forall m mm n. (m -> mm) -> Border m n -> Border mm n
mapY forall {a} {b}. Fractional a => (a, b) -> (a, b)
half forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Border m n
border UPaddedBox
box
}
collapseTBorders :: TableOptions -> UPaddedBox -> UPaddedBox
collapseTBorders :: TableOptions -> UPaddedBox -> UPaddedBox
collapseTBorders TableOptions { borderCollapse :: TableOptions -> Bool
borderCollapse = Bool
False } UPaddedBox
ret = UPaddedBox
ret
collapseTBorders TableOptions
_ UPaddedBox
box = UPaddedBox
box {
padding :: Border Unitted Unitted
padding = forall a. Zero a => a
zero,
border :: Border Unitted Unitted
border = forall n nn m. (n -> nn) -> Border m n -> Border m nn
mapX forall {a} {b}. Fractional a => (a, b) -> (a, b)
half forall a b. (a -> b) -> a -> b
$ forall m mm n. (m -> mm) -> Border m n -> Border mm n
mapY forall {a} {b}. Fractional a => (a, b) -> (a, b)
half forall a b. (a -> b) -> a -> b
$ forall m n. PaddedBox m n -> Border m n
border UPaddedBox
box
}
half :: (a, b) -> (a, b)
half (a
x,b
u) = (a
xforall a. Fractional a => a -> a -> a
/a
2,b
u)
finalizeVAlign :: TableOptions -> Alignment
finalizeVAlign :: TableOptions -> Alignment
finalizeVAlign TableOptions { verticalAlign :: TableOptions -> Unitted
verticalAlign = (Double
_,Text
"top") } = Alignment
Start
finalizeVAlign TableOptions { verticalAlign :: TableOptions -> Unitted
verticalAlign = (Double
_,Text
"middle") } = Alignment
Mid
finalizeVAlign TableOptions { verticalAlign :: TableOptions -> Unitted
verticalAlign = (Double
_,Text
"bottom") } = Alignment
End
finalizeVAlign TableOptions
_ = Alignment
Start
finalizeHAlign :: ParagraphOptions -> Direction -> Alignment
finalizeHAlign :: ParagraphOptions -> Direction -> Alignment
finalizeHAlign (ParagraphOptions -> ParagraphAlignment
paragraphAlignment -> ParagraphAlignment
AlignStart) Direction
_ = Alignment
Start
finalizeHAlign (ParagraphOptions -> ParagraphAlignment
paragraphAlignment -> ParagraphAlignment
AlignEnd) Direction
_ = Alignment
End
finalizeHAlign (ParagraphOptions -> ParagraphAlignment
paragraphAlignment -> ParagraphAlignment
AlignLeft) Direction
DirLTR = Alignment
Start
finalizeHAlign (ParagraphOptions -> ParagraphAlignment
paragraphAlignment -> ParagraphAlignment
AlignLeft) Direction
_ = Alignment
End
finalizeHAlign (ParagraphOptions -> ParagraphAlignment
paragraphAlignment -> ParagraphAlignment
AlignRight) Direction
DirLTR = Alignment
End
finalizeHAlign (ParagraphOptions -> ParagraphAlignment
paragraphAlignment -> ParagraphAlignment
AlignRight) Direction
_ = Alignment
Start
finalizeHAlign (ParagraphOptions -> ParagraphAlignment
paragraphAlignment -> ParagraphAlignment
AlignCentreH) Direction
_ = Alignment
Mid