~alcinnz/haskell-stylist

0a7e279a67e8afcd5dcd90fc62921ffadbe1bb0f — Adrian Cochrane 8 months ago e4585f4
Packaging improvements.
M ChangeLog.md => ChangeLog.md +3 -0
@@ 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.

M stylist-traits/src/Stylist.hs => stylist-traits/src/Stylist.hs +16 -2
@@ 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'

M stylist-traits/src/Stylist/Tree.hs => stylist-traits/src/Stylist/Tree.hs +13 -0
@@ 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']

M stylist-traits/stylist-traits.cabal => stylist-traits/stylist-traits.cabal +2 -2
@@ 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

M stylist.cabal => stylist.cabal +4 -3
@@ 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