M Graphics/Layout.hs => Graphics/Layout.hs +20 -1
@@ 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
M Graphics/Layout/CSS/Length.hs => Graphics/Layout/CSS/Length.hs +2 -0
@@ 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
M Graphics/Layout/Grid.hs => Graphics/Layout/Grid.hs +1 -1
@@ 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.
M Graphics/Layout/Inline.hs => Graphics/Layout/Inline.hs +1 -0
@@ 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.
M Graphics/Layout/Inline/CSS.hs => Graphics/Layout/Inline/CSS.hs +5 -1
@@ 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
M cattrap.cabal => cattrap.cabal +6 -4
@@ 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
M test/Test.hs => test/Test.hs +108 -0
@@ 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 "<table>" $ do
+ it "parses to grids" $ do
+ -- <table>
+ -- <caption>Test table</caption>
+ -- <thead><tr><th>A</th><th rowspan="2">B</th><th>C</th></tr></thead>
+ -- <tbody><tr><td colspan="2">D</td><td colspan="2">E</td></tr></tbody>
+ -- <tfoot><tr><td>F</td><td>G</td><td>H</td></tr></tfoot>
+ -- </table>
+ 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