git.iko.soy/elk
on 6c19c6e help sign in
elk/compiler/src/Parse/Module.hs
441 lines 14 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Parse.Module
4 ( fromByteString
5 , chompImports
6 , chompImport
7 )
8 where
11import qualified Data.ByteString as BS
12import qualified Data.Name as Name
14import qualified AST.Source as Src
15import qualified Elm.Compiler.Imports as Imports
16import qualified Elm.Package as Pkg
17import qualified Parse.Declaration as Decl
18import qualified Parse.Keyword as Keyword
19import qualified Parse.Space as Space
20import qualified Parse.Symbol as Symbol
21import qualified Parse.Variable as Var
22import qualified Parse.Primitives as P
23import Parse.Primitives hiding (State, fromByteString)
24import qualified Reporting.Annotation as A
25import qualified Reporting.Error.Syntax as E
29-- FROM BYTE STRING
32fromByteString :: Pkg.Name -> BS.ByteString -> Either E.Error Src.Module
33fromByteString pkg source =
34 case P.fromByteString (chompModule pkg) E.ModuleBadEnd source of
35 Right modul -> checkModule modul
36 Left err -> Left (E.ParseError err)
40-- MODULE
43data Module =
44 Module
45 { _header :: Maybe Header
46 , _imports :: [Src.Import]
47 , _infixes :: [A.Located Src.Infix]
48 , _decls :: [Decl.Decl]
49 }
52chompModule :: Pkg.Name -> Parser E.Module Module
53chompModule pkg =
54 do header <- chompHeader
55 imports <- chompImports (if pkg == Pkg.core then [] else Imports.defaults)
56 infixes <- if Pkg.isKernel pkg then chompInfixes [] else return []
57 decls <- specialize E.Declarations $ chompDecls []
58 return (Module header imports infixes decls)
62-- CHECK MODULE
65checkModule :: Module -> Either E.Error Src.Module
66checkModule (Module maybeHeader imports infixes decls) =
67 let
68 (values, unions, aliases, ports) = categorizeDecls [] [] [] [] decls
69 in
70 case maybeHeader of
71 Just (Header name effects exports docs) ->
72 Src.Module (Just name) exports (toDocs docs decls) imports values unions aliases infixes
73 <$> checkEffects ports effects
75 Nothing ->
76 Right $
77 Src.Module Nothing (A.At A.one Src.Open) (Src.NoDocs A.one) imports values unions aliases infixes $
78 case ports of
79 [] -> Src.NoEffects
80 _:_ -> Src.Ports ports
83checkEffects :: [Src.Port] -> Effects -> Either E.Error Src.Effects
84checkEffects ports effects =
85 case effects of
86 NoEffects region ->
87 case ports of
88 [] -> Right Src.NoEffects
89 _:_ -> Left (E.UnexpectedPort region)
91 Ports region ->
92 case ports of
93 [] -> Left (E.NoPorts region)
94 _:_ -> Right (Src.Ports ports)
96 Manager region manager ->
97 case ports of
98 [] -> Right (Src.Manager region manager)
99 _:_ -> Left (E.UnexpectedPort region)
102categorizeDecls :: [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] )
103categorizeDecls values unions aliases ports decls =
104 case decls of
105 [] ->
106 (values, unions, aliases, ports)
108 decl:otherDecls ->
109 case decl of
110 Decl.Value _ value -> categorizeDecls (value:values) unions aliases ports otherDecls
111 Decl.Union _ union -> categorizeDecls values (union:unions) aliases ports otherDecls
112 Decl.Alias _ alias -> categorizeDecls values unions (alias:aliases) ports otherDecls
113 Decl.Port _ port_ -> categorizeDecls values unions aliases (port_:ports) otherDecls
117-- TO DOCS
120toDocs :: Either A.Region Src.Comment -> [Decl.Decl] -> Src.Docs
121toDocs comment decls =
122 case comment of
123 Right overview ->
124 Src.YesDocs overview (getComments decls [])
126 Left region ->
127 Src.NoDocs region
130getComments :: [Decl.Decl] -> [(Name.Name,Src.Comment)] -> [(Name.Name,Src.Comment)]
131getComments decls comments =
132 case decls of
133 [] ->
134 comments
136 decl:otherDecls ->
137 case decl of
138 Decl.Value c (A.At _ (Src.Value n _ _ _)) -> getComments otherDecls (addComment c n comments)
139 Decl.Union c (A.At _ (Src.Union n _ _ )) -> getComments otherDecls (addComment c n comments)
140 Decl.Alias c (A.At _ (Src.Alias n _ _ )) -> getComments otherDecls (addComment c n comments)
141 Decl.Port c (Src.Port n _ ) -> getComments otherDecls (addComment c n comments)
144addComment :: Maybe Src.Comment -> A.Located Name.Name -> [(Name.Name,Src.Comment)] -> [(Name.Name,Src.Comment)]
145addComment maybeComment (A.At _ name) comments =
146 case maybeComment of
147 Just comment -> (name, comment) : comments
148 Nothing -> comments
152-- FRESH LINES
155freshLine :: (Row -> Col -> E.Module) -> Parser E.Module ()
156freshLine toFreshLineError =
157 do Space.chomp E.ModuleSpace
158 Space.checkFreshLine toFreshLineError
162-- CHOMP DECLARATIONS
165chompDecls :: [Decl.Decl] -> Parser E.Decl [Decl.Decl]
166chompDecls decls =
167 do (decl, _) <- Decl.declaration
168 oneOfWithFallback
169 [ do Space.checkFreshLine E.DeclStart
170 chompDecls (decl:decls)
171 ]
172 (reverse (decl:decls))
175chompInfixes :: [A.Located Src.Infix] -> Parser E.Module [A.Located Src.Infix]
176chompInfixes infixes =
177 oneOfWithFallback
178 [ do binop <- Decl.infix_
179 chompInfixes (binop:infixes)
180 ]
181 infixes
185-- MODULE DOC COMMENT
188chompModuleDocCommentSpace :: Parser E.Module (Either A.Region Src.Comment)
189chompModuleDocCommentSpace =
190 do (A.At region ()) <- addLocation (freshLine E.FreshLine)
191 oneOfWithFallback
192 [
193 do docComment <- Space.docComment E.ImportStart E.ModuleSpace
194 Space.chomp E.ModuleSpace
195 Space.checkFreshLine E.FreshLine
196 return (Right docComment)
197 ]
198 (Left region)
202-- HEADER
205data Header =
206 Header (A.Located Name.Name) Effects (A.Located Src.Exposing) (Either A.Region Src.Comment)
209data Effects
210 = NoEffects A.Region
211 | Ports A.Region
212 | Manager A.Region Src.Manager
215chompHeader :: Parser E.Module (Maybe Header)
216chompHeader =
217 do freshLine E.FreshLine
218 start <- getPosition
219 oneOfWithFallback
220 [
221 -- module MyThing exposing (..)
222 do Keyword.module_ E.ModuleProblem
223 effectEnd <- getPosition
224 Space.chompAndCheckIndent E.ModuleSpace E.ModuleProblem
225 name <- addLocation (Var.moduleName E.ModuleName)
226 Space.chompAndCheckIndent E.ModuleSpace E.ModuleProblem
227 Keyword.exposing_ E.ModuleProblem
228 Space.chompAndCheckIndent E.ModuleSpace E.ModuleProblem
229 exports <- addLocation (specialize E.ModuleExposing exposing)
230 comment <- chompModuleDocCommentSpace
231 return $ Just $
232 Header name (NoEffects (A.Region start effectEnd)) exports comment
233 ,
234 -- port module MyThing exposing (..)
235 do Keyword.port_ E.PortModuleProblem
236 Space.chompAndCheckIndent E.ModuleSpace E.PortModuleProblem
237 Keyword.module_ E.PortModuleProblem
238 effectEnd <- getPosition
239 Space.chompAndCheckIndent E.ModuleSpace E.PortModuleProblem
240 name <- addLocation (Var.moduleName E.PortModuleName)
241 Space.chompAndCheckIndent E.ModuleSpace E.PortModuleProblem
242 Keyword.exposing_ E.PortModuleProblem
243 Space.chompAndCheckIndent E.ModuleSpace E.PortModuleProblem
244 exports <- addLocation (specialize E.PortModuleExposing exposing)
245 comment <- chompModuleDocCommentSpace
246 return $ Just $
247 Header name (Ports (A.Region start effectEnd)) exports comment
248 ,
249 -- effect module MyThing where { command = MyCmd } exposing (..)
250 do Keyword.effect_ E.Effect
251 Space.chompAndCheckIndent E.ModuleSpace E.Effect
252 Keyword.module_ E.Effect
253 effectEnd <- getPosition
254 Space.chompAndCheckIndent E.ModuleSpace E.Effect
255 name <- addLocation (Var.moduleName E.ModuleName)
256 Space.chompAndCheckIndent E.ModuleSpace E.Effect
257 Keyword.where_ E.Effect
258 Space.chompAndCheckIndent E.ModuleSpace E.Effect
259 manager <- chompManager
260 Space.chompAndCheckIndent E.ModuleSpace E.Effect
261 Keyword.exposing_ E.Effect
262 Space.chompAndCheckIndent E.ModuleSpace E.Effect
263 exports <- addLocation (specialize (const E.Effect) exposing)
264 comment <- chompModuleDocCommentSpace
265 return $ Just $
266 Header name (Manager (A.Region start effectEnd) manager) exports comment
267 ]
268 -- default header
269 Nothing
272chompManager :: Parser E.Module Src.Manager
273chompManager =
274 do word1 0x7B {- { -} E.Effect
275 spaces_em
276 oneOf E.Effect
277 [ do cmd <- chompCommand
278 spaces_em
279 oneOf E.Effect
280 [ do word1 0x7D {-}-} E.Effect
281 spaces_em
282 return (Src.Cmd cmd)
283 , do word1 0x2C {-,-} E.Effect
284 spaces_em
285 sub <- chompSubscription
286 spaces_em
287 word1 0x7D {-}-} E.Effect
288 spaces_em
289 return (Src.Fx cmd sub)
290 ]
291 , do sub <- chompSubscription
292 spaces_em
293 oneOf E.Effect
294 [ do word1 0x7D {-}-} E.Effect
295 spaces_em
296 return (Src.Sub sub)
297 , do word1 0x2C {-,-} E.Effect
298 spaces_em
299 cmd <- chompCommand
300 spaces_em
301 word1 0x7D {-}-} E.Effect
302 spaces_em
303 return (Src.Fx cmd sub)
304 ]
305 ]
308chompCommand :: Parser E.Module (A.Located Name.Name)
309chompCommand =
310 do Keyword.command_ E.Effect
311 spaces_em
312 word1 0x3D {-=-} E.Effect
313 spaces_em
314 addLocation (Var.upper E.Effect)
317chompSubscription :: Parser E.Module (A.Located Name.Name)
318chompSubscription =
319 do Keyword.subscription_ E.Effect
320 spaces_em
321 word1 0x3D {-=-} E.Effect
322 spaces_em
323 addLocation (Var.upper E.Effect)
326spaces_em :: Parser E.Module ()
327spaces_em =
328 Space.chompAndCheckIndent E.ModuleSpace E.Effect
332-- IMPORTS
335chompImports :: [Src.Import] -> Parser E.Module [Src.Import]
336chompImports is =
337 oneOfWithFallback
338 [ do i <- chompImport
339 chompImports (i:is)
340 ]
341 (reverse is)
344chompImport :: Parser E.Module Src.Import
345chompImport =
346 do Keyword.import_ E.ImportStart
347 Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentName
348 name@(A.At (A.Region _ end) _) <- addLocation (Var.moduleName E.ImportName)
349 Space.chomp E.ModuleSpace
350 oneOf E.ImportEnd
351 [ do Space.checkFreshLine E.ImportEnd
352 return $ Src.Import name Nothing (Src.Explicit [])
353 , do Space.checkIndent end E.ImportEnd
354 oneOf E.ImportAs
355 [ chompAs name
356 , chompExposing name Nothing
357 ]
358 ]
361chompAs :: A.Located Name.Name -> Parser E.Module Src.Import
362chompAs name =
363 do Keyword.as_ E.ImportAs
364 Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentAlias
365 alias <- Var.upper E.ImportAlias
366 end <- getPosition
367 Space.chomp E.ModuleSpace
368 oneOf E.ImportEnd
369 [ do Space.checkFreshLine E.ImportEnd
370 return $ Src.Import name (Just alias) (Src.Explicit [])
371 , do Space.checkIndent end E.ImportEnd
372 chompExposing name (Just alias)
373 ]
376chompExposing :: A.Located Name.Name -> Maybe Name.Name -> Parser E.Module Src.Import
377chompExposing name maybeAlias =
378 do Keyword.exposing_ E.ImportExposing
379 Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentExposingList
380 exposed <- specialize E.ImportExposingList exposing
381 freshLine E.ImportEnd
382 return $ Src.Import name maybeAlias exposed
386-- LISTING
389exposing :: Parser E.Exposing Src.Exposing
390exposing =
391 do word1 0x28 {-(-} E.ExposingStart
392 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentValue
393 oneOf E.ExposingValue
394 [ do word2 0x2E 0x2E {-..-} E.ExposingValue
395 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
396 word1 0x29 {-)-} E.ExposingEnd
397 return Src.Open
398 , do exposed <- addLocation chompExposed
399 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
400 exposingHelp [exposed]
401 ]
404exposingHelp :: [A.Located Src.Exposed] -> Parser E.Exposing Src.Exposing
405exposingHelp revExposed =
406 oneOf E.ExposingEnd
407 [ do word1 0x2C {-,-} E.ExposingEnd
408 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentValue
409 exposed <- addLocation chompExposed
410 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
411 exposingHelp (exposed:revExposed)
412 , do word1 0x29 {-)-} E.ExposingEnd
413 return (Src.Explicit (reverse revExposed))
414 ]
417chompExposed :: Parser E.Exposing Src.Exposed
418chompExposed =
419 oneOf E.ExposingValue
420 [ Src.Lower <$> Var.lower E.ExposingValue
421 , do word1 0x28 {-(-} E.ExposingValue
422 op <- Symbol.operator E.ExposingOperator E.ExposingOperatorReserved
423 word1 0x29 {-)-} E.ExposingOperatorRightParen
424 return (Src.Operator op)
425 , do name <- Var.upper E.ExposingValue
426 Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
427 Src.Upper name <$> privacy
428 ]
431privacy :: Parser E.Exposing Src.Privacy
432privacy =
433 oneOfWithFallback
434 [ do word1 0x28 {-(-} E.ExposingTypePrivacy
435 Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy
436 word2 0x2E 0x2E {-..-} E.ExposingTypePrivacy
437 Space.chompAndCheckIndent E.ExposingSpace E.ExposingTypePrivacy
438 word1 0x29 {-)-} E.ExposingTypePrivacy
439 return Src.Public
440 ]
441 Src.Private