~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
                                                                                
ceb3b528 Adrian Cochrane
df951629 Adrian Cochrane
ceb3b528 Adrian Cochrane
df951629 Adrian Cochrane
ceb3b528 Adrian Cochrane
898234de Adrian Cochrane
ceb3b528 Adrian Cochrane
898234de Adrian Cochrane
ceb3b528 Adrian Cochrane
898234de Adrian Cochrane
ceb3b528 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
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