git.iko.soy/elk
on 1925e31 help sign in
elk/src/Parse/Pattern.hs
228 lines 5.1 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 constructorHelp start ctor []
181 , (,,) <$> term <*> getPosition <*> whitespace
182 ]
185exprHelp :: R.Position -> [P.Raw] -> (P.Raw, R.Position, SPos) -> Parser (P.Raw, SPos)
186exprHelp start patterns (pattern, end, sPos) =
187 oneOf
188 [ do checkSpace sPos
189 cons
190 spaces
191 cTerm <- consTerm
192 exprHelp start (pattern:patterns) cTerm
193 , do checkSpace sPos
194 keyword "as"
195 spaces
196 alias <- lowVar
197 newEnd <- getPosition
198 newSpace <- whitespace
199 return
200 ( A.at start newEnd (P.Alias alias (foldl (consHelp end) pattern patterns))
201 , newSpace
202 )
203 , return
204 ( foldl (consHelp end) pattern patterns
205 , sPos
206 )
207 ]
210consHelp :: R.Position -> P.Raw -> P.Raw -> P.Raw
211consHelp end tl hd@(A.A (R.Region start _) _) =
212 A.at start end (P.Ctor (Var.Raw "::") [hd, tl])
215constructorHelp :: R.Position -> Text -> [P.Raw] -> SParser P.Raw
216constructorHelp start ctor args =
217 do end <- getPosition
218 sPos <- whitespace
219 oneOf
220 [ do checkSpace sPos
221 arg <- term
222 constructorHelp start ctor (arg:args)
223 , return
224 ( A.at start end (P.Ctor (Var.Raw ctor) (reverse args))
225 , end
226 , sPos
227 )
228 ]