git.iko.soy/elk
on b09bb00 help sign in
elk/src/Parse/Pattern.hs
215 lines 4.4 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.Region as R
17-- PATTERN TERMS
20term :: Parser P.Raw
21term =
22 oneOf [ record, tuple, list, termHelp ]
25termHelp :: Parser P.Raw
26termHelp =
27 addLocation $
28 oneOf
29 [ do underscore
30 return P.Anything
31 , P.Var <$> lowVar
32 , mkCtor <$> qualifiedCapVar
33 , P.Literal <$> Literal.literal
34 ]
37mkCtor :: Text -> P.Raw'
38mkCtor ctor =
39 case ctor of
40 "True" ->
41 P.Literal (L.Boolean True)
43 "False" ->
44 P.Literal (L.Boolean False)
46 _ ->
47 P.Ctor (Var.Raw ctor) []
51-- RECORDS
54record :: Parser P.Raw
55record =
56 addLocation $
57 do leftCurly
58 spaces
59 oneOf
60 [ do var <- lowVar
61 spaces
62 recordHelp [var]
63 , do rightCurly
64 return (P.Record [])
65 ]
68recordHelp :: [Text] -> Parser P.Raw'
69recordHelp vars =
70 oneOf
71 [ do comma
72 spaces
73 var <- lowVar
74 spaces
75 recordHelp (var:vars)
76 , do rightCurly
77 return (P.Record vars)
78 ]
82-- TUPLES
85tuple :: Parser P.Raw
86tuple =
87 do start <- getPosition
88 leftParen
89 spaces
90 oneOf
91 [ do (pattern, sPos) <- expression
92 checkSpace sPos
93 tupleHelp start [pattern]
94 , do rightParen
95 end <- getPosition
96 return (A.at start end (P.tuple []))
97 ]
100tupleHelp :: R.Position -> [P.Raw] -> Parser P.Raw
101tupleHelp start patterns =
102 oneOf
103 [ do comma
104 spaces
105 (pattern, sPos) <- expression
106 checkSpace sPos
107 tupleHelp start (pattern:patterns)
108 , do rightParen
109 case patterns of
110 [pattern] ->
111 return pattern
113 _ ->
114 do end <- getPosition
115 return (A.at start end (P.tuple (reverse patterns)))
116 ]
120-- LIST
123list :: Parser P.Raw
124list =
125 do leftSquare
126 spaces
127 oneOf
128 [ do (pattern, sPos) <- expression
129 checkSpace sPos
130 listHelp [pattern]
131 , do rightSquare
132 end <- getPosition
133 return (P.list end [])
134 ]
137listHelp :: [P.Raw] -> Parser P.Raw
138listHelp patterns =
139 oneOf
140 [ do comma
141 spaces
142 (pattern, sPos) <- expression
143 checkSpace sPos
144 listHelp (pattern:patterns)
145 , do end <- getPosition
146 rightSquare
147 return (P.list end (reverse patterns))
148 ]
152-- PATTERN EXPRESSION
155expression :: Parser (P.Raw, SPos)
156expression =
157 do start <- getPosition
158 cTerm <- consTerm
159 exprHelp start [] cTerm
162consTerm :: SParser P.Raw
163consTerm =
164 oneOf
165 [ do start <- getPosition
166 ctor <- qualifiedCapVar
167 constructorHelp start ctor []
168 , (,,) <$> term <*> getPosition <*> whitespace
169 ]
172exprHelp :: R.Position -> [P.Raw] -> (P.Raw, R.Position, SPos) -> Parser (P.Raw, SPos)
173exprHelp start patterns (pattern, end, sPos) =
174 oneOf
175 [ do checkSpace sPos
176 cons
177 spaces
178 cTerm <- consTerm
179 exprHelp start (pattern:patterns) cTerm
180 , do checkSpace sPos
181 keyword "as"
182 spaces
183 alias <- lowVar
184 newEnd <- getPosition
185 newSpace <- whitespace
186 return
187 ( A.at start newEnd (P.Alias alias (foldl (consHelp end) pattern patterns))
188 , newSpace
189 )
190 , return
191 ( foldl (consHelp end) pattern patterns
192 , sPos
193 )
194 ]
197consHelp :: R.Position -> P.Raw -> P.Raw -> P.Raw
198consHelp end tl hd@(A.A (R.Region start _) _) =
199 A.at start end (P.Ctor (Var.Raw "::") [hd, tl])
202constructorHelp :: R.Position -> Text -> [P.Raw] -> SParser P.Raw
203constructorHelp start ctor args =
204 do end <- getPosition
205 sPos <- whitespace
206 oneOf
207 [ do checkSpace sPos
208 arg <- term
209 constructorHelp start ctor (arg:args)
210 , return
211 ( A.at start end (P.Ctor (Var.Raw ctor) (reverse args))
212 , end
213 , sPos
214 )
215 ]