git.iko.soy/elk
on ea77dcf help sign in
elk/src/Parse/Pattern.hs
256 lines 6.5 kB history raw
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Parse.Pattern
4 ( term
5 , expression
6 )
7 where
10import qualified Data.List as List
12import qualified AST.Source as Src
13import qualified Elm.Name as N
14import Parse.Primitives (Parser, SParser, SPos, addLocation, checkSpace, getPosition, hint, inContext, spaces, oneOf)
15import qualified Parse.Primitives.Keyword as Keyword
16import qualified Parse.Primitives.Number as Number
17import qualified Parse.Primitives.Symbol as Symbol
18import qualified Parse.Primitives.Utf8 as Utf8
19import qualified Parse.Primitives.Variable as Var
20import Parse.Primitives.Whitespace (whitespace)
21import qualified Reporting.Annotation as A
22import qualified Reporting.Error.Syntax as E
23import qualified Reporting.Region as R
27-- TERM
30term :: Parser Src.Pattern
31term =
32 hint E.Pattern $
33 do start <- getPosition
34 oneOf
35 [ record start
36 , tuple start
37 , list start
38 , termHelp start
39 ]
42termHelp :: R.Position -> Parser Src.Pattern
43termHelp start =
44 oneOf
45 [
46 do Symbol.underscore
47 end <- getPosition
48 return (A.at start end Src.PAnything)
49 ,
50 do name <- Var.lower
51 end <- getPosition
52 return (A.at start end (Src.PVar name))
53 ,
54 do (maybePrefix, name) <- Var.foreignUpper
55 end <- getPosition
56 let ctor = Src.PCtor (R.Region start end) maybePrefix name []
57 return (A.at start end ctor)
58 ,
59 do number <- Number.number
60 end <- getPosition
61 case number of
62 Number.Int int ->
63 return (A.at start end (Src.PInt int))
65 Number.Float _ ->
66 error "TODO floats are not allowed in pattern matches"
67 ,
68 do str <- Utf8.string
69 end <- getPosition
70 return (A.at start end (Src.PStr str))
71 ,
72 do chr <- Utf8.character
73 end <- getPosition
74 return (A.at start end (Src.PChr chr))
75 ]
81-- RECORDS
84record :: R.Position -> Parser Src.Pattern
85record start =
86 do Symbol.leftCurly
87 inContext start E.ExprRecord $
88 do spaces
89 oneOf
90 [ do var <- addLocation Var.lower
91 spaces
92 recordHelp start [var]
93 , do Symbol.rightCurly
94 end <- getPosition
95 return (A.at start end (Src.PRecord []))
96 ]
99recordHelp :: R.Position -> [A.Located N.Name] -> Parser Src.Pattern
100recordHelp start vars =
101 oneOf
102 [ do Symbol.comma
103 spaces
104 var <- addLocation Var.lower
105 spaces
106 recordHelp start (var:vars)
107 , do Symbol.rightCurly
108 end <- getPosition
109 return (A.at start end (Src.PRecord vars))
110 ]
114-- TUPLES
117tuple :: R.Position -> Parser Src.Pattern
118tuple start =
119 do Symbol.leftParen
120 inContext start E.ExprTuple $
121 do spaces
122 oneOf
123 [ do (pattern, sPos) <- expression
124 checkSpace sPos
125 tupleHelp start pattern []
126 , do Symbol.rightParen
127 end <- getPosition
128 return (A.at start end Src.PUnit)
129 ]
132tupleHelp :: R.Position -> Src.Pattern -> [Src.Pattern] -> Parser Src.Pattern
133tupleHelp start firstPattern revPatterns =
134 oneOf
135 [ do Symbol.comma
136 spaces
137 (pattern, sPos) <- expression
138 checkSpace sPos
139 tupleHelp start firstPattern (pattern : revPatterns)
140 , do Symbol.rightParen
141 case reverse revPatterns of
142 [] ->
143 return firstPattern
145 secondPattern : otherPatterns ->
146 do end <- getPosition
147 return (A.at start end (Src.PTuple firstPattern secondPattern otherPatterns))
148 ]
152-- LIST
155list :: R.Position -> Parser Src.Pattern
156list start =
157 do Symbol.leftSquare
158 inContext start E.PatternList $
159 do spaces
160 oneOf
161 [ do (pattern, sPos) <- expression
162 checkSpace sPos
163 listHelp start [pattern]
164 , do Symbol.rightSquare
165 end <- getPosition
166 return (A.at start end (Src.PList []))
167 ]
170listHelp :: R.Position -> [Src.Pattern] -> Parser Src.Pattern
171listHelp start patterns =
172 oneOf
173 [ do Symbol.comma
174 spaces
175 (pattern, sPos) <- expression
176 checkSpace sPos
177 listHelp start (pattern:patterns)
178 , do Symbol.rightSquare
179 end <- getPosition
180 return (A.at start end (Src.PList (reverse patterns)))
181 ]
185-- EXPRESSION
188expression :: Parser (Src.Pattern, SPos)
189expression =
190 hint E.Pattern $
191 do start <- getPosition
192 cTerm <- exprTerm
193 exprHelp start [] cTerm
196exprHelp :: R.Position -> [Src.Pattern] -> (Src.Pattern, R.Position, SPos) -> Parser (Src.Pattern, SPos)
197exprHelp start patterns (pattern, _end, sPos) =
198 oneOf
199 [ do checkSpace sPos
200 Symbol.cons
201 spaces
202 cTerm <- exprTerm
203 exprHelp start (pattern:patterns) cTerm
204 , do checkSpace sPos
205 Keyword.as_
206 spaces
207 nameStart <- getPosition
208 name <- Var.lower
209 newEnd <- getPosition
210 newSpace <- whitespace
211 let alias = A.at nameStart newEnd name
212 return
213 ( A.at start newEnd (Src.PAlias (List.foldl' cons pattern patterns) alias)
214 , newSpace
215 )
216 , return
217 ( List.foldl' cons pattern patterns
218 , sPos
219 )
220 ]
223cons :: Src.Pattern -> Src.Pattern -> Src.Pattern
224cons tl@(A.A (R.Region _ end) _) hd@(A.A (R.Region start _) _) =
225 A.at start end (Src.PCons hd tl)
229-- EXPRESSION TERM
232exprTerm :: SParser Src.Pattern
233exprTerm =
234 oneOf
235 [ do start <- getPosition
236 pair <- Var.foreignUpper
237 exprTermHelp start pair []
239 , (,,) <$> term <*> getPosition <*> whitespace
240 ]
243exprTermHelp :: R.Position -> (Maybe N.Name, N.Name) -> [Src.Pattern] -> SParser Src.Pattern
244exprTermHelp start pair@(maybePrefix, name) args =
245 do end <- getPosition
246 sPos <- whitespace
247 oneOf
248 [ do checkSpace sPos
249 arg <- term
250 exprTermHelp start pair (arg:args)
251 , return
252 ( A.at start end (Src.PCtor (R.Region start end) maybePrefix name (reverse args))
253 , end
254 , sPos
255 )
256 ]