~alcinnz/haskell-stylist

ref: 4d148074125e584a21eb4d9771994e091afb1738 haskell-stylist/src/Data/CSS/StyleTree.hs -rw-r--r-- 1.9 KiB
4d148074 — Adrian Cochrane Unit tests & bug fixes for counter-renderers. 1 year, 6 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
-- | Abstracts away tree traversals.
-- Mostly used by callers including (soon) XML Conduit Stylist,
-- but also used internally for generating counter text.
--
-- Backwards compatability module, this API has been moved out into "stylist-traits".
-- Though it also contains integration between the styletree & styling APIs.
{-# LANGUAGE OverloadedStrings #-}
module Data.CSS.StyleTree(StyleTree(..), treeOrder, treeOrder',
    Path, treeMap, treeFlatten, preorder, preorder', postorder,
    stylize, inlinePseudos) where

import Stylist.Tree -- Mainly for reexports

import Stylist
import Data.CSS.Style
import Data.CSS.Syntax.StyleSheet (parseProperties')
import Data.CSS.Syntax.Tokens
import Data.Text (Text, pack)
import Data.HashMap.Strict as M (toList)
import Data.Maybe (fromMaybe)

stylize :: PropertyParser s => QueryableStyleSheet s -> StyleTree Element -> StyleTree [(Text, s)]
stylize = preorder . stylize'
stylize' :: PropertyParser s => QueryableStyleSheet s -> Maybe [(Text, s)] -> Maybe [(Text, s)] ->
        Element -> [(Text, s)]
stylize' stylesheet parent' _ el = ("", base) : [
        (k, cascade' v [] base) | (k, v) <- M.toList $ queryRules stylesheet el
    ] where
        base = cascade stylesheet el overrides $ fromMaybe temp $ lookup "" =<< parent'
        overrides = concat [fst $ parseProperties' $ tokenize $ pack val
            | Attribute "style" _ val <- attributes el]

inlinePseudos :: PropertyParser s => StyleTree [(Text, VarParser s)] -> StyleTree s
inlinePseudos (StyleTree self childs) = StyleTree {
        style = fromMaybe temp $ innerParser <$> lookup "" self,
        children = pseudo "before" ++ map inlinePseudos childs ++ pseudo "after"
    } where
        pseudo n
            | Just sty <- innerParser <$> lookup n self,
                Just style' <- longhand sty sty "::" [Ident n] = [StyleTree style' []]
            | Just sty <- innerParser <$> lookup n self = [StyleTree sty []]
            | otherwise = []