From 3a25ee5a27764d2f32096e01161e70abb0b9e3df Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Fri, 3 Nov 2023 16:01:43 +1300 Subject: [PATCH] Test table lowering --- Graphics/Layout.hs | 21 ++++++- Graphics/Layout/CSS/Length.hs | 2 + Graphics/Layout/Grid.hs | 2 +- Graphics/Layout/Inline.hs | 1 + Graphics/Layout/Inline/CSS.hs | 6 +- cattrap.cabal | 10 ++-- test/Test.hs | 108 ++++++++++++++++++++++++++++++++++ 7 files changed, 143 insertions(+), 7 deletions(-) diff --git a/Graphics/Layout.hs b/Graphics/Layout.hs index bb412da..7aaf648 100644 --- a/Graphics/Layout.hs +++ b/Graphics/Layout.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, RecordWildCards #-} +{-# LANGUAGE OverloadedStrings, RecordWildCards, StandaloneDeriving #-} -- | Generic layout logic, handling a hierarchy of varying formulas. -- Unless callers have more specific needs they probably wish to use this abstraction. -- Attempts to follow the CSS specs. @@ -32,6 +32,11 @@ import qualified Data.Map.Strict as M import qualified Data.Text.Glyphize as Hb import Graphics.Text.Font.Choose (Pattern) +-- For comparisons +import Data.Array.Byte (ByteArray(..)) +import Data.Text.Array (Array(..)) +import Unsafe.Coerce (unsafeCoerce) + -- | Additional data routed through Balkon. type UserData m n x = ((Font', Int), PaddedBox m n, x) @@ -52,6 +57,7 @@ data LayoutItem m n x = | LayoutConst x (PaddedBox m n) [LayoutItem m n x] -- | Children of a `LayoutInline` or `LayoutInline'`. | LayoutSpan (FragmentTree (UserData m n x)) + deriving (Show, Eq) -- | An empty box. nullLayout :: (PropertyParser x, Zero m, Zero n) => LayoutItem m n x nullLayout = LayoutFlow temp zero [] @@ -409,3 +415,16 @@ glyphsPerFont node = M.unionsWith IS.union $ map glyphsPerFont $ layoutGetChilds parMap' :: NFData b => (a -> b) -> [a] -> [b] parMap' = parMap rdeepseq + +------ +--- Orphan typeclass instances +------ + +instance Show (Paragraph x) where + show (Paragraph arr _ _ _) = show $ asBA arr +deriving instance Show PageOptions +instance Eq (Paragraph x) where + Paragraph a _ _ _ == Paragraph b _ _ _ = asBA a == asBA b +deriving instance Eq PageOptions + +asBA = unsafeCoerce :: Array -> ByteArray diff --git a/Graphics/Layout/CSS/Length.hs b/Graphics/Layout/CSS/Length.hs index 65e4c96..89f6b6f 100644 --- a/Graphics/Layout/CSS/Length.hs +++ b/Graphics/Layout/CSS/Length.hs @@ -120,3 +120,5 @@ data Font' = Font' { instance Eq Font' where a == b = pattern a == pattern b +instance Show Font' where + show a = show $ pattern a diff --git a/Graphics/Layout/Grid.hs b/Graphics/Layout/Grid.hs index 024d561..2899f16 100644 --- a/Graphics/Layout/Grid.hs +++ b/Graphics/Layout/Grid.hs @@ -27,7 +27,7 @@ data Track x = Track { trackNats :: [Double], -- | How much space to add between cells. gap :: x -} +} deriving (Show, Read, Eq, Ord) -- | Which cells a child should be aligned to. type GridItem = Size GridItem' GridItem' -- | How a grid child should be aligned per-axis. diff --git a/Graphics/Layout/Inline.hs b/Graphics/Layout/Inline.hs index d04da46..d6e4309 100644 --- a/Graphics/Layout/Inline.hs +++ b/Graphics/Layout/Inline.hs @@ -79,6 +79,7 @@ lowerSpacing (Paragraph a b (RootBox c) d) = Paragraph a b (RootBox $ inner c) d data FragmentTree x = Branch (AncestorBox x) [FragmentTree x] | Leaf (Fragment x) + deriving (Show, Eq) -- | Apply an operation to the 2nd field of the paragraph's userdata, -- for it's entire subtree. diff --git a/Graphics/Layout/Inline/CSS.hs b/Graphics/Layout/Inline/CSS.hs index c67ad09..a652404 100644 --- a/Graphics/Layout/Inline/CSS.hs +++ b/Graphics/Layout/Inline/CSS.hs @@ -2,7 +2,7 @@ -- | Infrastructure for parsing & desugaring text related CSS properties. module Graphics.Layout.Inline.CSS( CSSInline(..), Default(..), UnicodeBidi(..), applyFontInline, applyBidi, - resolveVAlign, resolveBoxOpts) where + resolveVAlign, resolveBoxOpts, plaintext) where import Data.CSS.Syntax.Tokens (Token(..)) import Stylist (PropertyParser(..)) @@ -25,6 +25,10 @@ data CSSInline = CSSInline Txt.Text TextOptions UnicodeBidi data UnicodeBidi = BdNormal | BdEmbed | BdOverride | BdIsolate | BdIsolateOverride | BdPlainText deriving (Eq, Ord, Enum, Read, Show) +-- | Construct plain text +plaintext :: Txt.Text -> CSSInline +plaintext txt = CSSInline txt (defaultTextOptions DirLTR) BdNormal + instance PropertyParser CSSInline where temp = CSSInline "" (defaultTextOptions DirLTR) BdNormal inherit (CSSInline _ opts _) = CSSInline "" opts BdNormal diff --git a/cattrap.cabal b/cattrap.cabal index 9529f8f..cc6c92f 100644 --- a/cattrap.cabal +++ b/cattrap.cabal @@ -26,15 +26,16 @@ library Graphics.Layout.Grid, Graphics.Layout.Grid.CSS, Graphics.Layout.Box, Graphics.Layout.Arithmetic, Graphics.Layout.CSS.Length, Graphics.Layout.CSS.Font, - Graphics.Layout.Inline, Graphics.Layout.Inline.CSS - other-modules: Graphics.Layout.CSS.Parse, Graphics.Layout.Grid.Table + Graphics.Layout.Inline, Graphics.Layout.Inline.CSS, + Graphics.Layout.Grid.Table + other-modules: Graphics.Layout.CSS.Parse -- other-extensions: build-depends: base >=4.12 && <5, containers, parallel >= 3, css-syntax, scientific, text, deepseq, stylist-traits >= 0.1.3.0 && < 1, fontconfig-pure >= 0.2 && < 0.5, harfbuzz-pure >= 1.0.3.2 && < 1.1, bytestring, - balkon >= 1.2 && <2, unordered-containers + balkon >= 1.2 && <2, unordered-containers, data-array-byte -- hs-source-dirs: default-language: Haskell2010 ghc-options: -Wincomplete-patterns @@ -70,4 +71,5 @@ test-suite test-cattrap type: exitcode-stdio-1.0 main-is: Test.hs build-depends: base, cattrap, hspec >= 2 && < 3, QuickCheck >= 2 && < 3, - css-syntax, stylist-traits, unordered-containers + css-syntax, stylist-traits, unordered-containers, + balkon, harfbuzz-pure diff --git a/test/Test.hs b/test/Test.hs index 65fb99b..bd49f35 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -6,6 +6,7 @@ import Test.Hspec import Graphics.Layout.Arithmetic import Data.CSS.Syntax.Tokens (tokenize, Token(..)) import Stylist (PropertyParser(..)) +import Stylist.Tree (StyleTree(..)) import Data.Maybe (fromJust) import Graphics.Layout.Box as B @@ -13,6 +14,17 @@ import Graphics.Layout.Grid import Graphics.Layout.Flow import Graphics.Layout +import Graphics.Layout.CSS +import Graphics.Layout.Grid.Table +import Graphics.Layout.Inline.CSS +import Graphics.Layout.CSS.Font (placeholderFont) + +import Data.Text.ParagraphLayout.Rich (constructParagraph, + defaultParagraphOptions, defaultTextOptions, + InnerNode(..), Box(..), RootNode(..)) +import Data.Text.ParagraphLayout (PageOptions(..)) +import Data.Text.Glyphize (Direction(..)) + import Graphics.Layout.Grid.CSS (parseASCIIGrid) import qualified Data.HashMap.Lazy as HM @@ -303,6 +315,102 @@ spec = do test [["head", "nav", "head"]] test [["head"], ["nav"], ["head"]] test [["head", "head"], ["head", "nav"]] + describe "" $ do + it "parses to grids" $ do + --
+ -- + -- + -- + -- + --
Test table
ABC
DE
FGH
+ let text' txt = StyleTree temp { inlineStyles = plaintext txt } [] + let table :: StyleTree (CSSBox ()) + table = StyleTree temp { display = Table } [ + StyleTree temp { display = TableHeaderGroup } [ + StyleTree temp { display = TableRow } [ + StyleTree temp { display = TableCell } [text' "A"], + StyleTree temp { + display = TableCell, + tableOptions = temp { rowspan = 2 } + } [text' "B"], + StyleTree temp { display = TableCell } [text' "C"] + ] + ], + StyleTree temp { display = TableRowGroup } [ + StyleTree temp { display = TableRow } [ + StyleTree temp { + display = TableCell, + tableOptions = temp { colspan = 2 } + } [text' "D"], + StyleTree temp { + display = TableCell, + tableOptions = temp { colspan = 2 } + } [text' "E"] + ] + ], + StyleTree temp { display = TableFooterGroup } [ + StyleTree temp { display = TableRow } [ + StyleTree temp { display = TableCell } [text' "F"], + StyleTree temp { display = TableCell } [text' "G"], + StyleTree temp { display = TableCell } [text' "H"] + ] + ], + StyleTree temp { display = TableCaption } [text' "Test table"] + ] + let defaultPageOptions = PageOptions 0 0 2 2 + let gridItem x y = GridItem { + cellStart = x, cellEnd = y, + alignment = Start, + minSize = 0, natSize = 0 + } + let track cells' = Track { + cells = cells', + trackMins = [], trackNats = [], gap = Pixels 0 + } + let inline txt = LayoutInline () (constructParagraph "" ( + RootBox $ Box [ + TextSequence ((placeholderFont, 12), zero, ()) txt + ] $ defaultTextOptions DirLTR + ) "" defaultParagraphOptions) defaultPageOptions + finalizeCSS placeholderFont placeholderFont table `shouldBe` + LayoutFlow () lengthBox [ + LayoutFlow () lengthBox [inline "Test table"], + LayoutGrid () Size { + inline = track [Left Auto, Left Auto, Left Auto, Left Auto, Left Auto, Left Auto], + block = track [Left Auto, Left Auto, Left Auto] + } [ + gridItem 0 6 `Size` gridItem 0 1, + gridItem 0 6 `Size` gridItem 1 2, + gridItem 0 6 `Size` gridItem 2 3, + gridItem 0 6 `Size` gridItem 3 4, + gridItem 0 6 `Size` gridItem 4 5, + gridItem 0 6 `Size` gridItem 5 6, + gridItem 1 2 `Size` gridItem 0 1, + gridItem 3 4 `Size` gridItem 0 2, + gridItem 5 6 `Size` gridItem 0 1, + gridItem 1 3 `Size` gridItem 1 2, + gridItem 4 6 `Size` gridItem 1 2, + gridItem 1 2 `Size` gridItem 2 3, + gridItem 3 4 `Size` gridItem 2 3, + gridItem 5 6 `Size` gridItem 2 3 + ] [ + LayoutFlow () lengthBox [], + LayoutFlow () lengthBox [], + LayoutFlow () lengthBox [], + LayoutFlow () lengthBox [], + LayoutFlow () lengthBox [], + LayoutFlow () lengthBox [], + LayoutFlow () lengthBox [inline "A"], + LayoutFlow () lengthBox [inline "B"], + LayoutFlow () lengthBox [inline "C"], + LayoutFlow () lengthBox [inline "D"], + LayoutFlow () lengthBox [inline "E"], + LayoutFlow () lengthBox [inline "F"], + LayoutFlow () lengthBox [inline "G"], + LayoutFlow () lengthBox [inline "H"] + ] + ] + runMath = flip evalCalc [] . mapCalc fst . flip parseCalc [] . filter (/= Whitespace) . tokenize -- 2.30.2