~alcinnz/haskell-stylist

ref: be4bb6f0a906a155c74158abcbf6ef0321057072 haskell-stylist/src/Data/CSS/Syntax/StyleSheet.hs -rw-r--r-- 3.8 KiB
be4bb6f0 — Adrian Cochrane Fix parser freezes, blocking issue for Rhapsode. 4 years ago
                                                                                
c1fca3d5 Adrian Cochrane
be4bb6f0 Adrian Cochrane
c1fca3d5 Adrian Cochrane
af343c17 Adrian Cochrane
c1fca3d5 Adrian Cochrane
62b97a58 Adrian Cochrane
c1fca3d5 Adrian Cochrane
be4bb6f0 Adrian Cochrane
c1fca3d5 Adrian Cochrane
be4bb6f0 Adrian Cochrane
c1fca3d5 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
99
100
101
102
module Data.CSS.Syntax.StyleSheet (
        parse, TrivialStyleSheet(..),
        StyleSheet(..), skipAtRule,
        StyleRule(..),
        -- for testing
        scanValue
    ) where

import Data.CSS.Syntax.Tokens
import Data.CSS.Syntax.Selector
import Data.CSS.Syntax.StylishUtil

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
-- This error recovery is a bit overly conservative, but it's simple.
parseProperties (_:tokens) = ([], skipAtRule 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 (Function _: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 tokens@(LeftCurlyBracket:_) = scanInner tokens scanValue
scanValue tokens@(LeftParen:_) = scanInner tokens scanValue
scanValue tokens@(Function _:_) = scanInner tokens scanValue
scanValue tokens@(LeftSquareBracket:_) = 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