{-# LANGUAGE OverloadedStrings #-}
-- | Parse FlexBox-related CSS properties
module Graphics.Layout.Flex.CSS(CSSFlex(..), lowerFlex) where
import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
import Stylist (PropertyParser(..), TrivialPropertyParser, parseOperands,
parseUnorderedShorthand', parseUnorderedShorthand)
import Graphics.Layout.Flex as F
import Graphics.Layout.CSS.Length (parseLength, finalizeLength, n2f, Unitted, Font')
import Graphics.Layout.Box (Length)
import Data.Maybe (isJust)
-- | Parsed FlexBox-related CSS properties.
data CSSFlex = CSSFlex {
-- | Parsed CSS flex-direction, axis component.
directionCSS :: Direction,
-- | Parsed CSS flex-direction, reversed flag
reverseRowsCSS :: Bool,
-- | Parsed CSS flex-wrap
wrapCSS :: FlexWrapping,
-- | Parsed CSS justify-content
justifyCSS :: Maybe Justification,
-- | Parsed CSS align-items
alignItemsCSS :: Alignment,
-- | Parsed CSS align-content, `Nothing` is "stretch"
alignLinesCSS :: Maybe Justification,
-- | Parsed CSS row-gap
rowGapCSS :: Unitted,
-- | Parsed CSS column-gap
columnGapCSS :: Unitted,
-- flex children
-- | Parsed CSS order
orderCSS :: Integer,
-- | Parsed CSS flex-grow
growCSS :: Double,
-- | Parsed CSS flex-shrink
shrinkCSS :: Double,
-- | Parsed CSS flex-basis
basisCSS :: Unitted,
-- | Parsed CSS align-self
alignSelfCSS :: Alignment,
-- | Whether justification or alignment properties should be parsed as right-to-left or left-to-right.
textRTL :: Bool -- Extra parameter from caller.
}
setDir self dir rev = Just self { directionCSS = dir, reverseRowsCSS = rev }
parseJustify self "flex-start" | reverseRowsCSS self = Just JEnd
| otherwise = Just JStart
parseJustify self "flex-end" | reverseRowsCSS self = Just JStart
| otherwise = Just JEnd
parseJustify self "start" | textRTL self = Just JEnd
| otherwise = Just JStart
parseJustify self "end" | textRTL self = Just JStart
| otherwise = Just JEnd
parseJustify _ "left" = Just JStart
parseJustify _ "right" = Just JEnd
parseJustify _ "center" = Just JCenter
parseJustify _ "space-between" = Just JSpaceBetween
parseJustify _ "space-around" = Just JSpaceAround
parseJustify _ "space-evenly" = Just JSpaceEvenly
parseJustify _ _ = Nothing
parseAlign _ "stretch" = Just AlStretch
parseAlign self "flex-start" | reverseRowsCSS self = Just AlEnd
| otherwise = Just AlStart
parseAlign _ "start" = Just AlStart
parseAlign self "self-start" | textRTL self = Just AlEnd
| otherwise = Just AlStart
parseAlign self "flex-end" | reverseRowsCSS self = Just AlStart
| otherwise = Just AlEnd
parseAlign _ "end" = Just AlEnd
parseAlign self "self-end" | textRTL self = Just AlStart
| otherwise = Just AlEnd
parseAlign _ "center" = Just AlCenter
parseAlign _ "baseline" = Just AlBaseline
parseAlign _ _ = Nothing
instance PropertyParser CSSFlex where
temp = CSSFlex {
directionCSS = Row,
reverseRowsCSS = False,
wrapCSS = NoWrap,
justifyCSS = Nothing, -- flex-start, conditional on directionCSS
alignItemsCSS = AlStretch,
alignLinesCSS = Just JStart,
rowGapCSS = (0,"px"),
columnGapCSS = (0,"px"),
orderCSS = 0,
growCSS = 0,
shrinkCSS = 1,
basisCSS = (0,"auto"),
alignSelfCSS = AlStretch, -- Should be auto, but we're implementing that in `inherit`.
textRTL = False
}
inherit parent = temp { alignSelfCSS = alignItemsCSS parent }
priority _ = ["flex-direction"]
longhand _ self "flex-direction" [Ident "row"] = setDir self Row False
longhand _ self "flex-direction" [Ident "row-reverse"] = setDir self Row True
longhand _ self "flex-direction" [Ident "column"] = setDir self F.Column False
longhand _ self "flex-direction" [Ident "column-reverse"] =
setDir self F.Column True
longhand _ self "flex-direction" [Ident "initial"] = setDir self Row False
longhand _ self "flex-wrap" [Ident "no-wrap"] = Just self { wrapCSS = NoWrap }
longhand _ self "flex-wrap" [Ident "wrap"] = Just self { wrapCSS = Wrap }
longhand _ self "flex-wrap" [Ident "wrap-reverse"] =
Just self { wrapCSS = WrapReverse }
longhand _ self "flex-wrap" [Ident "initial"] = Just self { wrapCSS = NoWrap }
longhand _ self "justify-content" [Ident x]
| x == "initial" = Just self { justifyCSS = parseJustify self "flex-start" }
| y@(Just _) <- parseJustify self x = Just self { justifyCSS = y }
longhand _ self "align-items" [Ident x]
| x == "initial" = Just self { alignItemsCSS = AlStretch }
| Just y <- parseAlign self x = Just self { alignItemsCSS = y }
longhand _ self "align-content" [Ident x] | x `elem` ["initial", "normal"] =
Just self { alignLinesCSS = parseJustify self "start" }
| x == "stretch" = Just self { alignLinesCSS = Nothing }
| y@(Just _) <- parseJustify self x = Just self { alignLinesCSS = y }
longhand _ self "row-gap" [Ident x]
| x `elem` ["initial", "normal"] = Just self { rowGapCSS = (0,"px") }
| otherwise = Nothing
longhand _ self "row-gap" toks
| Just x <- parseLength toks = Just self { rowGapCSS = x}
longhand _ self "column-gap" [Ident x]
| x `elem` ["initial", "normal"] = Just self { columnGapCSS = (0,"px") }
| otherwise = Nothing
longhand _ self "column-gap" toks
| Just x <- parseLength toks = Just self { columnGapCSS = x }
longhand _ self "order" [Number _ (NVInteger x)] = Just self { orderCSS = x }
longhand _ self "order" [Ident "initial"] = Just self { orderCSS = 0 }
longhand _ self "flex-grow" [Number _ x] | n2f x>0 = Just self {growCSS=n2f x}
longhand _ self "flex-grow" [Ident "initial"] = Just self { growCSS = 0 }
longhand _ self "flex-shrink" [Number _ x] | n2f x > 0 =
Just self { shrinkCSS = n2f x }
longhand _ self "flex-shrink" [Ident "initial"] = Just self { shrinkCSS = 1 }
longhand _ self "flex-basis" toks | Just x <- parseLength toks =
Just self { basisCSS = x }
longhand parent self "align-self" [Ident x] | x `elem` ["initial", "auto"] =
Just self { alignSelfCSS = alignItemsCSS parent }
| Just y <- parseAlign self x = Just self { alignSelfCSS = y }
longhand _ _ _ _ = Nothing
shorthand self "flex-flow" toks =
parseUnorderedShorthand self ["flex-direction", "flex-wrap"] toks
shorthand self "gap" toks | [x] <- parseOperands toks =
parseUnorderedShorthand' self ["row-gap", "column-gap"] [x, x]
| otherwise = parseUnorderedShorthand self ["row-gap", "column-gap"] toks
shorthand self "flex" toks
| [Ident "initial"] <- toks =
[("flex-grow", init), ("flex-shrink", init), ("flex-basis", px0)]
| [Ident "auto"] <- toks =
[("flex-grow", n1), ("flex-shrink", n1), ("flex-basis", init)]
| [Ident "none"] <- toks =
[("flex-grow", n0), ("flex-shrink", n0), ("flex-basis", init)]
| [a] <- operands, test "flex-grow" a =
[("flex-grow", a), ("flex-shrink", init), ("flex-basis", px0)]
| [a] <- operands, test "flex-basis" a =
[("flex-grow", n1), ("flex-shrink", init), ("flex-basis", a)]
| [a, b] <- operands, test "flex-grow" a, test "flex-shrink" b =
[("flex-grow", a), ("flex-shrink", b), ("flex-basis", px0)]
| [a, b] <- operands, test "flex-grow" a, test "flex-basis" b =
[("flex-grow", a), ("flex-shrink", init), ("flex-basis", b)]
| [a, b, c] <- operands, test "flex-grow" a, test "flex-shrink" b, test "flex-basis" c =
[("flex-grow", a), ("flex-shrink", b), ("flex-basis", c)]
where
operands = parseOperands toks
test a = isJust . longhand self self a
init = [Ident "initial"]
px0 = [Dimension "0" (NVInteger 0) "px"]
n1 = [Number "1" (NVInteger 1)]
n0 = [Number "0" (NVInteger 0)]
shorthand self k v | Just _ <- longhand self self k v = [(k, v)]
| otherwise = []
-- | Lower the Flexbox styling tree to the Layout tree.
lowerFlex :: CSSFlex -> Font' -> [CSSFlex] -> [a] -> [Font'] -> Flex a Length
lowerFlex self font kids kids' fonts' = Flex {
direction = directionCSS self,
reverseRows = reverseRowsCSS self,
wrap = wrapCSS self,
justify = case justifyCSS self of
Just x -> x
Nothing | reverseRowsCSS self -> JEnd
Nothing -> JStart,
alignLines = alignLinesCSS self,
baseGap = case directionCSS self of
Row -> flip finalizeLength font $ rowGapCSS self
F.Column -> flip finalizeLength font $ columnGapCSS self,
crossGap = case directionCSS self of
Row -> flip finalizeLength font $ columnGapCSS self
F.Column -> flip finalizeLength font $ rowGapCSS self,
pageWidth = 0,
children = [[FlexChild {
grow = growCSS kid,
shrink = shrinkCSS kid,
basis = flip finalizeLength font' $ rowGapCSS kid,
alignment = alignSelfCSS kid,
flexInner = kid'
} | (kid, kid', font') <- zip3 kids kids' fonts']]
}