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