From 52bc8445579a0a5652f6bbf498249bdd40659d0a Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Mon, 22 May 2023 16:35:16 +1200 Subject: [PATCH] Build utility for parsing CSS3 Grid templates. --- Graphics/Layout/Grid/CSS.hs | 33 +++++++++++++++++++++++++++++++-- cattrap.cabal | 17 +++++++++++++---- test/Test.hs | 19 +++++++++++++++++++ 3 files changed, 63 insertions(+), 6 deletions(-) diff --git a/Graphics/Layout/Grid/CSS.hs b/Graphics/Layout/Grid/CSS.hs index 8893769..3dcad9d 100644 --- a/Graphics/Layout/Grid/CSS.hs +++ b/Graphics/Layout/Grid/CSS.hs @@ -1,19 +1,48 @@ {-# LANGUAGE OverloadedStrings #-} -- | Infrastructure for parsing & desugaring grid-layout related CSS properties. -module Graphics.Layout.Grid.CSS(CSSGrid(..), Axis(..), CSSCell(..), Placement(..), finalizeGrid) where +module Graphics.Layout.Grid.CSS(CSSGrid(..), Axis(..), CSSCell(..), Placement(..), + finalizeGrid, Areas, parseASCIIGrid) where import Stylist (PropertyParser(..)) import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..)) + import Data.Text (Text) import qualified Data.Text as Txt import Data.Char (isAlphaNum) -import Data.Maybe (fromMaybe) +import Data.Maybe (fromMaybe, isNothing) +import Data.List (nub) +import qualified Data.HashMap.Lazy as HM import Graphics.Layout.CSS.Length import Graphics.Layout.Box import Graphics.Layout.Grid import Graphics.Layout +import Debug.Trace + +type Areas = HM.HashMap Text ((Int, Int), (Int, Maybe Int)) + +-- | Converts a grid to lookup table start & indices for row & columns. +-- Exported for the sake of testing +parseASCIIGrid :: [[Text]] -> Int -> Areas -> Maybe Areas +parseASCIIGrid (row:rows) i prev + | names == nub names, and [span == fst rec && isNothing (snd $ snd rec) + | (name, span) <- row', Just rec <- [name `HM.lookup` prev]] = + parseASCIIGrid rows (succ i) $ HM.mapWithKey closeAreas $ HM.union prev $ + HM.fromList [(name, (span, (i, Nothing))) | (name, span) <- row'] + | otherwise = Nothing + where + names = map fst row' + row' = parseAsciiRow $ enumerate row + parseAsciiRow ((j, cell):cells) = + let (self, cells') = span (\z -> snd z == cell) cells + in (cell, (j, succ j + length self)):parseAsciiRow cells' + parseAsciiRow [] = [] + enumerate = zip [0..] + closeAreas name (a, (b, Nothing)) | name `notElem` names = (a, (b, Just i)) + closeAreas _ ret = ret +parseASCIIGrid [] _ ret = Just ret + -- | Parsed CSS Grid properties data CSSGrid = CSSGrid { -- | Parsed CSS grid-auto-columns diff --git a/cattrap.cabal b/cattrap.cabal index 15935e0..b9738c4 100644 --- a/cattrap.cabal +++ b/cattrap.cabal @@ -9,13 +9,18 @@ homepage: https://argonaut-constellation.org/ license: GPL-3 license-file: LICENSE author: Adrian Cochrane -maintainer: alcinnz@argonaut-constellation.org +maintainer: ~alcinnz/cattrap@todo.argonaut-constellation.org +bug-reports: https://todo.argonaut-constellation.org/~alcinnz/cattrap copyright: Adrian Cochrane 2023 category: Graphics build-type: Simple extra-source-files: CHANGELOG.md cabal-version: >=1.10 +source-repository head + type: git + location: https://git.argonaut-constellation.org/~alcinnz/cattrap + library exposed-modules: Graphics.Layout, Graphics.Layout.CSS, Graphics.Layout.Flow, Graphics.Layout.Grid, Graphics.Layout.Grid.CSS, @@ -25,8 +30,11 @@ library -- other-modules: -- other-extensions: build-depends: base >=4.12 && <4.16, containers, - css-syntax, scientific, text, stylist-traits, - fontconfig-pure, harfbuzz-pure, bytestring, balkon + css-syntax, scientific, text, + stylist-traits >= 0.1.3.0 && < 1, + fontconfig-pure >= 0.2 && < 0.3, + harfbuzz-pure >= 1.0.3.2 && < 1.1, bytestring, + balkon >= 0.2.1 && < 0.3, unordered-containers -- hs-source-dirs: default-language: Haskell2010 ghc-options: -Wincomplete-patterns @@ -44,4 +52,5 @@ test-suite test-cattrap default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: Test.hs - build-depends: base, cattrap, hspec, QuickCheck, css-syntax, stylist-traits + build-depends: base, cattrap, hspec >= 2 && < 3, QuickCheck >= 2 && < 3, + css-syntax, stylist-traits, unordered-containers diff --git a/test/Test.hs b/test/Test.hs index bcdaddb..65fb99b 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -6,12 +6,16 @@ import Test.Hspec import Graphics.Layout.Arithmetic import Data.CSS.Syntax.Tokens (tokenize, Token(..)) import Stylist (PropertyParser(..)) +import Data.Maybe (fromJust) import Graphics.Layout.Box as B import Graphics.Layout.Grid import Graphics.Layout.Flow import Graphics.Layout +import Graphics.Layout.Grid.CSS (parseASCIIGrid) +import qualified Data.HashMap.Lazy as HM + main :: IO () main = hspec spec @@ -284,6 +288,21 @@ spec = do let LayoutFlow (pos, _) _ _ = snd $ head pxCells containerSize pxGrid `shouldBe` Size 10 10 pos `shouldBe` (0, 0) -} + describe "Grid templates" $ do + it "parses successfully" $ do + let grid = fromJust $ parseASCIIGrid [["head", "head"], + ["nav", "main"], + ["foot", "."]] 0 HM.empty + HM.lookup "head" grid `shouldBe` Just ((0,2), (0, Just 1)) + HM.lookup "nav" grid `shouldBe` Just ((0,1), (1, Just 2)) + HM.lookup "main" grid `shouldBe` Just ((1,2), (1, Just 2)) + HM.lookup "foot" grid `shouldBe` Just ((0,1), (2, Nothing)) + HM.lookup "aside" grid `shouldBe` Nothing + it "discards invalid non-squares" $ do + let test grid = parseASCIIGrid grid 0 HM.empty `shouldBe` Nothing + test [["head", "nav", "head"]] + test [["head"], ["nav"], ["head"]] + test [["head", "head"], ["head", "nav"]] runMath = flip evalCalc [] . mapCalc fst . flip parseCalc [] . filter (/= Whitespace) . tokenize -- 2.30.2