~alcinnz/haskell-stylist

ref: 9e14bcfe44ee71d1aa76548c9e04c7d91039218e haskell-stylist/src/Data/CSS/Preprocessor/Text.hs -rw-r--r-- 2.6 KiB
9e14bcfe — Adrian Cochrane Parse CSS counters. 4 years ago
                                                                                
9e14bcfe 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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
{-# LANGUAGE OverloadedStrings #-}
-- | Lowers certain CSS properties to plain text.
module Data.CSS.Preprocessor.Text(TextStyle, resolve) where

import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
import Data.CSS.Style (PropertyParser(..))
import Data.Text
import Data.Maybe (fromMaybe)

-- | `PropertyParser` decorator that parses & lowers certain CSS properties to plain text.
data TextStyle p = TextStyle {
    inner :: p,
    content :: [Token],

    counterReset :: [(Text, Integer)],
    counterIncrement :: [(Text, Integer)],
    counterSet :: [(Text, Integer)]
}

instance PropertyParser p => PropertyParser (TextStyle p) where
    temp = TextStyle {
            inner = temp,
            content = [],
            counterReset = [],
            counterIncrement = [],
            counterSet = []
        }
    inherit parent = TextStyle {
            inner = inherit $ inner parent,
            content = [],
            counterReset = [],
            counterIncrement = [],
            counterSet = []
        }

    shorthand self "content" value = shorthand (inner self) "content" $ removeCounters value
    shorthand _ key value
        | key `elem` ["counter-reset", "counter-increment", "counter-set"],
            Just _ <- parseCounters 0 value = [(key, value)]
    shorthand self key value = shorthand (inner self) key value

    longhand _ self "content" value = Just $ self {content = value}
    longhand _ self "counter-reset" value = (\v -> self {counterReset = v}) <$> parseCounters 0 value
    longhand _ self "counter-increment" value = (\v -> self {counterIncrement = v}) <$> parseCounters 1 value
    longhand _ self "counter-set" value = (\v -> self {counterSet = v}) <$> parseCounters 0 value
    longhand parent self key value = (\v -> self {inner = v}) <$> longhand (inner parent ) (inner self) key value

removeCounters :: [Token] -> [Token]
removeCounters (Function "counter":Ident _:RightParen:toks) = String "" : removeCounters toks
removeCounters (Function "counters":Ident _:Comma:String _:toks) = String "" : removeCounters toks
removeCounters (tok:toks) = tok : removeCounters toks
removeCounters [] = []

parseCounters :: Integer -> [Token] -> Maybe [(Text, Integer)]
parseCounters _ [Ident "none"] = Just []
parseCounters _ [] = Just []
parseCounters x (Ident counter : Number _ (NVInteger count') : toks) =
    (:) (counter, count') <$> parseCounters x toks
parseCounters x (Ident counter : toks) = (:) (counter, x) <$> parseCounters x toks
parseCounters _ _ = Nothing

resolve :: PropertyParser p => TextStyle p -> p
resolve TextStyle {inner = inner', content = content'} =
    fromMaybe inner' $ longhand temp inner' "content" content'