cattrap 0.3.1.0 → 0.4.0.0

raw patch · 9 files changed

+81/−17 lines, 9 filesdep ~bytestringdep ~containersdep ~css-syntaxPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: bytestring, containers, css-syntax, data-array-byte, deepseq, directory, file-embed, html-conduit, hurl, hurl-xml, network-uri, parallel, scientific, sdl2, stylist, text, unordered-containers, xml, xml-conduit-stylist

API changes (from Hackage documentation)

Files

• Graphics/Layout.hs +3/−2
• Graphics/Layout/Box.hs +9/−0
• Graphics/Layout/CSS.hs +3/−0
• Graphics/Layout/Grid.hs +1/−1
• Graphics/Layout/Grid/CSS.hs +1/−0
• Graphics/Layout/Grid/Table.hs +29/−3
• Graphics/Layout/Inline.hs +9/−2
• Graphics/Layout/Inline/CSS.hs +8/−0
• cattrap.cabal +18/−9

@@ -9,7 +9,7 @@         boxMinWidth, boxMaxWidth, boxNatWidth, boxWidth,         boxNatHeight, boxMinHeight, boxMaxHeight, boxHeight,         boxSplit, boxPaginate, boxPosition, boxLayout,-        glyphs, codepoints, fragmentFont, {-, glyphsPerFont-}) where+        glyphs, codepoints, fragmentFont, glyphsPerFont) where  import Data.Text.ParagraphLayout.Rich (Paragraph(..), ParagraphOptions(..),                                 ParagraphLayout(..), layoutRich)@@ -66,7 +66,7 @@         NFData (LayoutItem m n x) where     rnf = rnf . layoutGetBox -- Avoid auxiliary properties that don't cleanly `rnf` ---- | Retrieve the surrounding box for a layout item.+-- | Retrieve the surrounding box for a layout item. layoutGetBox :: (Zero m, Zero n, CastDouble m, CastDouble n) =>         LayoutItem m n x -> PaddedBox m n layoutGetBox (LayoutFlow _ ret _) = ret@@ -101,6 +101,7 @@ layoutGetInner (LayoutConst ret _ _) = ret layoutGetInner (LayoutSpan x) = treeInner x +-- | Retrieve the font associated with inline layout. fragmentFont x = let (ret, _, _) = treeInner' x in ret  -- | map-ready wrapper around `setCellBox` sourcing from a child node.

@@ -117,11 +117,17 @@ maxHeight PaddedBox {..} = top margin + top border + top padding +     block max + bottom padding + bottom border + bottom margin +-- | Amount of whitespace to the left, summing margins, borders, & padding. leftSpace PaddedBox {..} = left margin + left border + left padding+-- | Amount of whitespace to the right, summing margins, borders, & padding. rightSpace PaddedBox {..} = right margin + right border + right padding+-- | Amount of whitespace to the top, summing margins, borders, & padding. topSpace PaddedBox {..} = top margin + top border + top padding+-- | Amount of whitespace to the bottom, summing margins, borders, & padding. bottomSpace PaddedBox {..} = bottom margin + bottom border + bottom padding+-- | Amount of whitespace along the x axis, summing margins, borders, & padding. hSpace self = leftSpace self + rightSpace self+-- | Amount of whitespace along the y axis, summing margins, borders, & padding. vSpace self = topSpace self + bottomSpace self  -- | A partially-computed length value.@@ -148,6 +154,7 @@ mapAuto x Min = Pixels x mapAuto _ x = x +-- | Typeclass for zeroing out fields, so layout primitives can be more reusable. class Zero a where     -- | Return the empty (or zero) value for a CatTrap geometric type.     zero :: a@@ -167,6 +174,8 @@ instance (Zero m, Zero n) => Zero (Border m n) where     zero = Border zero zero zero zero +-- | Typeclass for converting between doubles & layout types, approximately if needs be.+-- So layout primitives can be more reusable. class CastDouble a where     -- | Convert a double to a double or length.     fromDouble :: Double -> a

