{-# 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']] }