~alcinnz/haskell-stylist

ref: 8880b12954c89968308b18a3ab6c2f50cbd948bc haskell-stylist/src/Data/CSS/StyleTree.hs -rw-r--r-- 1.9 KiB
8880b129 — Adrian Cochrane Minor fix to repair the testsuite! 11 months ago
                                                                                
5f40f7e8 Adrian Cochrane
a73ae441 Adrian Cochrane
3e92f6c3 Adrian Cochrane
e3beef67 Adrian Cochrane
3e92f6c3 Adrian Cochrane
5f40f7e8 Adrian Cochrane
3e92f6c3 Adrian Cochrane
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 = []