git.iko.soy/elk
on 2edbe13 help sign in
elk/compiler/src/Parse/Module.hs
487 lines 15 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Parse.Module
4 ( fromByteString
5 , ProjectType(..)
6 , isKernel
7 , chompImports
8 , chompImport
9 )
10 where
13import qualified Data.ByteString as BS
14import qualified Data.Name as Name
16import qualified AST.Source as Src
17import qualified Elm.Compiler.Imports as Imports
18import qualified Elm.Package as Pkg
19import qualified Parse.Declaration as Decl
20import qualified Parse.Keyword as Keyword
21import qualified Parse.Space as Space
22import qualified Parse.Symbol as Symbol
23import qualified Parse.Variable as Var
24import qualified Parse.Primitives as P
25import Parse.Primitives hiding (State, fromByteString)
26import qualified Reporting.Annotation as A
27import qualified Reporting.Error.Syntax as E
31-- FROM BYTE STRING
34fromByteString :: ProjectType -> BS.ByteString -> Either E.Error Src.Module
35fromByteString projectType source =
36 case P.fromByteString (chompModule projectType) E.ModuleBadEnd source of
37 Right modul -> checkModule projectType modul
38 Left err -> Left (E.ParseError err)
42-- PROJECT TYPE
45data ProjectType
46 = Package Pkg.Name
47 | Application
50isCore :: ProjectType -> Bool
51isCore projectType =
52 case projectType of
53 Package pkg -> pkg == Pkg.core
54 Application -> False
57isKernel :: ProjectType -> Bool
58isKernel projectType =
59 case projectType of
60 Package pkg -> Pkg.isKernel pkg
61 Application -> False
65-- MODULE
68data Module =
69 Module
70 { _header :: Maybe Header
71 , _imports :: [Src.Import]
72 , _infixes :: [A.Located Src.Infix]
73 , _decls :: [Decl.Decl]
74 }
77chompModule :: ProjectType -> Parser E.Module Module
78chompModule projectType =
79 do header <- chompHeader
80 imports <- chompImports (if isCore projectType then [] else Imports.defaults)
81 infixes <- if isKernel projectType then chompInfixes [] else return []
82 decls <- specialize E.Declarations $ chompDecls []
83 return (Module header imports infixes decls)
87-- CHECK MODULE
90checkModule :: ProjectType -> Module -> Either E.Error Src.Module
91checkModule projectType (Module maybeHeader imports infixes decls) =
92 let
93 (values, unions, aliases, ports) = categorizeDecls [] [] [] [] decls
94 in
95 case maybeHeader of
96 Just (Header name effects exports docs) ->
97 Src.Module (Just name) exports (toDocs docs decls) imports values unions aliases infixes
98 <$> checkEffects projectType ports effects
100 Nothing ->
101 Right $
102 Src.Module Nothing (A.At A.one Src.Open) (Src.NoDocs A.one) imports values unions aliases infixes $
103 case ports of
104 [] -> Src.NoEffects
105 _:_ -> Src.Ports ports
108checkEffects :: ProjectType -> [Src.Port] -> Effects -> Either E.Error Src.Effects
109checkEffects projectType ports effects =
110 case effects of
111 NoEffects region ->
112 case ports of
113 [] ->
114 Right Src.NoEffects
116 Src.Port name _ : _ ->
117 case projectType of
118 Package _ -> Left (E.NoPortsInPackage name)
119 Application -> Left (E.UnexpectedPort region)
121 Ports region ->
122 case projectType of
123 Package _ ->
124 Left (E.NoPortModulesInPackage region)
126 Application ->
127 case ports of
128 [] -> Left (E.NoPorts region)
129 _:_ -> Right (Src.Ports ports)
131 Manager region manager ->
132 if isKernel projectType then
133 case ports of
134 [] -> Right (Src.Manager region manager)
135 _:_ -> Left (E.UnexpectedPort region)
136 else
137 Left (E.NoEffectsOutsideKernel region)
141categorizeDecls :: [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] )
142categorizeDecls values unions aliases ports decls =
143 case decls of
144 [] ->
145 (values, unions, aliases, ports)
147 decl:otherDecls ->
148 case decl of
149 Decl.Value _ value -> categorizeDecls (value:values) unions aliases ports otherDecls
150 Decl.Union _ union -> categorizeDecls values (union:unions) aliases ports otherDecls
151 Decl.Alias _ alias -> categorizeDecls values unions (alias:aliases) ports otherDecls
152 Decl.Port _ port_ -> categorizeDecls values unions aliases (port_:ports) otherDecls
156-- TO DOCS
159toDocs :: Either A.Region Src.Comment -> [Decl.Decl] -> Src.Docs
160toDocs comment decls =
161 case comment of
162 Right overview ->
163 Src.YesDocs overview (getComments decls [])
165 Left region ->
166 Src.NoDocs region
169getComments :: [Decl.Decl] -> [(Name.Name,Src.Comment)] -> [(Name.Name,Src.Comment)]
170getComments decls comments =
171 case decls of
172 [] ->
173 comments
175 decl:otherDecls ->
176 case decl of
177 Decl.Value c (A.At _ (Src.Value n _ _ _)) -> getComments otherDecls (addComment c n comments)
178 Decl.Union c (A.At _ (Src.Union n _ _ )) -> getComments otherDecls (addComment c n comments)
179 Decl.Alias c (A.At _ (Src.Alias n _ _ )) -> getComments otherDecls (addComment c n comments)
180 Decl.Port c (Src.Port n _ ) -> getComments otherDecls (addComment c n comments)
183addComment :: Maybe Src.Comment -> A.Located Name.Name -> [(Name.Name,Src.Comment)] -> [(Name.Name,Src.Comment)]
184addComment maybeComment (A.At _ name) comments =
185 case maybeComment of
186 Just comment -> (name, comment) : comments
187 Nothing -> comments
191-- FRESH LINES
194freshLine :: (Row -> Col -> E.Module) -> Parser E.Module ()
195freshLine toFreshLineError =
196 do Space.chomp E.ModuleSpace
197 Space.checkFreshLine toFreshLineError
201-- CHOMP DECLARATIONS
204chompDecls :: [Decl.Decl] -> Parser E.Decl [Decl.Decl]
205chompDecls decls =
206 do (decl, _) <- Decl.declaration
207 oneOfWithFallback
208 [ do Space.checkFreshLine E.DeclStart
209 chompDecls (decl:decls)
210 ]
211 (reverse (decl:decls))
214chompInfixes :: [A.Located Src.Infix] -> Parser E.Module [A.Located Src.Infix]
215chompInfixes infixes =
216 oneOfWithFallback
217 [ do binop <- Decl.infix_
218 chompInfixes (binop:infixes)
219 ]
220 infixes
224-- MODULE DOC COMMENT
227chompModuleDocCommentSpace :: Parser E.Module (Either A.Region Src.Comment)
228chompModuleDocCommentSpace =
229 do (A.At region ()) <- addLocation (freshLine E.FreshLine)
230 oneOfWithFallback
231 [
232 do docComment <- Space.docComment E.ImportStart E.ModuleSpace
233 Space.chomp E.ModuleSpace
234 Space.checkFreshLine E.FreshLine
235 return (Right docComment)
236 ]
237 (Left region)
241-- HEADER
244data Header =
245 Header (A.Located Name.Name) Effects (A.Located Src.Exposing) (Either A.Region Src.Comment)
248data Effects
249 = NoEffects A.Region
250 | Ports A.Region
251 | Manager A.Region Src.Manager
254chompHeader :: Parser E.Module (Maybe Header)
255chompHeader =
256 do freshLine E.FreshLine
257 start <- getPosition
258 oneOfWithFallback
259 [
260 -- module MyThing exposing (..)
261 do Keyword.module_ E.ModuleProblem
262 effectEnd <- getPosition
263 Space.chompAndCheckIndent E.ModuleSpace E.ModuleProblem
264 name <- addLocation (Var.moduleName E.ModuleName)
265 Space.chompAndCheckIndent E.ModuleSpace E.ModuleProblem
266 Keyword.exposing_ E.ModuleProblem
267 Space.chompAndCheckIndent E.ModuleSpace E.ModuleProblem
268 exports <- addLocation (specialize E.ModuleExposing exposing)
269 comment <- chompModuleDocCommentSpace
270 return $ Just $
271 Header name (NoEffects (A.Region start effectEnd)) exports comment
272 ,
273 -- port module MyThing exposing (..)
274 do Keyword.port_ E.PortModuleProblem
275 Space.chompAndCheckIndent E.ModuleSpace E.PortModuleProblem
276 Keyword.module_ E.PortModuleProblem
277 effectEnd <- getPosition
278 Space.chompAndCheckIndent E.ModuleSpace E.PortModuleProblem
279 name <- addLocation (Var.moduleName E.PortModuleName)
280 Space.chompAndCheckIndent E.ModuleSpace E.PortModuleProblem
281 Keyword.exposing_ E.PortModuleProblem
282 Space.chompAndCheckIndent E.ModuleSpace E.PortModuleProblem
283 exports <- addLocation (specialize E.PortModuleExposing exposing)
284 comment <- chompModuleDocCommentSpace
285 return $ Just $
286 Header name (Ports (A.Region start effectEnd)) exports comment
287 ,
288 -- effect module MyThing where { command = MyCmd } exposing (..)
289 do Keyword.effect_ E.Effect
290 Space.chompAndCheckIndent E.ModuleSpace E.Effect
291 Keyword.module_ E.Effect
292 effectEnd <- getPosition
293 Space.chompAndCheckIndent E.ModuleSpace E.Effect
294 name <- addLocation (Var.moduleName E.ModuleName)
295 Space.chompAndCheckIndent E.ModuleSpace E.Effect
296 Keyword.where_ E.Effect
297 Space.chompAndCheckIndent E.ModuleSpace E.Effect
298 manager <- chompManager
299 Space.chompAndCheckIndent E.ModuleSpace E.Effect
300 Keyword.exposing_ E.Effect
301 Space.chompAndCheckIndent E.ModuleSpace E.Effect
302 exports <- addLocation (specialize (const E.Effect) exposing)
303 comment <- chompModuleDocCommentSpace
304 return $ Just $
305 Header name (Manager (A.Region start effectEnd) manager) exports comment
306 ]
307 -- default header
308 Nothing
311chompManager :: Parser E.Module Src.Manager
312chompManager =
313 do word1 0x7B {- { -} E.Effect
314 spaces_em
315 oneOf E.Effect
316 [ do cmd <- chompCommand
317 spaces_em
318 oneOf E.Effect
319 [ do word1 0x7D {-}-} E.Effect
320 spaces_em
321 return (Src.Cmd cmd)
322 , do word1 0x2C {-,-} E.Effect
323 spaces_em
324 sub <- chompSubscription
325 spaces_em
326 word1 0x7D {-}-} E.Effect
327 spaces_em
328 return (Src.Fx cmd sub)
329 ]
330 , do sub <- chompSubscription
331 spaces_em
332 oneOf E.Effect
333 [ do word1 0x7D {-}-} E.Effect
334 spaces_em
335 return (Src.Sub sub)
336 , do word1 0x2C {-,-} E.Effect
337 spaces_em
338 cmd <- chompCommand
339 spaces_em
340 word1 0x7D {-}-} E.Effect
341 spaces_em
342 return (Src.Fx cmd sub)
343 ]
344 ]
347chompCommand :: Parser E.Module (A.Located Name.Name)
348chompCommand =
349 do Keyword.command_ E.Effect
350 spaces_em
351 word1 0x3D {-=-} E.Effect
352 spaces_em
353 addLocation (Var.upper E.Effect)
356chompSubscription :: Parser E.Module (A.Located Name.Name)
357chompSubscription =
358 do Keyword.subscription_ E.Effect
359 spaces_em
360 word1 0x3D {-=-} E.Effect
361 spaces_em
362 addLocation (Var.upper E.Effect)
365spaces_em :: Parser E.Module ()
366spaces_em =
367 Space.chompAndCheckIndent E.ModuleSpace E.Effect
371-- IMPORTS
374chompImports :: [Src.Import] -> Parser E.Module [Src.Import]
375chompImports is =
376 oneOfWithFallback
377 [ do i <- chompImport
378 chompImports (i:is)
379 ]
380 (reverse is)
383chompImport :: Parser E.Module Src.Import
384chompImport =
385 do Keyword.import_ E.ImportStart
386 Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentName
387 name@(A.At (A.Region _ end) _) <- addLocation (Var.moduleName E.ImportName)
388 Space.chomp E.ModuleSpace
389 oneOf E.ImportEnd
390 [ do Space.checkFreshLine E.ImportEnd
391 return $ Src.Import name Nothing (Src.Explicit [])
392 , do Space.checkIndent end E.ImportEnd
393 oneOf E.ImportAs
394 [ chompAs name
395 , chompExposing name Nothing
396 ]
397 ]
400chompAs :: A.Located Name.Name -> Parser E.Module Src.Import
401chompAs name =
402 do Keyword.as_ E.ImportAs
403 Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentAlias
404 alias <- Var.upper E.ImportAlias
405 end <- getPosition
406 Space.chomp E.ModuleSpace
407 oneOf E.ImportEnd
408 [ do Space.checkFreshLine E.ImportEnd
409 return $ Src.Import name (Just alias) (Src.Explicit [])
410 , do Space.checkIndent end E.ImportEnd
411 chompExposing name (Just alias)
412 ]
415chompExposing :: A.Located Name.Name -> Maybe Name.Name -> Parser E.Module Src.Import
416chompExposing name maybeAlias =
417 do Keyword.exposing_ E.ImportExposing
418 Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentExposingList
419 exposed <- specialize E.ImportExposingList exposing
420 freshLine E.ImportEnd
421 return $ Src.Import name maybeAlias exposed
425-- LISTING
428exposing :: Parser E.Exposing Src.Exposing
429exposing =
430 do word1 0x28 {-(-} E.ExposingStart
431 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentValue
432 oneOf E.ExposingValue
433 [ do word2 0x2E 0x2E {-..-} E.ExposingValue
434 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
435 word1 0x29 {-)-} E.ExposingEnd
436 return Src.Open
437 , do exposed <- chompExposed
438 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
439 exposingHelp [exposed]
440 ]
443exposingHelp :: [Src.Exposed] -> Parser E.Exposing Src.Exposing
444exposingHelp revExposed =
445 oneOf E.ExposingEnd
446 [ do word1 0x2C {-,-} E.ExposingEnd
447 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentValue
448 exposed <- chompExposed
449 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
450 exposingHelp (exposed:revExposed)
451 , do word1 0x29 {-)-} E.ExposingEnd
452 return (Src.Explicit (reverse revExposed))
453 ]
456chompExposed :: Parser E.Exposing Src.Exposed
457chompExposed =
458 do start <- getPosition
459 oneOf E.ExposingValue
460 [ do name <- Var.lower E.ExposingValue
461 end <- getPosition
462 return $ Src.Lower $ A.at start end name
463 , do word1 0x28 {-(-} E.ExposingValue
464 op <- Symbol.operator E.ExposingOperator E.ExposingOperatorReserved
465 word1 0x29 {-)-} E.ExposingOperatorRightParen
466 end <- getPosition
467 return $ Src.Operator (A.Region start end) op
468 , do name <- Var.upper E.ExposingValue
469 end <- getPosition
470 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
471 Src.Upper (A.at start end name) <$> privacy
472 ]
475privacy :: Parser E.Exposing Src.Privacy
476privacy =
477 oneOfWithFallback
478 [ do word1 0x28 {-(-} E.ExposingTypePrivacy
479 Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy
480 start <- getPosition
481 word2 0x2E 0x2E {-..-} E.ExposingTypePrivacy
482 end <- getPosition
483 Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy
484 word1 0x29 {-)-} E.ExposingTypePrivacy
485 return $ Src.Public (A.Region start end)
486 ]
487 Src.Private