on 087045f help sign in
elk/src/Parse/Module.hs
294 lines 7.0 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Parse.Module
4 ( module_
5 , chompImports
6 )
7 where
10import qualified Data.ByteString as B
11import Data.Text (Text)
13import qualified AST.Expression.Source as Src
14import qualified Elm.Name as N
15import Parse.Primitives (Parser, oneOf)
16import qualified Parse.Primitives as P
17import qualified Parse.Primitives.Keyword as Keyword
18import qualified Parse.Primitives.Symbol as Symbol
19import qualified Parse.Primitives.Variable as Var
20import qualified Parse.Primitives.Whitespace as W
21import qualified Reporting.Annotation as A
22import qualified Reporting.Error.Syntax as E
23import qualified Reporting.Region as R
27-- HEADER
30module_ :: Parser decls -> Parser (Src.Module decls)
31module_ chompDecls =
32 do freshLine
33 oneOf
34 [ do start <- P.getPosition
35 P.pushContext start E.Module
36 (name, effects) <- chompNameAndEffects
37 P.hint E.Exposing $ Keyword.exposing_
38 P.spaces
39 exports <- exposing
40 P.popContext ()
41 docs <- maybeDocComment
42 imports <- chompImports []
43 decls <- chompDecls
44 return (Src.Module name effects docs exports imports decls)
45 , Src.defaultModule
46 <$> chompImports []
47 <*> chompDecls
48 ]
52-- MODULE NAME
53--
54-- module MyThing
55-- port module MyThing
56-- effect module MyThing where { command = MyCmd }
57--
58chompNameAndEffects :: Parser (N.Name, Src.Effects)
59chompNameAndEffects =
60 oneOf
61 [
62 do Keyword.module_
63 P.spaces
64 name <- Var.moduleName
65 P.spaces
66 return ( name, Src.NoEffects )
67 ,
68 do start <- P.getPosition
69 Keyword.port_
70 P.spaces
71 Keyword.module_
72 end <- P.getPosition
73 P.spaces
74 name <- Var.moduleName
75 P.spaces
76 return ( name, Src.Ports (R.Region start end) )
77 ,
78 do start <- P.getPosition
79 Keyword.effect_
80 P.spaces
81 Keyword.module_
82 end <- P.getPosition
83 P.spaces
84 name <- Var.moduleName
85 P.spaces
86 manager <- chompManager
87 return ( name, Src.Effects (R.Region start end) manager )
88 ]
92-- MANAGER
93--
94-- where { command = MyCmd }
95-- where { subscription = MySub }
96-- where { command = MyCmd, subscription = MySub }
97--
98chompManager :: Parser Src.Manager
99chompManager =
100 do Keyword.where_
101 P.spaces
102 Symbol.leftCurly
103 P.spaces
104 oneOf
105 [ do cmd <- chompCommand
106 P.spaces
107 oneOf
108 [ do Symbol.rightCurly
109 P.spaces
110 return (Src.Cmd cmd)
111 , do Symbol.comma
112 P.spaces
113 sub <- chompSubscription
114 P.spaces
115 Symbol.rightCurly
116 P.spaces
117 return (Src.Fx cmd sub)
118 ]
119 , do sub <- chompSubscription
120 P.spaces
121 oneOf
122 [ do Symbol.rightCurly
123 P.spaces
124 return (Src.Sub sub)
125 , do Symbol.comma
126 P.spaces
127 cmd <- chompCommand
128 P.spaces
129 Symbol.rightCurly
130 P.spaces
131 return (Src.Fx cmd sub)
132 ]
133 ]
136chompCommand :: Parser (A.Located Text)
137chompCommand =
138 do Keyword.command_
139 P.spaces
140 Symbol.equals
141 P.spaces
142 P.addLocation Var.upper
145chompSubscription :: Parser (A.Located Text)
146chompSubscription =
147 do Keyword.subscription_
148 P.spaces
149 Symbol.equals
150 P.spaces
151 P.addLocation Var.upper
155-- DOC COMMENTS
158maybeDocComment :: Parser (A.Located (Maybe B.ByteString))
159maybeDocComment =
160 do oldEnd <- P.getPosition
161 freshLine
162 newStart <- P.getPosition
163 oneOf
164 [ do doc <- W.docComment
165 end <- P.getPosition
166 freshLine
167 return (A.at newStart end (Just doc))
168 , return (A.at oldEnd newStart Nothing)
169 ]
173-- IMPORTS
176chompImports :: [Src.Import] -> Parser [Src.Import]
177chompImports imports =
178 oneOf
179 [ do start <- P.getPosition
180 Keyword.import_
181 P.pushContext start E.Import
182 P.spaces
183 name <- P.addLocation Var.moduleName
184 pos <- W.whitespace
185 oneOf
186 [ do P.checkFreshLine pos
187 P.popContext ()
188 chompImports $
189 Src.Import name Nothing (Src.Explicit []) : imports
190 , do P.checkSpace pos
191 oneOf
192 [ chompAs name imports
193 , chompExposing name Nothing imports
194 ]
195 ]
196 , return (reverse imports)
197 ]
200chompAs :: A.Located Text -> [Src.Import] -> Parser [Src.Import]
201chompAs name imports =
202 do Keyword.as_
203 P.spaces
204 alias <- Var.upper
205 pos <- W.whitespace
206 oneOf
207 [ do P.checkFreshLine pos
208 P.popContext ()
209 chompImports $
210 Src.Import name (Just alias) (Src.Explicit []) : imports
211 , do P.checkSpace pos
212 chompExposing name (Just alias) imports
213 ]
216chompExposing :: A.Located Text -> Maybe Text -> [Src.Import] -> Parser [Src.Import]
217chompExposing name maybeAlias imports =
218 do Keyword.exposing_
219 P.spaces
220 exposed <- exposing
221 freshLine
222 P.popContext ()
223 chompImports $
224 Src.Import name maybeAlias exposed : imports
228-- LISTING
231exposing :: Parser Src.Exposing
232exposing =
233 P.hint E.Listing $
234 do Symbol.leftParen
235 P.spaces
236 oneOf
237 [ do Symbol.doubleDot
238 P.spaces
239 Symbol.rightParen
240 return Src.Open
241 , do entry <- P.addLocation chompEntry
242 P.spaces
243 exposingHelp [entry]
244 ]
247exposingHelp :: [A.Located Src.Exposed] -> Parser Src.Exposing
248exposingHelp revEntries =
249 oneOf
250 [ do Symbol.comma
251 P.spaces
252 entry <- P.addLocation chompEntry
253 P.spaces
254 exposingHelp (entry:revEntries)
255 , do Symbol.rightParen
256 return (Src.Explicit (reverse revEntries))
257 ]
260chompEntry :: Parser Src.Exposed
261chompEntry =
262 oneOf
263 [ Src.Lower <$> Var.lower
264 , do Symbol.leftParen
265 op <- Symbol.binop
266 Symbol.rightParen
267 return (Src.Lower op)
268 , do name <- Var.upper
269 P.spaces
270 Src.Upper name <$> privacy
271 ]
274privacy :: Parser Src.Privacy
275privacy =
276 oneOf
277 [ do Symbol.leftParen
278 P.spaces
279 Symbol.doubleDot
280 P.spaces
281 Symbol.rightParen
282 return Src.Public
283 , return Src.Private
284 ]
288-- FRESH LINES
291freshLine :: Parser ()
292freshLine =
293 P.checkFreshLine =<< W.whitespace