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
{ module XML.Selectors.CSS.Parse (parsePath) where
import XML.Selectors.CSS.Tokens (lexer)
import XML.Selectors.CSS.Types
}
%name cssPath
%tokentype { Token }
%error { parseError }
%monad { Either String }
%token
sp { TokenSpace }
name { TokenName $$ }
string { TokenString $$ }
'+' { TokenPlus }
'-' { TokenMinus }
'/' { TokenSlash }
'>' { TokenChild }
'~' { TokenAnySibling }
'#' { TokenHash }
firstchild { TokenFirstChild }
lastchild { TokenLastChild }
'.' { TokenDot }
'=' { TokenEquals }
"~=" { TokenIncludes }
"^=" { TokenBeginsWith }
"$=" { TokenEndsWith }
"|=" { TokenDashMatch }
':' { TokenPseudo }
'(' { TokenOP }
')' { TokenCP }
'[' { TokenOB }
']' { TokenCB }
nat { TokenDigits $$ }
'*' { TokenAster }
%%
Selector : SimpleSelector { Selector $1 }
| SimpleSelector Combinator Selector { Combinator $1 $2 $3 }
Combinator : sp { Descendant }
| sp Combinator { $2 }
| '+' { FollowingSibling }
| '+' sp { FollowingSibling }
| '~' { AnySibling }
| '~' sp { AnySibling }
| '>' { Child }
| '>' sp { Child }
SimpleSelector : name { SimpleSelector (Just $1) [] Nothing }
| name specs { SimpleSelector (Just $1) $2 Nothing }
| name specs Pseudo { SimpleSelector (Just $1) $2 (Just $3) }
| specs { SimpleSelector Nothing $1 Nothing }
| specs Pseudo { SimpleSelector Nothing $1 (Just $2) }
| '*' { SimpleSelector Nothing [] Nothing }
specs : Specifier { [$1] }
| specs Specifier { $2 : $1 }
Specifier : '#' name { ID $2 }
| '.' name { Class $2 }
| '[' attr ']' { $2 }
| '[' attr sp ']' { $2 }
attr : name Pred { Attrib $1 $2 }
| sp attr { $2 }
Pred : sp Pred { $2 }
| PredOp sp string { Pred $1 $3 }
| PredOp string { Pred $1 $2 }
PredOp : '=' { Equals }
| "~=" { Includes }
| "|=" { DashMatch }
| "^=" { BeginsWith }
| "$=" { EndsWith }
Pseudo : ':' firstchild { FirstChild }
| ':' lastchild { LastChild }
{
parseError toks = Left $ "parse error: " ++ show toks
parsePath :: String -> Either String Selector
parsePath str = lexer str >>= cssPath
}