3 files changed, 63 insertions(+), 6 deletions(-)

M Graphics/Layout/Grid/CSS.hs
M cattrap.cabal
M test/Test.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

@@ 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

@@ 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