stylist-traits 0.1.3.0 → 0.1.3.1

raw patch · 3 files changed

+30/−3 lines, 3 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• src/Stylist.hs +16/−2
• src/Stylist/Tree.hs +13/−0
• stylist-traits.cabal +1/−1

@@ -78,15 +78,19 @@ -- | 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 (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 @@             | 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 @@     | 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'

@@ -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' _ _ 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 (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']

@@ -10,7 +10,7 @@ -- 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