git.iko.soy/elk
on 1238607 help sign in
elk/compiler/src/Parse/Module.hs
416 lines 11 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Parse.Module
4 ( fromByteString
5 , Header(..)
6 , Effects(..)
7 , chompHeader
8 , chompImports
9 , freshLine
10 )
11 where
14import qualified Data.ByteString as B
15import qualified Data.Name as Name
17import qualified AST.Source as Src
18import qualified Elm.Compiler.Imports as Imports
19import qualified Elm.Package as Pkg
20import qualified Parse.Declaration as Decl
21import qualified Parse.Keyword as Keyword
22import qualified Parse.Symbol as Symbol
23import qualified Parse.Variable as Var
24import qualified Parse.Primitives as P
25import Parse.Primitives hiding (Parser, State, fromByteString)
26import Parse.Utils
27import qualified Reporting.Annotation as A
28import qualified Reporting.Error.Syntax as E
29import qualified Reporting.Result as Result
33-- FROM BYTE STRING
36fromByteString :: Pkg.Name -> B.ByteString -> Result.Result i w E.Error Src.Module
37fromByteString pkg source =
38 let
39 parser
40 | pkg == Pkg.core = core
41 | Pkg.isKernel pkg = platform
42 | otherwise = normal
43 in
44 case P.fromByteString parser source of
45 P.Ok outcome _ ->
46 case outcome of
47 Right modul -> Result.ok modul
48 Left err -> Result.throw err
50 P.Err row col ctx err ->
51 Result.throw (E.ParseError row col ctx err)
55-- MODULE
58normal :: Parser (Either E.Error Src.Module)
59normal =
60 do freshLine
61 header <- chompHeader
62 imports <- chompImports []
63 decls <- chompDecls []
64 endOfFile
65 return (checkModule header (Imports.addDefaults imports) [] decls)
68core :: Parser (Either E.Error Src.Module)
69core =
70 do freshLine
71 header <- chompHeader
72 imports <- chompImports []
73 binops <- chompBinops []
74 decls <- chompDecls []
75 endOfFile
76 return (checkModule header imports binops decls)
79platform :: Parser (Either E.Error Src.Module)
80platform =
81 do freshLine
82 header <- chompHeader
83 imports <- chompImports []
84 binops <- chompBinops []
85 decls <- chompDecls []
86 endOfFile
87 return (checkModule header (Imports.addDefaults imports) binops decls)
91-- CHECK MODULE
94checkModule :: Maybe Header -> [Src.Import] -> [A.Located Src.Binop] -> [Decl.Decl] -> Either E.Error Src.Module
95checkModule maybeHeader imports binops decls =
96 let
97 (Header name effects exports) = maybe (Header "Main" NoEffects (A.At A.one Src.Open)) id maybeHeader
98 (values, unions, aliases, ports) = categorizeDecls [] [] [] [] decls
99 in
100 Src.Module name exports imports values unions aliases binops
101 <$> checkEffects ports effects
104checkEffects :: [Src.Port] -> Effects -> Either E.Error Src.Effects
105checkEffects ports effects =
106 case effects of
107 NoEffects ->
108 case ports of
109 [] -> Right Src.NoEffects
110 _:_ -> Left (error "TODO no ports")
112 Ports region ->
113 case ports of
114 [] -> Left (error "TODO no ports in port module" region)
115 _:_ -> Right (Src.Ports ports)
117 Manager region manager ->
118 case ports of
119 [] -> Right (Src.Manager region manager)
120 _:_ -> Left (error "TODO ports in effect manager")
123categorizeDecls :: [A.Located Src.Value] -> [A.Located Src.Union] -> [A.Located Src.Alias] -> [Src.Port] -> [Decl.Decl] -> ( [A.Located Src.Value], [A.Located Src.Union], [A.Located Src.Alias], [Src.Port] )
124categorizeDecls values unions aliases ports decls =
125 case decls of
126 [] ->
127 (values, unions, aliases, ports)
129 decl:otherDecls ->
130 case decl of
131 Decl.Value value -> categorizeDecls (value:values) unions aliases ports otherDecls
132 Decl.Union union -> categorizeDecls values (union:unions) aliases ports otherDecls
133 Decl.Alias alias -> categorizeDecls values unions (alias:aliases) ports otherDecls
134 Decl.Port port_ -> categorizeDecls values unions aliases (port_:ports) otherDecls
138-- FRESH LINES
141freshLine :: Parser ()
142freshLine =
143 checkFreshLine =<< whitespace
146endOfFile :: Parser ()
147endOfFile =
148 P.Parser $ \state@(P.State pos end _ row col ctx) _ eok _ eerr ->
149 if pos < end then
150 eerr row col ctx E.EndOfFile
151 else
152 eok () state
156-- CHOMP DECLARATIONS
159chompDecls :: [Decl.Decl] -> Parser [Decl.Decl]
160chompDecls decls =
161 do (decl, _, pos) <- Decl.declaration
162 oneOf E.XXX
163 [ do checkFreshLine pos
164 chompDecls (decl:decls)
165 , return (reverse (decl:decls))
166 ]
169chompBinops :: [A.Located Src.Binop] -> Parser [A.Located Src.Binop]
170chompBinops binops =
171 oneOf E.XXX
172 [ do binop <- Decl.infix_
173 chompBinops (binop:binops)
174 , return binops
175 ]
179-- HEADER
182data Header =
183 Header Name.Name Effects (A.Located Src.Exposing)
186data Effects
187 = NoEffects
188 | Ports A.Region
189 | Manager A.Region Src.Manager
192chompHeader :: Parser (Maybe Header)
193chompHeader =
194 do start <- getPosition
195 oneOf E.XXX
196 [
197 -- module MyThing exposing (..)
198 do Keyword.module_
199 pushContext start E.Module
200 spaces
201 name <- Var.moduleName
202 spaces
203 Keyword.exposing_
204 spaces
205 exports <- addLocation exposing
206 popContext ()
207 freshLine
208 return (Just (Header name NoEffects exports))
209 ,
210 -- port module MyThing exposing (..)
211 do Keyword.port_
212 pushContext start E.Module
213 spaces
214 Keyword.module_
215 end <- getPosition
216 spaces
217 name <- Var.moduleName
218 spaces
219 Keyword.exposing_
220 spaces
221 exports <- addLocation exposing
222 popContext ()
223 freshLine
224 return (Just (Header name (Ports (A.Region start end)) exports))
225 ,
226 -- effect module MyThing where { command = MyCmd } exposing (..)
227 do Keyword.effect_
228 pushContext start E.Module
229 spaces
230 Keyword.module_
231 end <- getPosition
232 spaces
233 name <- Var.moduleName
234 spaces
235 Keyword.where_
236 spaces
237 manager <- chompManager
238 spaces
239 Keyword.exposing_
240 spaces
241 exports <- addLocation exposing
242 popContext ()
243 freshLine
244 return (Just (Header name (Manager (A.Region start end) manager) exports))
245 ,
246 -- default header
247 return Nothing
248 ]
251chompManager :: Parser Src.Manager
252chompManager =
253 do word1 0x7B {- { -} E.XXX
254 spaces
255 oneOf E.XXX
256 [ do cmd <- chompCommand
257 spaces
258 oneOf E.XXX
259 [ do word1 0x7D {-}-} E.XXX
260 spaces
261 return (Src.Cmd cmd)
262 , do word1 0x2C {-,-} E.XXX
263 spaces
264 sub <- chompSubscription
265 spaces
266 word1 0x7D {-}-} E.XXX
267 spaces
268 return (Src.Fx cmd sub)
269 ]
270 , do sub <- chompSubscription
271 spaces
272 oneOf E.XXX
273 [ do word1 0x7D {-}-} E.XXX
274 spaces
275 return (Src.Sub sub)
276 , do word1 0x2C {-,-} E.XXX
277 spaces
278 cmd <- chompCommand
279 spaces
280 word1 0x7D {-}-} E.XXX
281 spaces
282 return (Src.Fx cmd sub)
283 ]
284 ]
287chompCommand :: Parser (A.Located Name.Name)
288chompCommand =
289 do Keyword.command_
290 spaces
291 word1 0x3D {-=-} E.XXX
292 spaces
293 addLocation Var.upper
296chompSubscription :: Parser (A.Located Name.Name)
297chompSubscription =
298 do Keyword.subscription_
299 spaces
300 word1 0x3D {-=-} E.XXX
301 spaces
302 addLocation Var.upper
306-- IMPORTS
309chompImports :: [Src.Import] -> Parser [Src.Import]
310chompImports imports =
311 oneOf E.XXX
312 [ do start <- getPosition
313 Keyword.import_
314 pushContext start E.Import
315 spaces
316 name <- addLocation Var.moduleName
317 pos <- whitespace
318 oneOf E.XXX
319 [ do checkFreshLine pos
320 popContext ()
321 chompImports $
322 Src.Import name Nothing (Src.Explicit []) : imports
323 , do checkSpace pos
324 oneOf E.XXX
325 [ chompAs name imports
326 , chompExposing name Nothing imports
327 ]
328 ]
329 , return (reverse imports)
330 ]
333chompAs :: A.Located Name.Name -> [Src.Import] -> Parser [Src.Import]
334chompAs name imports =
335 do Keyword.as_
336 spaces
337 alias <- Var.upper
338 pos <- whitespace
339 oneOf E.XXX
340 [ do checkFreshLine pos
341 popContext ()
342 chompImports $
343 Src.Import name (Just alias) (Src.Explicit []) : imports
344 , do checkSpace pos
345 chompExposing name (Just alias) imports
346 ]
349chompExposing :: A.Located Name.Name -> Maybe Name.Name -> [Src.Import] -> Parser [Src.Import]
350chompExposing name maybeAlias imports =
351 do Keyword.exposing_
352 spaces
353 exposed <- exposing
354 freshLine
355 popContext ()
356 chompImports $
357 Src.Import name maybeAlias exposed : imports
361-- LISTING
364exposing :: Parser Src.Exposing
365exposing =
366 do word1 0x28 {-(-} E.XXX
367 spaces
368 oneOf E.XXX
369 [ do word2 0x2E 0x2E {-..-} E.XXX
370 spaces
371 word1 0x29 {-)-} E.XXX
372 return Src.Open
373 , do entry <- addLocation chompEntry
374 spaces
375 exposingHelp [entry]
376 ]
379exposingHelp :: [A.Located Src.Exposed] -> Parser Src.Exposing
380exposingHelp revEntries =
381 oneOf E.XXX
382 [ do word1 0x2C {-,-} E.XXX
383 spaces
384 entry <- addLocation chompEntry
385 spaces
386 exposingHelp (entry:revEntries)
387 , do word1 0x29 {-)-} E.XXX
388 return (Src.Explicit (reverse revEntries))
389 ]
392chompEntry :: Parser Src.Exposed
393chompEntry =
394 oneOf E.XXX
395 [ Src.Lower <$> Var.lower
396 , do word1 0x28 {-(-} E.XXX
397 op <- Symbol.binop
398 word1 0x29 {-)-} E.XXX
399 return (Src.Operator op)
400 , do name <- Var.upper
401 spaces
402 Src.Upper name <$> privacy
403 ]
406privacy :: Parser Src.Privacy
407privacy =
408 oneOf E.XXX
409 [ do word1 0x28 {-(-} E.XXX
410 spaces
411 word2 0x2E 0x2E {-..-} E.XXX
412 spaces
413 word1 0x29 {-)-} E.XXX
414 return Src.Public
415 , return Src.Private
416 ]