2 files changed, 105 insertions(+), 10 deletions(-)

M Graphics/Layout/CSS.hs
M cattrap.cabal

@@ 1,18 1,113 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Graphics.Layout.CSS where
 
-import Graphics.Layout.Box
+import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
+import qualified Data.Text as Txt
+import Stylist (PropertyParser(..), TrivialPropertyParser)
+import Data.Scientific (toRealFloat)
+
+import Graphics.Layout.Box as B
 import Graphics.Layout
+import Graphics.Text.Font.Choose (Pattern(..))
 
-data CSSBox = CSSBox {
+data CSSBox a = CSSBox {
     boxSizing :: BoxSizing,
-    cssBox :: PaddedBox Unitted Unitted -- Some units need to be resolved per font. calc()?
-    -- Other layout-mode specific properties?
-    -- Resolve font here so we can resolve those units?
+    cssBox :: PaddedBox Unitted Unitted, -- Some units need to be resolved per font. calc()?
+    font :: Pattern,
+    inner :: a
 }
 data BoxSizing = BorderBox | ContentBox
-type Unitted = (Double, String)
+type Unitted = (Double, Txt.Text)
+auto = (0,"auto")
+noborder = Border (0,"px") (0,"px") (0,"px") (0,"px")
+
+instance PropertyParser a => PropertyParser (CSSBox a) where
+    temp = CSSBox {
+        boxSizing = ContentBox,
+        cssBox = PaddedBox {
+            B.min = Size auto auto,
+            size = Size auto auto,
+            B.max = Size auto auto,
+            padding = noborder,
+            border = noborder,
+            margin = noborder
+        },
+        font = temp,
+        inner = temp
+      }
+    inherit parent = CSSBox {
+        boxSizing = boxSizing parent,
+        cssBox = cssBox (temp :: CSSBox TrivialPropertyParser),
+        font = inherit $ font parent,
+        inner = inherit $ inner parent
+      }
+
+    longhand _ self "box-sizing" [Ident "content-box"] = Just self {boxSizing = ContentBox}
+    longhand _ self "box-sizing" [Ident "border-box"] = Just self {boxSizing = BorderBox}
+    longhand _ self "box-sizing" [Ident "initial"] = Just self {boxSizing = ContentBox}
+
+    longhand _ self@CSSBox {cssBox = box} "padding-top" toks | Just x <- parseLength toks =
+        Just self { cssBox = box { padding = (padding box) { top = x } } }
+    longhand _ self@CSSBox {cssBox = box} "padding-bottom" toks | Just x <- parseLength toks =
+        Just self { cssBox = box { padding = (padding box) { bottom = x } } }
+    longhand _ self@CSSBox {cssBox = box} "padding-left" toks | Just x <- parseLength toks =
+        Just self { cssBox = box { padding = (padding box) { left = x } } }
+    longhand _ self@CSSBox {cssBox = box} "padding-right" toks | Just x <- parseLength toks =
+        Just self { cssBox = box { padding = (padding box) { right = x } } }
+    longhand _ self@CSSBox {cssBox = box} "border-top-width" toks | Just x <- parseLength toks =
+        Just self { cssBox = box { border = (border box) { top = x } } }
+    longhand _ self@CSSBox {cssBox = box} "border-bottom-width" toks | Just x <- parseLength toks =
+        Just self { cssBox = box { border = (border box) { bottom = x } } }
+    longhand _ self@CSSBox {cssBox = box} "border-left-width" toks | Just x <- parseLength toks =
+        Just self { cssBox = box { border = (border box) { left = x } } }
+    longhand _ self@CSSBox {cssBox = box} "border-right-width" toks | Just x <- parseLength toks =
+        Just self { cssBox = box { border = (border box) { right = x } } }
+    longhand _ self@CSSBox {cssBox = box} "margin-top" toks | Just x <- parseLength toks =
+        Just self { cssBox = box { margin = (margin box) { top = x } } }
+    longhand _ self@CSSBox {cssBox = box} "margin-bottom" toks | Just x <- parseLength toks =
+        Just self { cssBox = box { margin = (margin box) { bottom = x } } }
+    longhand _ self@CSSBox {cssBox = box} "margin-left" toks | Just x <- parseLength toks =
+        Just self { cssBox = box { margin = (margin box) { left = x } } }
+    longhand _ self@CSSBox {cssBox = box} "margin-right" toks | Just x <- parseLength toks =
+        Just self { cssBox = box { margin = (margin box) { right = x } } }
+
+    longhand _ self@CSSBox {cssBox = box} "width" toks | Just x <- parseLength' toks =
+        Just self { cssBox = box { size = (size box) { inline = x } } }
+    longhand _ self@CSSBox {cssBox = box} "height" toks | Just x <- parseLength' toks =
+        Just self { cssBox = box { size = (size box) { block = x } } }
+    longhand _ self@CSSBox {cssBox = box} "max-width" toks | Just x <- parseLength' toks =
+        Just self { cssBox = box { B.max = (B.max box) { inline = x } } }
+    longhand _ self@CSSBox {cssBox = box} "min-width" toks | Just x <- parseLength' toks =
+        Just self { cssBox = box { B.min = (B.min box) { inline = x } } }
+    longhand _ self@CSSBox {cssBox = box} "max-height" toks | Just x <- parseLength' toks =
+        Just self { cssBox = box { B.max = (B.max box) { block = x } } }
+    longhand _ self@CSSBox {cssBox = box} "min-height" toks | Just x <- parseLength' toks =
+        Just self { cssBox = box { B.min = (B.min box) { block = x } } }
+
+    longhand a b c d | Just font' <- longhand (font a) (font b) c d = Just b {
+        font = font'
+      }
+    longhand a b c d | Just inner' <- longhand (inner a) (inner b) c d = Just b {
+        inner = inner'
+      }
+    longhand _ _ _ _ = Nothing
+
+parseLength :: [Token] -> Maybe Unitted
+parseLength [Percentage _ x] = Just (n2f x,"%")
+parseLength [Dimension _ x unit]
+    | n2f x == 0 && unit == "" = Just (0,"px")
+    | unit `elem` units = Just (n2f x,unit)
+parseLength [Ident "auto"] = Just (0,"auto")
+parseLength [Ident "initial"] = Just (0,"px")
+parseLength _ = Nothing
+parseLength' [Ident "min-content"] = Just (0,"min-content")
+parseLength' [Ident "max-content"] = Just (0,"max-content")
+parseLength' [Ident "auto"] = Just (0,"auto")
+parseLength' toks = parseLength toks
+
+units = Txt.words "cap ch em ex ic lh rem rlh vh vw vmax vmin vb vi px cm mm Q in pc pt %"
 
-{-instance PropertyParser CSSBox where
-    ...
+n2f (NVInteger x) = realToFrac x
+n2f (NVNumber x) = toRealFloat x
 
-finalizeCSS :: CSSBox -> LayoutItem Length-}
+{-finalizeCSS :: CSSBox -> LayoutItem Length-}

@@ 21,7 21,7 @@ library
                         Graphics.Layout.Grid, Graphics.Layout.Box, Graphics.Layout.Arithmetic
   -- other-modules:
   -- other-extensions:
-  build-depends:       base >=4.12 && <4.16, css-syntax, scientific, text, stylist-traits
+  build-depends:       base >=4.12 && <4.16, css-syntax, scientific, text, stylist-traits, fontconfig-pure
   -- hs-source-dirs:
   default-language:    Haskell2010
   ghc-options:         -Wincomplete-patterns