From 0a7e279a67e8afcd5dcd90fc62921ffadbe1bb0f Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Thu, 20 Jul 2023 12:58:29 +1200 Subject: [PATCH] Packaging improvements. --- ChangeLog.md | 3 +++ stylist-traits/src/Stylist.hs | 18 ++++++++++++++++-- stylist-traits/src/Stylist/Tree.hs | 13 +++++++++++++ stylist-traits/stylist-traits.cabal | 4 ++-- stylist.cabal | 7 ++++--- 5 files changed, 38 insertions(+), 7 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index f8cd3e5..93797eb 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,8 @@ # Revision history for stylist +## 2.7.0.1 -- 2023-06-20 +* Fix build when downloaded from Hackage (was missing a file) + ## 2.7.0 -- 2023-05-16 * Improved crash resiliency in rendering numbers * Allow prioritizing specific properties in cascade. diff --git a/stylist-traits/src/Stylist.hs b/stylist-traits/src/Stylist.hs index cd26888..4c5e44b 100644 --- a/stylist-traits/src/Stylist.hs +++ b/stylist-traits/src/Stylist.hs @@ -78,15 +78,19 @@ data Element = ElementNode { -- | A key-value attribute. data Attribute = Attribute Text Text String deriving (Eq, Ord) +-- | Computes the child indices to traverse to reach the given element. elementPath :: Element -> [Int] elementPath = elementPath' [] +-- | Variant of `elementPath` with a prefix path. elementPath' path ElementNode { parent = Just parent', previous = prev } = elementPath' (succ (countSib prev) : path) parent' elementPath' path ElementNode { parent = Nothing, previous = prev } = (succ (countSib prev) : path) +-- | How many previous children does this element have? countSib (Just (ElementNode { previous = prev })) = succ $ countSib prev countSib Nothing = 0 +-- | Converts a property text into a callback testing against a string. compileAttrTest :: PropertyTest -> String -> Bool compileAttrTest Exists = matched compileAttrTest (Equals val) = (== (unpack val)) @@ -97,13 +101,17 @@ compileAttrTest (Include val) = hasWord $ unpack val compileAttrTest (Dash val) = hasLang $ unpack val compileAttrTest (Callback (PropertyFunc cb)) = cb +-- | returns True regardless of value. matched :: t -> Bool matched _ = True +-- | Tests the given word is in the whitespace-seperated value. hasWord :: String -> String -> Bool hasWord expected value = expected `elem` words value +-- | Tests whether the attribute holds the expected value or a sub-locale. hasLang :: [Char] -> [Char] -> Bool hasLang expected value = expected == value || isPrefixOf (expected ++ "-") value +-- | Test whether the element matches a parsed property test, for the given attribute. attrTest :: Maybe Text -> Text -> PropertyTest -> Element -> Bool attrTest namespace name test ElementNode { attributes = attrs } = any predicate attrs where @@ -111,6 +119,9 @@ attrTest namespace name test ElementNode { attributes = attrs } = any predicate | otherwise = predicate' attr predicate' (Attribute _ name' value') = name == name' && compileAttrTest test value' +-- | Utility for parsing shorthand attributes which don't care in which order the +-- subproperties are specified. +-- Each property must parse only a single function or token. parseUnorderedShorthand :: PropertyParser a => a -> [Text] -> [Token] -> [(Text, [Token])] parseUnorderedShorthand self properties toks @@ -118,19 +129,22 @@ parseUnorderedShorthand self properties toks | otherwise = ret where ret = parseUnorderedShorthand' self properties $ parseOperands toks +-- | Variant of `parseUnorderedShorthand` taking pre-split list. parseUnorderedShorthand' :: PropertyParser a => a -> [Text] -> [[Token]] -> [(Text, [Token])] parseUnorderedShorthand' self properties (arg:args) = inner properties [] where inner (prop:props) props' - | Just _ <- longhand self self prop arg = - parseUnorderedShorthand' self (props' ++ props) args + | entry@(_:_) <- shorthand self prop arg = + entry ++ parseUnorderedShorthand' self (props' ++ props) args | otherwise = inner props (prop:props') inner [] _ = [("", [])] -- Error caught & handled by public API. parseUnorderedShorthand' self (prop:props) [] = -- Shorthands have long effects! (prop, [Ident "initial"]):parseUnorderedShorthand' self props [] parseUnorderedShorthand' _ [] [] = [] +-- | Splits a token list so each function is it's own list. +-- Other tokens are split into their own singletons. parseOperands :: [Token] -> [[Token]] parseOperands (Function name:toks) = let (args, toks') = scanBlock toks in (Function name:args):parseOperands toks' diff --git a/stylist-traits/src/Stylist/Tree.hs b/stylist-traits/src/Stylist/Tree.hs index c1351f7..1624de6 100644 --- a/stylist-traits/src/Stylist/Tree.hs +++ b/stylist-traits/src/Stylist/Tree.hs @@ -4,17 +4,21 @@ module Stylist.Tree(StyleTree(..), treeOrder, treeOrder', Path, treeMap, treeFind, treeFlatten, treeFlattenAll, preorder, preorder', postorder) where +-- | A generic tree, variable numbers of children. data StyleTree p = StyleTree { style :: p, children :: [StyleTree p] } +-- | Indices within the tree. type Path = [Integer] +-- | Preorder traversal of the tree. treeOrder :: (c -> c -> Path -> p -> (c, p')) -> c -> StyleTree p -> StyleTree p' treeOrder cb ctxt tree = StyleTree (snd $ cb ctxt ctxt [] $ style tree) (snd $ treeOrder' cb ctxt ctxt [0] $ children tree) +-- | Preorder traversal of the tree managing per-layer contexts. treeOrder' :: (c -> c -> Path -> p -> (c, p')) -> c -> c -> Path -> [StyleTree p] -> (c, [StyleTree p']) treeOrder' cb prevContext context (num:path) (node:nodes) = (tailContext, StyleTree node' children' : nodes') @@ -25,28 +29,36 @@ treeOrder' cb prevContext context (num:path) (node:nodes) = (tailContext, StyleT treeOrder' _ _ context _ [] = (context, []) treeOrder' _ _ _ [] _ = error "Invalid path during tree traversal!" +-- | Runs a callback over all `style` properties in the tree. treeMap :: (p -> p') -> StyleTree p -> StyleTree p' treeMap cb = treeOrder (\_ _ _ p -> ((), cb p)) () +-- | Flatten a styletree into a list. treeFlatten :: StyleTree p -> [p] treeFlatten = treeFlatten' . children +-- | Flatten a list of styletrees into a list. treeFlatten' :: [StyleTree p] -> [p] treeFlatten' (StyleTree p []:ps) = p : treeFlatten' ps treeFlatten' (StyleTree _ childs:sibs) = treeFlatten' childs ++ treeFlatten' sibs treeFlatten' [] = [] +-- | Flatten a styletree into a list, including parent nodes. treeFlattenAll :: StyleTree p -> [p] treeFlattenAll = treeFlattenAll' . children +-- | Flatten styletrees into a list, including parent nodes. treeFlattenAll' :: [StyleTree p] -> [p] treeFlattenAll' (StyleTree p []:ps) = p : treeFlattenAll' ps treeFlattenAll' (StyleTree p childs:sibs) = p : treeFlattenAll' childs ++ treeFlattenAll' sibs treeFlattenAll' [] = [] +-- | Find the styltree node matching the given predicate. treeFind :: StyleTree p -> (p -> Bool) -> [p] treeFind p test = filter test $ treeFlattenAll p +-- | Preorder traversal over a tree, without tracking contexts. preorder :: (Maybe b -> Maybe b -> a -> b) -> StyleTree a -> StyleTree b preorder cb self = head $ preorder' cb Nothing Nothing [self] +-- | Variant of `preorder` with given parent & previous-sibling. preorder' :: (Maybe b -> Maybe b -> a -> b) -> Maybe b -> Maybe b -> [StyleTree a] -> [StyleTree b] preorder' cb parent previous (self:sibs) = let self' = cb parent previous $ style self @@ -54,6 +66,7 @@ preorder' cb parent previous (self:sibs) = let self' = cb parent previous $ styl preorder' cb parent (Just self') sibs preorder' _ _ _ [] = [] +-- | Postorder traversal over the tree. postorder :: (a -> [b] -> [b]) -> StyleTree a -> [StyleTree b] postorder cb (StyleTree self childs) = [StyleTree self' children' | self' <- cb self $ Prelude.map style children'] diff --git a/stylist-traits/stylist-traits.cabal b/stylist-traits/stylist-traits.cabal index 2326d57..d4295fe 100644 --- a/stylist-traits/stylist-traits.cabal +++ b/stylist-traits/stylist-traits.cabal @@ -10,7 +10,7 @@ name: stylist-traits -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.3.0 +version: 0.1.3.1 -- A short (one-line) description of the package. synopsis: Traits, datatypes, & parsers for Haskell Stylist @@ -65,7 +65,7 @@ library -- other-extensions: -- Other library packages from which modules are imported. - build-depends: base >=4.12 && <4.16, css-syntax >=0.1 && <0.2, text, network-uri >= 2.6 && <2.7 + build-depends: base >=4.12 && <5, css-syntax >=0.1 && <0.2, text, network-uri >= 2.6 && <2.7 -- Directories containing source files. hs-source-dirs: src diff --git a/stylist.cabal b/stylist.cabal index eccaf2c..fd756dd 100644 --- a/stylist.cabal +++ b/stylist.cabal @@ -10,7 +10,7 @@ name: stylist -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 2.7.0.0 +version: 2.7.0.1 -- A short (one-line) description of the package. synopsis: Apply CSS styles to a document tree. @@ -42,7 +42,8 @@ build-type: Simple -- Extra files to be distributed with the package, such as examples or a -- README. -extra-source-files: ChangeLog.md, README.md +extra-source-files: ChangeLog.md, README.md, + src/Data/CSS/Preprocessor/Text/counter-styles.css -- Constraint on the version of Cabal needed to build this package. cabal-version: >=1.10 @@ -71,7 +72,7 @@ library -- Other library packages from which modules are imported. build-depends: base >=4.9 && <5, css-syntax >=0.1 && <0.2, unordered-containers >= 0.2 && <0.3, - hashable >= 1.4.2 && < 1.5, text >= 1.2.4 && < 1.3, + hashable >= 1.4.2 && < 1.5, text >= 2 && < 2.1, network-uri >= 2.6 && <2.7, async >= 2.1 && <2.3, regex-tdfa >=1.3 && <1.4, stylist-traits >=0.1.2 && <0.2, file-embed >= 0.0.10 && < 0.1 -- 2.30.2