git.iko.soy/elk
on e55ba2b help sign in
elk/src/Parse/Pattern.hs
243 lines 5.9 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.Pattern as P
13import qualified Elm.Name as N
14import qualified Parse.Literal as Literal
15import Parse.Primitives (Parser, SParser, SPos, addLocation, checkSpace, getPosition, hint, inContext, spaces, oneOf)
16import qualified Parse.Primitives.Keyword as Keyword
17import qualified Parse.Primitives.Symbol as Symbol
18import qualified Parse.Primitives.Variable as Var
19import Parse.Primitives.Whitespace (whitespace)
20import qualified Reporting.Annotation as A
21import qualified Reporting.Error.Syntax as E
22import qualified Reporting.Region as R
26-- TERM
29term :: Parser P.Raw
30term =
31 hint E.Pattern $
32 do start <- getPosition
33 oneOf
34 [ record start
35 , tuple start
36 , list start
37 , termHelp start
38 ]
41termHelp :: R.Position -> Parser P.Raw
42termHelp start =
43 oneOf
44 [
45 do Symbol.underscore
46 end <- getPosition
47 return (A.at start end P.RAnything)
48 ,
49 do name <- Var.lower
50 end <- getPosition
51 return (A.at start end (P.RVar name))
52 ,
53 do (maybePrefix, name) <- Var.foreignUpper
54 end <- getPosition
55 let ctor = P.RCtor (R.Region start end) maybePrefix name []
56 return (A.at start end ctor)
58 ,
59 do lit <- Literal.literal
60 end <- getPosition
61 return (A.at start end (P.RLiteral lit))
62 ]
68-- RECORDS
71record :: R.Position -> Parser P.Raw
72record start =
73 do Symbol.leftCurly
74 inContext start E.ExprRecord $
75 do spaces
76 oneOf
77 [ do var <- addLocation Var.lower
78 spaces
79 recordHelp start [var]
80 , do Symbol.rightCurly
81 end <- getPosition
82 return (A.at start end (P.RRecord []))
83 ]
86recordHelp :: R.Position -> [A.Located N.Name] -> Parser P.Raw
87recordHelp start vars =
88 oneOf
89 [ do Symbol.comma
90 spaces
91 var <- addLocation Var.lower
92 spaces
93 recordHelp start (var:vars)
94 , do Symbol.rightCurly
95 end <- getPosition
96 return (A.at start end (P.RRecord vars))
97 ]
101-- TUPLES
104tuple :: R.Position -> Parser P.Raw
105tuple start =
106 do Symbol.leftParen
107 inContext start E.ExprTuple $
108 do spaces
109 oneOf
110 [ do (pattern, sPos) <- expression
111 checkSpace sPos
112 tupleHelp start pattern []
113 , do Symbol.rightParen
114 end <- getPosition
115 return (A.at start end P.RUnit)
116 ]
119tupleHelp :: R.Position -> P.Raw -> [P.Raw] -> Parser P.Raw
120tupleHelp start firstPattern revPatterns =
121 oneOf
122 [ do Symbol.comma
123 spaces
124 (pattern, sPos) <- expression
125 checkSpace sPos
126 tupleHelp start firstPattern (pattern : revPatterns)
127 , do Symbol.rightParen
128 case reverse revPatterns of
129 [] ->
130 return firstPattern
132 secondPattern : otherPatterns ->
133 do end <- getPosition
134 return (A.at start end (P.RTuple firstPattern secondPattern otherPatterns))
135 ]
139-- LIST
142list :: R.Position -> Parser P.Raw
143list start =
144 do Symbol.leftSquare
145 inContext start E.PatternList $
146 do spaces
147 oneOf
148 [ do (pattern, sPos) <- expression
149 checkSpace sPos
150 listHelp start [pattern]
151 , do Symbol.rightSquare
152 end <- getPosition
153 return (A.at start end (P.RList []))
154 ]
157listHelp :: R.Position -> [P.Raw] -> Parser P.Raw
158listHelp start patterns =
159 oneOf
160 [ do Symbol.comma
161 spaces
162 (pattern, sPos) <- expression
163 checkSpace sPos
164 listHelp start (pattern:patterns)
165 , do Symbol.rightSquare
166 end <- getPosition
167 return (A.at start end (P.RList (reverse patterns)))
168 ]
172-- EXPRESSION
175expression :: Parser (P.Raw, SPos)
176expression =
177 hint E.Pattern $
178 do start <- getPosition
179 cTerm <- exprTerm
180 exprHelp start [] cTerm
183exprHelp :: R.Position -> [P.Raw] -> (P.Raw, R.Position, SPos) -> Parser (P.Raw, SPos)
184exprHelp start patterns (pattern, _end, sPos) =
185 oneOf
186 [ do checkSpace sPos
187 Symbol.cons
188 spaces
189 cTerm <- exprTerm
190 exprHelp start (pattern:patterns) cTerm
191 , do checkSpace sPos
192 Keyword.as_
193 spaces
194 nameStart <- getPosition
195 name <- Var.lower
196 newEnd <- getPosition
197 newSpace <- whitespace
198 let alias = A.at nameStart newEnd name
199 return
200 ( A.at start newEnd (P.RAlias (List.foldl' cons pattern patterns) alias)
201 , newSpace
202 )
203 , return
204 ( List.foldl' cons pattern patterns
205 , sPos
206 )
207 ]
210cons :: P.Raw -> P.Raw -> P.Raw
211cons tl@(A.A (R.Region _ end) _) hd@(A.A (R.Region start _) _) =
212 A.at start end (P.RCons hd tl)
216-- EXPRESSION TERM
219exprTerm :: SParser P.Raw
220exprTerm =
221 oneOf
222 [ do start <- getPosition
223 pair <- Var.foreignUpper
224 exprTermHelp start pair []
226 , (,,) <$> term <*> getPosition <*> whitespace
227 ]
230exprTermHelp :: R.Position -> (Maybe N.Name, N.Name) -> [P.Raw] -> SParser P.Raw
231exprTermHelp start pair@(maybePrefix, name) args =
232 do end <- getPosition
233 sPos <- whitespace
234 oneOf
235 [ do checkSpace sPos
236 arg <- term
237 exprTermHelp start pair (arg:args)
238 , return
239 ( A.at start end (P.RCtor (R.Region start end) maybePrefix name (reverse args))
240 , end
241 , sPos
242 )
243 ]