~alcinnz/haskell-stylist

ref: 062bdd9817d994a3473b659c499b62b938a6c6a0 haskell-stylist/src/Stylish/Parse.hs -rw-r--r-- 3.5 KiB
062bdd98 — Adrian Cochrane Unit test the selector compiler. 5 years 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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
module Stylish.Parse (
        parse, TrivialStyleSheet(..),
        skipAtRule,
        StyleSheet, addRule, addAtRule,
        StyleRule(..),
        Selector(..), SimpleSelector(..), PropertyTest(..)
    ) where

import Data.CSS.Syntax.Tokens
import Stylish.Parse.Selector
import Stylish.Parse.Utils

import Data.Text.Internal (Text(..))

--------
---- Output type class
--------
class StyleSheet s where
    addRule :: s -> StyleRule -> s
    addAtRule :: s -> Text -> [Token] -> (s, [Token])
    addAtRule self _ tokens = (self, skipAtRule tokens)

addRules self (selector:selectors, properties) = addRules self' (selectors, properties)
    where self' = addRule self $ StyleRule selector properties
addRules self ([], _) = self

data StyleRule = StyleRule Selector [(Text, [Token])] deriving (Show, Eq)

data TrivialStyleSheet = TrivialStyleSheet [StyleRule] deriving (Show, Eq)
instance StyleSheet TrivialStyleSheet where
    addRule (TrivialStyleSheet self) rule = TrivialStyleSheet $ rule:self

--------
---- Basic parsing
--------
parse :: StyleSheet s => s -> Text -> s
parse stylesheet source = parse' stylesheet $ tokenize source

-- Things to skip.
parse' stylesheet (Whitespace:tokens) = parse' stylesheet tokens
parse' stylesheet (CDO:tokens) = parse' stylesheet tokens
parse' stylesheet (CDC:tokens) = parse' stylesheet tokens
parse' stylesheet (Comma:tokens) = parse' stylesheet tokens -- TODO issue warnings.

parse' stylesheet [] = stylesheet

parse' stylesheet (AtKeyword kind:tokens) = parse' stylesheet' tokens'
    where (stylesheet', tokens') = addAtRule stylesheet kind tokens
parse' stylesheet tokens = parse' (addRules stylesheet rule) tokens'
    where (rule, tokens') = concatP (,) parseSelectors parseProperties tokens

--------
---- Property parsing
--------
parseProperties (LeftCurlyBracket:tokens) = parseProperties' tokens
parseProperties (Whitespace:tokens) = parseProperties tokens
parseProperties [] = ([], [])

parseProperties' (Whitespace:tokens) = parseProperties' tokens
parseProperties' (Ident name:tokens)
    | Colon:tokens' <- skipSpace tokens =
        concatP appendProp scanValue parseProperties' tokens'
    where appendProp value tail = (name, value):tail
parseProperties' (RightCurlyBracket:tokens) = ([], tokens)
parseProperties' [] = ([], [])
parseProperties' tokens = parseProperties' (skipValue tokens)

--------
---- Skipping/Scanning utilities
--------
skipAtRule :: [Token] -> [Token]
skipAtRule (Semicolon:tokens) = tokens
skipAtRule (LeftCurlyBracket:tokens) = skipBlock tokens

skipAtRule (LeftParen:tokens) = skipAtRule $ skipBlock tokens
skipAtRule (LeftSquareBracket:tokens) = skipAtRule $ skipBlock tokens
-- To ensure parens are balanced, should already be handled.
skipAtRule (RightCurlyBracket:tokens) = RightCurlyBracket:tokens
skipAtRule (RightParen:tokens) = RightParen:tokens
skipAtRule (RightSquareBracket:tokens) = RightSquareBracket:tokens

skipAtRule (_:tokens) = skipAtRule tokens
skipAtRule [] = []

scanValue (Semicolon:tokens) = ([], tokens)
scanValue (Whitespace:tokens) = scanValue tokens

scanValue (LeftCurlyBracket:tokens) = scanInner tokens scanValue
scanValue (LeftParen:tokens) = scanInner tokens scanValue
scanValue (LeftSquareBracket:tokens) = scanInner tokens scanValue
-- To ensure parens are balanced, should already be handled.
scanValue (RightCurlyBracket:tokens) = ([], RightCurlyBracket:tokens)
scanValue (RightParen:tokens) = ([], RightParen:tokens)
scanValue (RightSquareBracket:tokens) = ([], RightSquareBracket:tokens)

scanValue tokens = capture scanValue tokens

skipValue tokens = snd $ scanValue tokens