@@ -28,6 +28,7 @@ instance (PropertyParser x, Zero m, Zero n) => Default (UserData m n x) where     def = ((placeholderFont, 0), zero, temp) +-- | Resolves length units in properties handled by downstream components. inner' :: PropertyParser x => Font' -> CSSBox x -> x inner' f self = foldr apply (inner self) $ innerProperties self   where apply (k, v) ret = fromMaybe ret $@@ -74,6 +75,7 @@         (finalizeChilds root font_ self' childs)   where     font_ = pattern2font (font self') (font' self') parent root+-- | Desugars parsed CSS with a provided system font into more generic layout parameters. finalizeCSS' sysfont self@StyleTree { style = self' } =     finalizeCSS (pattern2font (font self') (font' self') sysfont sysfont) sysfont self @@ -274,6 +276,7 @@     isRowGroup (StyleTree CSSBox { display = TableColumnGroup } _) = True     isRowGroup _ = False +-- | Applies border-collapse to a table element. collapseTBorders' :: CSSBox x -> CSSBox x collapseTBorders' self = self {     cssBox = collapseTBorders (tableOptions self) (cssBox self)

@@ -152,7 +152,7 @@     align _ Start = 0     align excess Mid = excess/2     align excess End = excess--- Compute the maximum size along an axis of a child, for it to be sized to.+-- | Compute the maximum size along an axis of a child, for it to be sized to. cellSize :: CastDouble x => Track x -> GridItem' -> Double cellSize self child = track (cellEnd child) - track (cellStart child)   where

@@ -18,6 +18,7 @@ import Graphics.Layout.Grid import Graphics.Layout +-- | Mapping from area identifiers to bounding boxes. type Areas = HM.HashMap Text ((Int, Int), (Int, Maybe Int))  -- | Converts a grid to lookup table start & indices for row & columns.

@@ -1,4 +1,6 @@ {-# LANGUAGE OverloadedStrings, ViewPatterns #-}+-- | Datastructures for parsing table styling properties,+-- & for positioning cells into Grid layout regions. module Graphics.Layout.Grid.Table where  import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))@@ -13,22 +15,36 @@ import Text.Read (readMaybe) import Data.Text (unpack) +-- | Tracks `rowspan` attributes so later rows can dodge it. type Overflowed = [Int] +-- | A row with no cells overflowing into it. emptyRow :: Overflowed emptyRow = [] +-- | Decrement all `rowspan`s being overflowed, removing 0'd ones. commitRow :: Overflowed -> Overflowed commitRow = map $ Prelude.max 0 . pred +-- | Find the next column which a previous multi-row cell hasn't called "dibs" on. allocCol :: Int -> Overflowed -> Int allocCol ix cols = ix + length (span (> 0) $ drop ix cols) +-- | Splice a newly-allocated cell covernig `colspan` (2nd arg) & `rowspan` (3rd arg)+-- from "ix" (from 1st arg) into the final arg. insertCell :: Int -> Int -> Int -> Overflowed -> Overflowed-insertCell ix colspan rowspan cols =-    before ++ replicate colspan rowspan ++ drop colspan after-  where (before, after) = splitAt ix cols+insertCell ix colspan rowspan cols = before ++ inner colspan after+  where+    (before, after) = splitAt ix cols+    inner x cols' | x <= 0 = cols'+    inner colspan (col:cols') = Prelude.max col rowspan:inner (pred colspan) cols'+    inner x [] = replicate x colspan +-- | Parsed CSS properties & HTML attributes for laying out "table" elements.+-- To parse HTML attributes, expects the following useragent stylesheet rules:+--+-- [rowspan] { -argo-rowspan: attr(rowspan) }+-- [colspan] { -argo-colspan: attr(colspan) } data TableOptions = TableOptions {     -- | HTML rowspan attribute     rowspan :: Int,@@ -96,31 +112,41 @@      longhand _ _ _ _ = Nothing +-- | Resolve any units in the "border-spacing" property according to the given font.+-- If "border-collapse" is set, removes this spacing. finalizeGap :: TableOptions -> Font' -> (Length, Length) finalizeGap TableOptions { borderCollapse = True } _ = (Pixels 0, Pixels 0) finalizeGap TableOptions { borderHSpacing = x, borderVSpacing = y } font =     (finalizeLength x font, finalizeLength y font) +-- | Shorthand for a padded box without its CSS units resolved, simplifies type signatures. type UPaddedBox = PaddedBox Unitted Unitted+-- | Removes margins & halves borders if "border-collapse" is set,+-- as per the CSS specification. Apply this on the table cells, rows, & columns. collapseBorders :: TableOptions -> UPaddedBox -> UPaddedBox collapseBorders TableOptions { borderCollapse = False } ret = ret collapseBorders _ box = box {     margin = zero,     border = mapX half $ mapY half $ border box   }+-- | Removes padding & halves borders if "border-collapse" is set,+-- as per the CSS specification. Apply this on the table itself. collapseTBorders :: TableOptions -> UPaddedBox -> UPaddedBox collapseTBorders TableOptions { borderCollapse = False } ret = ret collapseTBorders _ box = box {     padding = zero,     border = mapX half $ mapY half $ border box   }+-- | Helper for halving a unit. half (x,u) = (x/2,u) +-- | Lower vertical alignment to grid alignment options. finalizeVAlign :: TableOptions -> Alignment finalizeVAlign TableOptions { verticalAlign = (_,"top") } = Start finalizeVAlign TableOptions { verticalAlign = (_,"middle") } = Mid finalizeVAlign TableOptions { verticalAlign = (_,"bottom") } = End finalizeVAlign _ = Start -- FIXME: Support baseline alignment!+-- | Lower text alignment to grid alignment. finalizeHAlign :: ParagraphOptions -> Direction -> Alignment finalizeHAlign (paragraphAlignment -> AlignStart) _ = Start finalizeHAlign (paragraphAlignment -> AlignEnd) _ = End

@@ -77,6 +77,7 @@     inner' self@(TextSequence _ _) = self  +-- | A tree extracted from Balkón's inline layout. data FragmentTree x = Branch (AncestorBox x) [FragmentTree x]     | Leaf (Fragment x)     deriving (Show, Eq)@@ -155,11 +156,13 @@ fragmentPos (x, y) self = (x + hbScale (x_min r), y + hbScale (y_min r))     where r = fragmentRect self +-- | Extract the tree datastructure out of Balkón's ParagraphLayout reconstructTree :: Eq x => ParagraphLayout x -> [FragmentTree x] reconstructTree ParagraphLayout { paragraphFragments = frags } =     reconstructTree' [frag {             fragmentAncestorBoxes = reverse $ fragmentAncestorBoxes frag         } | frag <- frags]+-- | Extract the tree datastructure out of Balkón's fragments. reconstructTree' :: Eq x => [Fragment x] -> [FragmentTree x] reconstructTree' (self@Fragment { fragmentAncestorBoxes = [] }:frags) =     Leaf self:reconstructTree' frags@@ -178,12 +181,12 @@     sameBranch Fragment { fragmentAncestorBoxes = [] } = False reconstructTree' [] = [] +-- | Add an X,Y offset to all positions, annotating the userdata. positionTree :: (CastDouble m, CastDouble n) => (Double, Double) ->         FragmentTree (a, PaddedBox m n, c) ->         FragmentTree (a, PaddedBox m n, ((Double, Double), c)) positionTree (x, y) self@(Branch (AncestorBox (a, b, c) d e f g) childs) =-    Branch (AncestorBox (a, b, (pos, c)) d e f g) $-        map (positionTree pos) childs+    Branch (AncestorBox (a, b, (pos, c)) d e f g) $ map (positionTree pos) childs   where     pos = (x + hbScale (x_min rect), y + hbScale (y_min rect))     rect = treeRect self@@ -192,16 +195,20 @@   where     pos = (x + hbScale (x_min rect), y + hbScale (y_min rect))     rect = treeRect self+-- | Retrieve 3rd userdata field. treeInner :: FragmentTree (a, b, c) -> c treeInner (Branch AncestorBox { boxUserData = (_, _, ret) } _) = ret treeInner (Leaf Fragment { fragmentUserData = (_, _, ret) }) = ret+-- | Retrieve userdata field. treeInner' :: FragmentTree a -> a treeInner' (Branch self _) = boxUserData self treeInner' (Leaf self) = fragmentUserData self +-- | Retrieve Harfbuzz data out of the tree extracted from Balkón. glyphs :: FragmentTree x -> [(HB.GlyphInfo, HB.GlyphPos)] glyphs (Branch _ _) = [] glyphs (Leaf self) = fragmentGlyphs self+-- | Retrieve the Unicode codepoints out of the tree extracted from Balkón. codepoints :: FragmentTree x -> [Word32] codepoints self = map HB.codepoint $ map fst $ glyphs self 

@@ -71,6 +71,7 @@         Just $ CSSInline txt opts BdPlainText     longhand _ _ _ _ = Nothing +-- | Fills in properties from looked-up fonts. applyFontInline :: TextOptions -> Font' -> TextOptions applyFontInline opts font = opts {     textFont = hbFont font,@@ -100,6 +101,7 @@ applyBidi (CSSInline _ (textDirection -> dir) _) txt =     trace ("Unexpected direction! " ++ show dir) txt +-- | Append a single character to the end of a string. a +: b = a ++ [b]  chLREmbed, chRLEmbed, chLROverride, chRLOverride, chPopDir,@@ -115,11 +117,15 @@ ch1stStrongIsolate = leaf '\x2068' chPopDirIsolate = leaf '\x2069' +-- | A Balkón fragment holding a magic character. leaf ch = TextSequence def $ Txt.singleton ch +-- | Types with default values.+-- Used to fill in values into generated fragments from caller. class Default a where     def :: a +-- | Converts parsed valign keywords or length units to Balkón alignment. resolveVAlign :: Font' -> Unitted -> VerticalAlignment resolveVAlign _ (_,"top") = AlignLineTop resolveVAlign _ (_,"super") = AlignLineTop -- FIXME: Is there a better translation?@@ -132,9 +138,11 @@ resolveVAlign f x | Pixels y <- finalizeLength x f = AlignBaseline $ toHB y     | Percent y <- finalizeLength x f = AlignBaseline $ toHB $ y * lineheight f     | otherwise = trace ("Invalid length! " ++ show x) $ AlignBaseline 0+-- | Converts grid options to box options. resolveBoxOpts f grid = defaultBoxOptions {     boxVerticalAlignment = resolveVAlign f $ verticalAlign grid   } +-- | Convert from CatTrap units to Balkón|Harfbuzz units. toHB :: Double -> Int32 toHB = toEnum . fromEnum . (*) hbUnit

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                cattrap-version:             0.3.1.0+version:             0.4.0.0 synopsis:            Lays out boxes according to the CSS Box Model. description:         Computes where to place e.g. images, paragraphs, containers, tables, etc onscreen given desired amounts of whitespace. homepage:            https://argonaut-constellation.org/@@ -30,12 +30,13 @@                         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,+  build-depends:       base >=4.12 && <5, containers >= 0.6 && < 1, parallel >= 3 && <4,+                        css-syntax >= 0.1 && < 0.2, scientific >= 0.3 && < 1, text >= 2.0.2,+                        deepseq >= 1.4 && <2, 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, data-array-byte+                        harfbuzz-pure >= 1.0.3.2 && < 1.1, bytestring >= 0.11 && <1,+                        balkon >= 1.2 && <2, unordered-containers >= 0.2 && <1,+                        data-array-byte >= 0.1 && < 0.2   -- hs-source-dirs:   default-language:    Haskell2010   ghc-options:         -Wincomplete-patterns@@ -44,7 +45,8 @@   main-is:             Main.hs   -- other-modules:   -- other-extensions:-  build-depends:       base >=4.12 && <5, cattrap, text, css-syntax, xml, stylist-traits, sdl2 >= 2.5.4+  build-depends:       base >=4.12 && <5, cattrap, text, css-syntax, xml >= 1.3 && < 2,+                        stylist-traits, sdl2 >= 2.5.4   hs-source-dirs:      app   default-language:    Haskell2010 @@ -52,7 +54,12 @@   main-is:             Integration.hs   -- other-modules:   -- other-extensions:-  build-depends:       base >=4.12 && <5, cattrap, text>=2.0.2, css-syntax, stylist-traits, stylist>=2.7.0.1, hurl-xml, hurl, sdl2 >= 2.5.4, containers, network-uri, xml-conduit, directory, xml-conduit-stylist, bytestring, file-embed, deepseq, fontconfig-pure+  build-depends:       base >=4.12 && <5, cattrap, text>=2.0.2, css-syntax,+                        stylist-traits , stylist>=2.7.0.1 && <3,+                        hurl-xml >= 0.2 && < 1, hurl >= 2.3 && < 3,+                        sdl2 >= 2.5.4 && < 2.6, containers, network-uri >=2.6 && <3,+                        xml-conduit, directory >= 1.3 && < 2, xml-conduit-stylist,+                        bytestring, file-embed >= 0.0.15 && < 0.1, deepseq, fontconfig-pure   hs-source-dirs:      app   default-language:    Haskell2010   ghc-options:	-threaded@@ -61,7 +68,9 @@   main-is:             Integration2.hs   -- other-modules:   -- other-extensions:-  build-depends:       base >=4.12 && <5, cattrap, text>=2.0.2, css-syntax, stylist-traits, stylist>=2.7.0.1, network-uri, html-conduit, xml-conduit, xml-conduit-stylist, deepseq, fontconfig-pure+  build-depends:       base >=4.12 && <5, cattrap, text>=2.0.2 && <3, css-syntax,+                        stylist-traits, stylist>=2.7.0.1 && <3, network-uri, html-conduit >=1.3 && <2,+                        xml-conduit, xml-conduit-stylist >= 3 && < 4, deepseq, fontconfig-pure   hs-source-dirs:      app   default-language:    Haskell2010