git.iko.soy/elk
on bfb8eca help sign in
elk/src/Parse/Pattern.hs
242 lines 6.1 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.Expression.Source as Src
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 Src.Pattern
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 Src.Pattern
42termHelp start =
43 oneOf
44 [
45 do Symbol.underscore
46 end <- getPosition
47 return (A.at start end Src.PAnything)
48 ,
49 do name <- Var.lower
50 end <- getPosition
51 return (A.at start end (Src.PVar name))
52 ,
53 do (maybePrefix, name) <- Var.foreignUpper
54 end <- getPosition
55 let ctor = Src.PCtor (R.Region start end) maybePrefix name []
56 return (A.at start end ctor)
57 ,
58 do lit <- Literal.literal
59 end <- getPosition
60 return (A.at start end (Src.PLiteral lit))
61 ]
67-- RECORDS
70record :: R.Position -> Parser Src.Pattern
71record start =
72 do Symbol.leftCurly
73 inContext start E.ExprRecord $
74 do spaces
75 oneOf
76 [ do var <- addLocation Var.lower
77 spaces
78 recordHelp start [var]
79 , do Symbol.rightCurly
80 end <- getPosition
81 return (A.at start end (Src.PRecord []))
82 ]
85recordHelp :: R.Position -> [A.Located N.Name] -> Parser Src.Pattern
86recordHelp start vars =
87 oneOf
88 [ do Symbol.comma
89 spaces
90 var <- addLocation Var.lower
91 spaces
92 recordHelp start (var:vars)
93 , do Symbol.rightCurly
94 end <- getPosition
95 return (A.at start end (Src.PRecord vars))
96 ]
100-- TUPLES
103tuple :: R.Position -> Parser Src.Pattern
104tuple start =
105 do Symbol.leftParen
106 inContext start E.ExprTuple $
107 do spaces
108 oneOf
109 [ do (pattern, sPos) <- expression
110 checkSpace sPos
111 tupleHelp start pattern []
112 , do Symbol.rightParen
113 end <- getPosition
114 return (A.at start end Src.PUnit)
115 ]
118tupleHelp :: R.Position -> Src.Pattern -> [Src.Pattern] -> Parser Src.Pattern
119tupleHelp start firstPattern revPatterns =
120 oneOf
121 [ do Symbol.comma
122 spaces
123 (pattern, sPos) <- expression
124 checkSpace sPos
125 tupleHelp start firstPattern (pattern : revPatterns)
126 , do Symbol.rightParen
127 case reverse revPatterns of
128 [] ->
129 return firstPattern
131 secondPattern : otherPatterns ->
132 do end <- getPosition
133 return (A.at start end (Src.PTuple firstPattern secondPattern otherPatterns))
134 ]
138-- LIST
141list :: R.Position -> Parser Src.Pattern
142list start =
143 do Symbol.leftSquare
144 inContext start E.PatternList $
145 do spaces
146 oneOf
147 [ do (pattern, sPos) <- expression
148 checkSpace sPos
149 listHelp start [pattern]
150 , do Symbol.rightSquare
151 end <- getPosition
152 return (A.at start end (Src.PList []))
153 ]
156listHelp :: R.Position -> [Src.Pattern] -> Parser Src.Pattern
157listHelp start patterns =
158 oneOf
159 [ do Symbol.comma
160 spaces
161 (pattern, sPos) <- expression
162 checkSpace sPos
163 listHelp start (pattern:patterns)
164 , do Symbol.rightSquare
165 end <- getPosition
166 return (A.at start end (Src.PList (reverse patterns)))
167 ]
171-- EXPRESSION
174expression :: Parser (Src.Pattern, SPos)
175expression =
176 hint E.Pattern $
177 do start <- getPosition
178 cTerm <- exprTerm
179 exprHelp start [] cTerm
182exprHelp :: R.Position -> [Src.Pattern] -> (Src.Pattern, R.Position, SPos) -> Parser (Src.Pattern, SPos)
183exprHelp start patterns (pattern, _end, sPos) =
184 oneOf
185 [ do checkSpace sPos
186 Symbol.cons
187 spaces
188 cTerm <- exprTerm
189 exprHelp start (pattern:patterns) cTerm
190 , do checkSpace sPos
191 Keyword.as_
192 spaces
193 nameStart <- getPosition
194 name <- Var.lower
195 newEnd <- getPosition
196 newSpace <- whitespace
197 let alias = A.at nameStart newEnd name
198 return
199 ( A.at start newEnd (Src.PAlias (List.foldl' cons pattern patterns) alias)
200 , newSpace
201 )
202 , return
203 ( List.foldl' cons pattern patterns
204 , sPos
205 )
206 ]
209cons :: Src.Pattern -> Src.Pattern -> Src.Pattern
210cons tl@(A.A (R.Region _ end) _) hd@(A.A (R.Region start _) _) =
211 A.at start end (Src.PCons hd tl)
215-- EXPRESSION TERM
218exprTerm :: SParser Src.Pattern
219exprTerm =
220 oneOf
221 [ do start <- getPosition
222 pair <- Var.foreignUpper
223 exprTermHelp start pair []
225 , (,,) <$> term <*> getPosition <*> whitespace
226 ]
229exprTermHelp :: R.Position -> (Maybe N.Name, N.Name) -> [Src.Pattern] -> SParser Src.Pattern
230exprTermHelp start pair@(maybePrefix, name) args =
231 do end <- getPosition
232 sPos <- whitespace
233 oneOf
234 [ do checkSpace sPos
235 arg <- term
236 exprTermHelp start pair (arg:args)
237 , return
238 ( A.at start end (Src.PCtor (R.Region start end) maybePrefix name (reverse args))
239 , end
240 , sPos
241 )
242 ]