git.iko.soy/elk
on fcf5cef help sign in
elk/src/Parse/Pattern.hs
206 lines 4.3 kB history raw
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Parse.Pattern (term, expression) where
5import Data.Text (Text)
7import qualified AST.Pattern as P
8import qualified AST.Variable as Var
9import Parse.Helpers
10import qualified Parse.Literal as Literal
11import qualified Reporting.Annotation as A
12import qualified Reporting.Region as R
16-- PATTERN TERMS
19term :: Parser P.Raw
20term =
21 oneOf [ record, tuple, list, termHelp ]
24termHelp :: Parser P.Raw
25termHelp =
26 addLocation $
27 oneOf
28 [ do underscore
29 return P.Anything
30 , P.Var <$> lowVar
31 , mkCtor <$> qualifiedCapVar
32 , P.Literal <$> Literal.literal
33 ]
36mkCtor :: Text -> P.Raw'
37mkCtor ctor =
38 P.Ctor (Var.Raw ctor) []
42-- RECORDS
45record :: Parser P.Raw
46record =
47 addLocation $
48 do leftCurly
49 spaces
50 oneOf
51 [ do var <- lowVar
52 spaces
53 recordHelp [var]
54 , do rightCurly
55 return (P.Record [])
56 ]
59recordHelp :: [Text] -> Parser P.Raw'
60recordHelp vars =
61 oneOf
62 [ do comma
63 spaces
64 var <- lowVar
65 spaces
66 recordHelp (var:vars)
67 , do rightCurly
68 return (P.Record vars)
69 ]
73-- TUPLES
76tuple :: Parser P.Raw
77tuple =
78 do start <- getPosition
79 leftParen
80 spaces
81 oneOf
82 [ do (pattern, space) <- expression
83 checkSpaces space
84 tupleHelp start [pattern]
85 , do rightParen
86 end <- getPosition
87 return (A.at start end (P.tuple []))
88 ]
91tupleHelp :: R.Position -> [P.Raw] -> Parser P.Raw
92tupleHelp start patterns =
93 oneOf
94 [ do comma
95 spaces
96 (pattern, space) <- expression
97 checkSpaces space
98 tupleHelp start (pattern:patterns)
99 , do rightParen
100 case patterns of
101 [pattern] ->
102 return pattern
104 _ ->
105 do end <- getPosition
106 return (A.at start end (P.tuple (reverse patterns)))
107 ]
111-- LIST
114list :: Parser P.Raw
115list =
116 do leftSquare
117 spaces
118 oneOf
119 [ do (pattern, space) <- expression
120 checkSpaces space
121 listHelp [pattern]
122 , do rightSquare
123 end <- getPosition
124 return (P.list end [])
125 ]
128listHelp :: [P.Raw] -> Parser P.Raw
129listHelp patterns =
130 oneOf
131 [ do comma
132 spaces
133 (pattern, space) <- expression
134 checkSpaces space
135 listHelp (pattern:patterns)
136 , do end <- getPosition
137 rightSquare
138 return (P.list end (reverse patterns))
139 ]
143-- PATTERN EXPRESSION
146expression :: Parser (P.Raw, Space)
147expression =
148 do start <- getPosition
149 cTerm <- consTerm
150 exprHelp start [] cTerm
153consTerm :: Parser (P.Raw, R.Position, Space)
154consTerm =
155 oneOf
156 [ do start <- getPosition
157 ctor <- qualifiedCapVar
158 constructorHelp start ctor []
159 , (,,) <$> term <*> getPosition <*> whitespace
160 ]
163exprHelp :: R.Position -> [P.Raw] -> (P.Raw, R.Position, Space) -> Parser (P.Raw, Space)
164exprHelp start patterns (pattern, end, space) =
165 oneOf
166 [ do checkSpaces space
167 cons
168 spaces
169 cTerm <- consTerm
170 exprHelp start (pattern:patterns) cTerm
171 , do checkSpaces space
172 keyword "as"
173 spaces
174 alias <- lowVar
175 newEnd <- getPosition
176 newSpace <- whitespace
177 return
178 ( A.at start newEnd (P.Alias alias (foldl (consHelp end) pattern patterns))
179 , newSpace
180 )
181 , return
182 ( foldl (consHelp end) pattern patterns
183 , space
184 )
185 ]
188consHelp :: R.Position -> P.Raw -> P.Raw -> P.Raw
189consHelp end tl hd@(A.A (R.Region start _) _) =
190 A.at start end (P.Ctor (Var.Raw "::") [hd, tl])
193constructorHelp :: R.Position -> Text -> [P.Raw] -> Parser (P.Raw, R.Position, Space)
194constructorHelp start ctor args =
195 do end <- getPosition
196 space <- whitespace
197 oneOf
198 [ do checkSpaces space
199 arg <- term
200 constructorHelp start ctor (arg:args)
201 , return
202 ( A.at start end (P.Ctor (Var.Raw ctor) (reverse args))
203 , end
204 , space
205 )
206 ]