git.iko.soy/elk
on fe7bbbd help sign in
elk/src/Parse/Pattern.hs
243 lines 5.5 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.Literal as L
8import qualified AST.Pattern as P
9import qualified AST.Variable as Var
10import Parse.Helpers
11import qualified Parse.Literal as Literal
12import qualified Reporting.Annotation as A
13import qualified Reporting.Error.Syntax as E
14import qualified Reporting.Region as R
18-- PATTERN TERMS
21term :: Parser P.Raw
22term =
23 hint E.Pattern $
24 do start <- getPosition
25 oneOf
26 [ record start
27 , tuple start
28 , list start
29 , termHelp start
30 ]
33termHelp :: R.Position -> Parser P.Raw
34termHelp start =
35 do pattern <-
36 oneOf
37 [ underscore >> return P.Anything
38 , P.Var <$> lowVar
39 , mkCtor <$> qualifiedCapVar
40 , P.Literal <$> Literal.literal
41 ]
42 end <- getPosition
43 return (A.at start end pattern)
46mkCtor :: Text -> P.Raw'
47mkCtor ctor =
48 case ctor of
49 "True" ->
50 P.Literal (L.Boolean True)
52 "False" ->
53 P.Literal (L.Boolean False)
55 _ ->
56 P.Ctor (Var.Raw ctor) []
60-- RECORDS
63record :: R.Position -> Parser P.Raw
64record start =
65 do leftCurly
66 inContext start E.ExprRecord $
67 do spaces
68 oneOf
69 [ do var <- lowVar
70 spaces
71 recordHelp start [var]
72 , do rightCurly
73 end <- getPosition
74 return (A.at start end (P.Record []))
75 ]
78recordHelp :: R.Position -> [Text] -> Parser P.Raw
79recordHelp start vars =
80 oneOf
81 [ do comma
82 spaces
83 var <- lowVar
84 spaces
85 recordHelp start (var:vars)
86 , do rightCurly
87 end <- getPosition
88 return (A.at start end (P.Record vars))
89 ]
93-- TUPLES
96tuple :: R.Position -> Parser P.Raw
97tuple start =
98 do leftParen
99 inContext start E.ExprTuple $
100 do spaces
101 oneOf
102 [ do (pattern, sPos) <- expression
103 checkSpace sPos
104 tupleHelp start [pattern]
105 , do rightParen
106 end <- getPosition
107 return (A.at start end (P.tuple []))
108 ]
111tupleHelp :: R.Position -> [P.Raw] -> Parser P.Raw
112tupleHelp start patterns =
113 oneOf
114 [ do comma
115 spaces
116 (pattern, sPos) <- expression
117 checkSpace sPos
118 tupleHelp start (pattern:patterns)
119 , do rightParen
120 case patterns of
121 [pattern] ->
122 return pattern
124 _ ->
125 do end <- getPosition
126 return (A.at start end (P.tuple (reverse patterns)))
127 ]
131-- LIST
134list :: R.Position -> Parser P.Raw
135list start =
136 do leftSquare
137 inContext start E.PatternList $
138 do spaces
139 oneOf
140 [ do (pattern, sPos) <- expression
141 checkSpace sPos
142 listHelp [pattern]
143 , do rightSquare
144 end <- getPosition
145 return (P.list end [])
146 ]
149listHelp :: [P.Raw] -> Parser P.Raw
150listHelp patterns =
151 oneOf
152 [ do comma
153 spaces
154 (pattern, sPos) <- expression
155 checkSpace sPos
156 listHelp (pattern:patterns)
157 , do end <- getPosition
158 rightSquare
159 return (P.list end (reverse patterns))
160 ]
164-- PATTERN EXPRESSION
167expression :: Parser (P.Raw, SPos)
168expression =
169 hint E.Pattern $
170 do start <- getPosition
171 cTerm <- consTerm
172 exprHelp start [] cTerm
175consTerm :: SParser P.Raw
176consTerm =
177 oneOf
178 [ do start <- getPosition
179 ctor <- qualifiedCapVar
180 case ctor of
181 "True" -> boolEnd start True
182 "False" -> boolEnd start False
183 _ -> constructorHelp start ctor []
185 , (,,) <$> term <*> getPosition <*> whitespace
186 ]
189boolEnd :: R.Position -> Bool -> SParser P.Raw
190boolEnd start bool =
191 do end <- getPosition
192 sPos <- whitespace
193 return
194 ( A.at start end $ P.Literal (L.Boolean bool)
195 , end
196 , sPos
197 )
200exprHelp :: R.Position -> [P.Raw] -> (P.Raw, R.Position, SPos) -> Parser (P.Raw, SPos)
201exprHelp start patterns (pattern, end, sPos) =
202 oneOf
203 [ do checkSpace sPos
204 cons
205 spaces
206 cTerm <- consTerm
207 exprHelp start (pattern:patterns) cTerm
208 , do checkSpace sPos
209 keyword "as"
210 spaces
211 alias <- lowVar
212 newEnd <- getPosition
213 newSpace <- whitespace
214 return
215 ( A.at start newEnd (P.Alias alias (foldl (consHelp end) pattern patterns))
216 , newSpace
217 )
218 , return
219 ( foldl (consHelp end) pattern patterns
220 , sPos
221 )
222 ]
225consHelp :: R.Position -> P.Raw -> P.Raw -> P.Raw
226consHelp end tl hd@(A.A (R.Region start _) _) =
227 A.at start end (P.Ctor (Var.Raw "::") [hd, tl])
230constructorHelp :: R.Position -> Text -> [P.Raw] -> SParser P.Raw
231constructorHelp start ctor args =
232 do end <- getPosition
233 sPos <- whitespace
234 oneOf
235 [ do checkSpace sPos
236 arg <- term
237 constructorHelp start ctor (arg:args)
238 , return
239 ( A.at start end (P.Ctor (Var.Raw ctor) (reverse args))
240 , end
241 , sPos
242 )
243 ]