@@ -4,14 +4,12 @@ module Parse.Module
44 ( fromByteString
55 , Header(..)
66 , Effects(..)
7− , chompHeader
87 , chompImports
9− , freshLine
108 )
119 where
1210
1311
14−import qualified Data.ByteString as B
12+import qualified Data.ByteString as BS
1513import qualified Data.Name as Name
1614
1715import qualified AST.Source as Src
@@ -19,21 +17,20 @@ import qualified Elm.Compiler.Imports as Imports
1917import qualified Elm.Package as Pkg
2018import qualified Parse.Declaration as Decl
2119import qualified Parse.Keyword as Keyword
20+import qualified Parse.Space as Space
2221import qualified Parse.Symbol as Symbol
2322import qualified Parse.Variable as Var
2423import qualified Parse.Primitives as P
25−import Parse.Primitives hiding (Parser, State, fromByteString)
26−import Parse.Utils
24+import Parse.Primitives hiding (State, fromByteString)
2725import qualified Reporting.Annotation as A
2826import qualified Reporting.Error.Syntax as E
29−import qualified Reporting.Result as Result
3027
3128
3229
3330-- FROM BYTE STRING
3431
3532
36−fromByteString :: Pkg.Name -> B.ByteString -> Result.Result i w E.Error Src.Module
33+fromByteString :: Pkg.Name -> BS.ByteString -> Either E.Error Src.Module
3734fromByteString pkg source =
3835 let
3936 parser
@@ -44,80 +41,91 @@ fromByteString pkg source =
4441 case P.fromByteString parser source of
4542 P.Ok outcome _ ->
4643 case outcome of
47− Right modul -> Result.ok modul
48− Left err -> Result.throw err
44+ Right modul -> Right modul
45+ Left err -> Left err
4946
50− P.Err row col ctx err ->
51− Result.throw (E.ParseError row col ctx err)
47+ P.Err err ->
48+ Left (E.ParseError err)
5249
5350
5451
5552-- MODULE
5653
5754
58−normal :: Parser (Either E.Error Src.Module)
55+normal :: Parser E.Module (Either E.Error Src.Module)
5956normal =
60− do freshLine
57+ do freshLine E.FreshLineModuleStart
6158 header <- chompHeader
59+ comment <- chompModuleDocComment
6260 imports <- chompImports []
63− decls <- chompDecls []
61+ decls <- specialize E.Declarations $ chompDecls []
6462 endOfFile
65− return (checkModule header (Imports.addDefaults imports) [] decls)
63+ return (checkModule header comment (Imports.addDefaults imports) [] decls)
6664
6765
68−core :: Parser (Either E.Error Src.Module)
66+core :: Parser E.Module (Either E.Error Src.Module)
6967core =
70− do freshLine
68+ do freshLine E.FreshLineModuleStart
7169 header <- chompHeader
70+ comment <- chompModuleDocComment
7271 imports <- chompImports []
7372 binops <- chompBinops []
74− decls <- chompDecls []
73+ decls <- specialize E.Declarations $ chompDecls []
7574 endOfFile
76− return (checkModule header imports binops decls)
75+ return (checkModule header comment imports binops decls)
7776
7877
79−platform :: Parser (Either E.Error Src.Module)
78+platform :: Parser E.Module (Either E.Error Src.Module)
8079platform =
81− do freshLine
80+ do freshLine E.FreshLineModuleStart
8281 header <- chompHeader
82+ comment <- chompModuleDocComment
8383 imports <- chompImports []
8484 binops <- chompBinops []
85− decls <- chompDecls []
85+ decls <- specialize E.Declarations $ chompDecls []
8686 endOfFile
87− return (checkModule header (Imports.addDefaults imports) binops decls)
87+ return (checkModule header comment (Imports.addDefaults imports) binops decls)
8888
8989
9090
9191-- CHECK MODULE
9292
9393
94−checkModule :: Maybe Header -> [Src.Import] -> [A.Located Src.Binop] -> [Decl.Decl] -> Either E.Error Src.Module
95−checkModule maybeHeader imports binops decls =
94+checkModule :: Maybe Header -> Maybe Space.DocComment -> [Src.Import] -> [A.Located Src.Binop] -> [Decl.Decl] -> Either E.Error Src.Module
95+checkModule maybeHeader _maybeDocs imports binops decls =
9696 let
97− (Header name effects exports) = maybe (Header "Main" NoEffects (A.At A.one Src.Open)) id maybeHeader
9897 (values, unions, aliases, ports) = categorizeDecls [] [] [] [] decls
9998 in
100− Src.Module name exports imports values unions aliases binops
101− <$> checkEffects ports effects
99+ case maybeHeader of
100+ Just (Header name effects exports) ->
101+ Src.Module (Just name) exports imports values unions aliases binops
102+ <$> checkEffects ports effects
103+
104+ Nothing ->
105+ Right $
106+ Src.Module Nothing (A.At A.one Src.Open) imports values unions aliases binops $
107+ case ports of
108+ [] -> Src.NoEffects
109+ _:_ -> Src.Ports ports
102110
103111
104112checkEffects :: [Src.Port] -> Effects -> Either E.Error Src.Effects
105113checkEffects ports effects =
106114 case effects of
107− NoEffects ->
115+ NoEffects region ->
108116 case ports of
109117 [] -> Right Src.NoEffects
110− _:_ -> Left (error "TODO no ports")
118+ _:_ -> Left (E.UnexpectedPort region)
111119
112120 Ports region ->
113121 case ports of
114− [] -> Left (error "TODO no ports in port module" region)
122+ [] -> Left (E.NoPorts region)
115123 _:_ -> Right (Src.Ports ports)
116124
117125 Manager region manager ->
118126 case ports of
119127 [] -> Right (Src.Manager region manager)
120− _:_ -> Left (error "TODO ports in effect manager")
128+ _:_ -> Left (E.UnexpectedPort region)
121129
122130
123131categorizeDecls :: [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] )
@@ -128,26 +136,27 @@ categorizeDecls values unions aliases ports decls =
128136
129137 decl:otherDecls ->
130138 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
139+ Decl.Value _ value -> categorizeDecls (value:values) unions aliases ports otherDecls
140+ Decl.Union _ union -> categorizeDecls values (union:unions) aliases ports otherDecls
141+ Decl.Alias _ alias -> categorizeDecls values unions (alias:aliases) ports otherDecls
142+ Decl.Port _ port_ -> categorizeDecls values unions aliases (port_:ports) otherDecls
135143
136144
137145
138146-- FRESH LINES
139147
140148
141−freshLine :: Parser ()
142−freshLine =
143− checkFreshLine =<< whitespace
149+freshLine :: (Row -> Col -> E.Module) -> Parser E.Module ()
150+freshLine toFreshLineError =
151+ do Space.chomp E.ModuleSpace
152+ Space.checkFreshLine toFreshLineError
144153
145154
146−endOfFile :: Parser ()
155+endOfFile :: Parser E.Module ()
147156endOfFile =
148− P.Parser $ \state@(P.State pos end _ row col ctx) _ eok _ eerr ->
157+ P.Parser $ \state@(P.State pos end _ row col) _ eok _ eerr ->
149158 if pos < end then
150− eerr row col ctx E.EndOfFile
159+ eerr row col E.ModuleEndOfFile
151160 else
152161 eok () state
153162
@@ -156,23 +165,39 @@ endOfFile =
156165-- CHOMP DECLARATIONS
157166
158167
159−chompDecls :: [Decl.Decl] -> Parser [Decl.Decl]
168+chompDecls :: [Decl.Decl] -> Parser E.Decl [Decl.Decl]
160169chompDecls decls =
161− do (decl, _, pos) <- Decl.declaration
162− oneOf E.XXX
163− [ do checkFreshLine pos
170+ do (decl, _) <- Decl.declaration
171+ oneOfWithFallback
172+ [ do Space.checkFreshLine E.DeclFreshLineStart
164173 chompDecls (decl:decls)
165− , return (reverse (decl:decls))
166174 ]
175+ (reverse (decl:decls))
167176
168177
169−chompBinops :: [A.Located Src.Binop] -> Parser [A.Located Src.Binop]
178+chompBinops :: [A.Located Src.Binop] -> Parser E.Module [A.Located Src.Binop]
170179chompBinops binops =
171− oneOf E.XXX
180+ oneOfWithFallback
172181 [ do binop <- Decl.infix_
173182 chompBinops (binop:binops)
174− , return binops
175183 ]
184+ binops
185+
186+
187+
188+-- MODULE DOC COMMENT
189+
190+
191+chompModuleDocComment :: Parser E.Module (Maybe Space.DocComment)
192+chompModuleDocComment =
193+ oneOfWithFallback
194+ [
195+ do docComment <- Space.docComment E.ImportStart E.ModuleSpace
196+ Space.chomp E.ModuleSpace
197+ Space.checkFreshLine E.FreshLineAfterDocComment
198+ return (Just docComment)
199+ ]
200+ Nothing
176201
177202
178203
@@ -184,175 +209,170 @@ data Header =
184209
185210
186211data Effects
187− = NoEffects
212+ = NoEffects A.Region
188213 | Ports A.Region
189214 | Manager A.Region Src.Manager
190215
191216
192−chompHeader :: Parser (Maybe Header)
217+chompHeader :: Parser E.Module (Maybe Header)
193218chompHeader =
194219 do start <- getPosition
195− oneOf E.XXX
220+ oneOfWithFallback
196221 [
197222 -- 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))
223+ do Keyword.module_ E.Module
224+ end <- getPosition
225+ Space.chompAndCheckIndent E.ModuleSpace E.ModuleIndentName
226+ name <- Var.moduleName E.ModuleName
227+ Space.chompAndCheckIndent E.ModuleSpace E.ModuleIndentExposing
228+ Keyword.exposing_ E.ModuleExposing
229+ Space.chompAndCheckIndent E.ModuleSpace E.ModuleIndentExposingList
230+ exports <- addLocation (specialize E.ModuleExposingList exposing)
231+ freshLine E.FreshLineAfterModuleLine
232+ return (Just (Header name (NoEffects (A.Region start end)) exports))
209233 ,
210234 -- port module MyThing exposing (..)
211− do Keyword.port_
212− pushContext start E.Module
213− spaces
214− Keyword.module_
235+ do Keyword.port_ E.Module
236+ Space.chompAndCheckIndent E.ModuleSpace E.ModuleIndentPortModule
237+ Keyword.module_ E.ModulePortModule
215238 end <- getPosition
216− spaces
217− name <- Var.moduleName
218− spaces
219− Keyword.exposing_
220− spaces
221− exports <- addLocation exposing
222− popContext ()
223− freshLine
239+ Space.chompAndCheckIndent E.ModuleSpace E.ModuleIndentName
240+ name <- Var.moduleName E.ModuleName
241+ Space.chompAndCheckIndent E.ModuleSpace E.ModuleIndentExposing
242+ Keyword.exposing_ E.ModuleExposing
243+ Space.chompAndCheckIndent E.ModuleSpace E.ModuleIndentExposingList
244+ exports <- addLocation (specialize E.ModuleExposingList exposing)
245+ freshLine E.FreshLineAfterModuleLine
224246 return (Just (Header name (Ports (A.Region start end)) exports))
225247 ,
226248 -- effect module MyThing where { command = MyCmd } exposing (..)
227− do Keyword.effect_
228− pushContext start E.Module
229− spaces
230− Keyword.module_
249+ do Keyword.effect_ E.Module
250+ Space.chompAndCheckIndent E.ModuleSpace E.ModuleEffect
251+ Keyword.module_ E.ModuleEffect
231252 end <- getPosition
232− spaces
233− name <- Var.moduleName
234− spaces
235− Keyword.where_
236− spaces
253+ Space.chompAndCheckIndent E.ModuleSpace E.ModuleEffect
254+ name <- Var.moduleName E.ModuleName
255+ Space.chompAndCheckIndent E.ModuleSpace E.ModuleEffect
256+ Keyword.where_ E.ModuleEffect
257+ Space.chompAndCheckIndent E.ModuleSpace E.ModuleEffect
237258 manager <- chompManager
238− spaces
239− Keyword.exposing_
240− spaces
241− exports <- addLocation exposing
242− popContext ()
243− freshLine
259+ Space.chompAndCheckIndent E.ModuleSpace E.ModuleIndentExposing
260+ Keyword.exposing_ E.ModuleExposing
261+ Space.chompAndCheckIndent E.ModuleSpace E.ModuleIndentExposingList
262+ exports <- addLocation (specialize E.ModuleExposingList exposing)
263+ freshLine E.FreshLineAfterModuleLine
244264 return (Just (Header name (Manager (A.Region start end) manager) exports))
245− ,
246− -- default header
247− return Nothing
248265 ]
266+ -- default header
267+ Nothing
249268
250269
251−chompManager :: Parser Src.Manager
270+chompManager :: Parser E.Module Src.Manager
252271chompManager =
253− do word1 0x7B {- { -} E.XXX
254− spaces
255− oneOf E.XXX
272+ do word1 0x7B {- { -} E.ModuleEffect
273+ spaces_em
274+ oneOf E.ModuleEffect
256275 [ do cmd <- chompCommand
257− spaces
258− oneOf E.XXX
259− [ do word1 0x7D {-}-} E.XXX
260− spaces
276+ spaces_em
277+ oneOf E.ModuleEffect
278+ [ do word1 0x7D {-}-} E.ModuleEffect
279+ spaces_em
261280 return (Src.Cmd cmd)
262− , do word1 0x2C {-,-} E.XXX
263− spaces
281+ , do word1 0x2C {-,-} E.ModuleEffect
282+ spaces_em
264283 sub <- chompSubscription
265− spaces
266− word1 0x7D {-}-} E.XXX
267− spaces
284+ spaces_em
285+ word1 0x7D {-}-} E.ModuleEffect
286+ spaces_em
268287 return (Src.Fx cmd sub)
269288 ]
270289 , do sub <- chompSubscription
271− spaces
272− oneOf E.XXX
273− [ do word1 0x7D {-}-} E.XXX
274− spaces
290+ spaces_em
291+ oneOf E.ModuleEffect
292+ [ do word1 0x7D {-}-} E.ModuleEffect
293+ spaces_em
275294 return (Src.Sub sub)
276− , do word1 0x2C {-,-} E.XXX
277− spaces
295+ , do word1 0x2C {-,-} E.ModuleEffect
296+ spaces_em
278297 cmd <- chompCommand
279− spaces
280− word1 0x7D {-}-} E.XXX
281− spaces
298+ spaces_em
299+ word1 0x7D {-}-} E.ModuleEffect
300+ spaces_em
282301 return (Src.Fx cmd sub)
283302 ]
284303 ]
285304
286305
287−chompCommand :: Parser (A.Located Name.Name)
306+chompCommand :: Parser E.Module (A.Located Name.Name)
288307chompCommand =
289− do Keyword.command_
290− spaces
291− word1 0x3D {-=-} E.XXX
292− spaces
293− addLocation Var.upper
308+ do Keyword.command_ E.ModuleEffect
309+ spaces_em
310+ word1 0x3D {-=-} E.ModuleEffect
311+ spaces_em
312+ addLocation (Var.upper E.ModuleEffect)
294313
295314
296−chompSubscription :: Parser (A.Located Name.Name)
315+chompSubscription :: Parser E.Module (A.Located Name.Name)
297316chompSubscription =
298− do Keyword.subscription_
299− spaces
300− word1 0x3D {-=-} E.XXX
301− spaces
302− addLocation Var.upper
317+ do Keyword.subscription_ E.ModuleEffect
318+ spaces_em
319+ word1 0x3D {-=-} E.ModuleEffect
320+ spaces_em
321+ addLocation (Var.upper E.ModuleEffect)
322+
323+
324+spaces_em :: Parser E.Module ()
325+spaces_em =
326+ Space.chompAndCheckIndent E.ModuleSpace E.ModuleEffect
303327
304328
305329
306330-- IMPORTS
307331
308332
309−chompImports :: [Src.Import] -> Parser [Src.Import]
333+chompImports :: [Src.Import] -> Parser E.Module [Src.Import]
310334chompImports 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 ()
335+ oneOfWithFallback
336+ [ do Keyword.import_ E.ImportStart
337+ Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentName
338+ name@(A.At (A.Region _ end) _) <- addLocation (Var.moduleName E.ImportName)
339+ Space.chomp E.ModuleSpace
340+ oneOf E.ImportEnd
341+ [ do Space.checkFreshLine E.ImportEnd
321342 chompImports $
322343 Src.Import name Nothing (Src.Explicit []) : imports
323− , do checkSpace pos
324− oneOf E.XXX
344+ , do Space.checkIndent end E.ImportIndentAs
345+ oneOf E.ImportAs
325346 [ chompAs name imports
326347 , chompExposing name Nothing imports
327348 ]
328349 ]
329− , return (reverse imports)
330350 ]
351+ (reverse imports)
331352
332353
333−chompAs :: A.Located Name.Name -> [Src.Import] -> Parser [Src.Import]
354+chompAs :: A.Located Name.Name -> [Src.Import] -> Parser E.Module [Src.Import]
334355chompAs 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 ()
356+ do Keyword.as_ E.ImportAs
357+ Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentAlias
358+ alias <- Var.upper E.ImportAlias
359+ end <- getPosition
360+ Space.chomp E.ModuleSpace
361+ oneOf E.ImportEnd
362+ [ do Space.checkFreshLine E.ImportEnd
342363 chompImports $
343364 Src.Import name (Just alias) (Src.Explicit []) : imports
344− , do checkSpace pos
365+ , do Space.checkIndent end E.ImportIndentExposing
345366 chompExposing name (Just alias) imports
346367 ]
347368
348369
349−chompExposing :: A.Located Name.Name -> Maybe Name.Name -> [Src.Import] -> Parser [Src.Import]
370+chompExposing :: A.Located Name.Name -> Maybe Name.Name -> [Src.Import] -> Parser E.Module [Src.Import]
350371chompExposing name maybeAlias imports =
351− do Keyword.exposing_
352− spaces
353− exposed <- exposing
354− freshLine
355− popContext ()
372+ do Keyword.exposing_ E.ImportExposing
373+ Space.chompAndCheckIndent E.ModuleSpace E.ImportIndentExposingList
374+ exposed <- specialize E.ImportExposingList exposing
375+ freshLine E.ImportEnd
356376 chompImports $
357377 Src.Import name maybeAlias exposed : imports
358378
@@ -361,56 +381,56 @@ chompExposing name maybeAlias imports =
361381-- LISTING
362382
363383
364−exposing :: Parser Src.Exposing
384+exposing :: Parser E.Exposing Src.Exposing
365385exposing =
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
386+ do word1 0x28 {-(-} E.ExposingStart
387+ Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentValue
388+ oneOf E.ExposingIndentValue
389+ [ do word2 0x2E 0x2E {-..-} E.ExposingIndentValue
390+ Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
391+ word1 0x29 {-)-} E.ExposingEnd
372392 return Src.Open
373− , do entry <- addLocation chompEntry
374− spaces
375− exposingHelp [entry]
393+ , do exposed <- addLocation chompExposed
394+ Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentEnd
395+ exposingHelp [exposed]
376396 ]
377397
378398
379−exposingHelp :: [A.Located Src.Exposed] -> Parser Src.Exposing
380−exposingHelp 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))
399+exposingHelp :: [A.Located Src.Exposed] -> Parser E.Exposing Src.Exposing
400+exposingHelp revExposed =
401+ oneOf E.ExposingEnd
402+ [ do word1 0x2C {-,-} E.ExposingEnd
403+ Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentValue
404+ exposed <- addLocation chompExposed
405+ Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentValueEnd
406+ exposingHelp (exposed:revExposed)
407+ , do word1 0x29 {-)-} E.ExposingEnd
408+ return (Src.Explicit (reverse revExposed))
389409 ]
390410
391411
392−chompEntry :: Parser Src.Exposed
393−chompEntry =
394− oneOf E.XXX
395− [ Src.Lower <$> Var.lower
396− , do word1 0x28 {-(-} E.XXX
397− op <- Symbol.binop
398− word1 0x29 {-)-} E.XXX
412+chompExposed :: Parser E.Exposing Src.Exposed
413+chompExposed =
414+ oneOf E.ExposingValue
415+ [ Src.Lower <$> Var.lower E.ExposingValue
416+ , do word1 0x28 {-(-} E.ExposingValue
417+ op <- Symbol.operator E.ExposingOperator E.ExposingOperatorReserved
418+ word1 0x29 {-)-} E.ExposingOperatorRightParen
399419 return (Src.Operator op)
400− , do name <- Var.upper
401− spaces
420+ , do name <- Var.upper E.ExposingValue
421+ Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentTypePrivacy
402422 Src.Upper name <$> privacy
403423 ]
404424
405425
406−privacy :: Parser Src.Privacy
426+privacy :: Parser E.Exposing Src.Privacy
407427privacy =
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
428+ oneOfWithFallback
429+ [ do word1 0x28 {-(-} E.ExposingTypePrivacy
430+ Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentTypePrivacyDots
431+ word2 0x2E 0x2E {-..-} E.ExposingTypePrivacyDots
432+ Space.chompAndCheckIndent E.ExposingSpace E.ExposingIndentTypePrivacyEnd
433+ word1 0x29 {-)-} E.ExposingTypePrivacyEnd
414434 return Src.Public
415− , return Src.Private
416435 ]
436+ Src.Private