@@ -32,78 +32,59 @@ import qualified Reporting.Error.Syntax as E
3232
3333fromByteString :: Pkg.Name -> BS.ByteString -> Either E.Error Src.Module
3434fromByteString pkg source =
35− let
36− parser
37− | pkg == Pkg.core = core
38− | Pkg.isKernel pkg = platform
39− | otherwise = normal
40− in
41− case P.fromByteString parser source of
42− P.Ok outcome _ ->
43− case outcome of
44− Right modul -> Right modul
45− Left err -> Left err
46−
47− P.Err err ->
48− Left (E.ParseError err)
35+ case P.fromByteString (chompModule pkg) source of
36+ P.Ok modul _ -> checkModule modul
37+ P.Err err -> Left (E.ParseError err)
4938
5039
5140
5241-- MODULE
5342
5443
55−normal :: Parser E.Module (Either E.Error Src.Module)
56−normal =
57− do freshLine E.FreshLine
58− header <- chompHeader
59− comment <- chompModuleDocComment
60− imports <- chompImports []
61− decls <- specialize E.Declarations $ chompDecls []
62− endOfFile
63− return (checkModule header comment (Imports.addDefaults imports) [] decls)
44+data Module =
45+ Module
46+ { _header :: Maybe Header
47+ , _comment :: Maybe Src.Comment
48+ , _imports :: [Src.Import]
49+ , _infixes :: [A.Located Src.Infix]
50+ , _decls :: [Decl.Decl]
51+ }
6452
6553
66−core :: Parser E.Module (Either E.Error Src.Module)
67−core =
54+chompModule :: Pkg.Name -> Parser E.Module Module
55+chompModule pkg =
6856 do freshLine E.FreshLine
6957 header <- chompHeader
7058 comment <- chompModuleDocComment
71− imports <- chompImports []
72− binops <- chompBinops []
59+ imports <- chompImports (if pkg == Pkg.core then [] else Imports.defaults)
60+ infixes <- if Pkg.isKernel pkg then chompInfixes [] else return []
7361 decls <- specialize E.Declarations $ chompDecls []
7462 endOfFile
75− return (checkModule header comment imports binops decls)
76−
77−
78−platform :: Parser E.Module (Either E.Error Src.Module)
79−platform =
80− do freshLine E.FreshLine
81− header <- chompHeader
82− comment <- chompModuleDocComment
83− imports <- chompImports []
84− binops <- chompBinops []
85− decls <- specialize E.Declarations $ chompDecls []
86− endOfFile
87− return (checkModule header comment (Imports.addDefaults imports) binops decls)
63+ return (Module header comment imports infixes decls)
8864
8965
9066
9167-- CHECK MODULE
9268
9369
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 =
70+checkModule :: Module -> Either E.Error Src.Module
71+checkModule (Module maybeHeader maybeComment imports infixes decls) =
9672 let
9773 (values, unions, aliases, ports) = categorizeDecls [] [] [] [] decls
74+
75+ docs =
76+ case maybeComment of
77+ Just c -> Just (Src.Docs c (getComments decls []))
78+ Nothing -> Nothing
9879 in
9980 case maybeHeader of
10081 Just (Header name effects exports) ->
101− Src.Module (Just name) exports imports values unions aliases binops
82+ Src.Module (Just name) exports docs imports values unions aliases infixes
10283 <$> checkEffects ports effects
10384
10485 Nothing ->
10586 Right $
106− Src.Module Nothing (A.At A.one Src.Open) imports values unions aliases binops $
87+ Src.Module Nothing (A.At A.one Src.Open) docs imports values unions aliases infixes $
10788 case ports of
10889 [] -> Src.NoEffects
10990 _:_ -> Src.Ports ports
@@ -142,6 +123,27 @@ categorizeDecls values unions aliases ports decls =
142123 Decl.Port _ port_ -> categorizeDecls values unions aliases (port_:ports) otherDecls
143124
144125
126+getComments :: [Decl.Decl] -> [(Name.Name,Src.Comment)] -> [(Name.Name,Src.Comment)]
127+getComments decls comments =
128+ case decls of
129+ [] ->
130+ comments
131+
132+ decl:otherDecls ->
133+ case decl of
134+ Decl.Value c (A.At _ (Src.Value n _ _ _)) -> getComments otherDecls (addComment c n comments)
135+ Decl.Union c (A.At _ (Src.Union n _ _ )) -> getComments otherDecls (addComment c n comments)
136+ Decl.Alias c (A.At _ (Src.Alias n _ _ )) -> getComments otherDecls (addComment c n comments)
137+ Decl.Port c (Src.Port n _ ) -> getComments otherDecls (addComment c n comments)
138+
139+
140+addComment :: Maybe Src.Comment -> A.Located Name.Name -> [(Name.Name,Src.Comment)] -> [(Name.Name,Src.Comment)]
141+addComment maybeComment (A.At _ name) comments =
142+ case maybeComment of
143+ Just comment -> (name, comment) : comments
144+ Nothing -> comments
145+
146+
145147
146148-- FRESH LINES
147149
@@ -175,20 +177,20 @@ chompDecls decls =
175177 (reverse (decl:decls))
176178
177179
178−chompBinops :: [A.Located Src.Binop] -> Parser E.Module [A.Located Src.Binop]
179−chompBinops binops =
180+chompInfixes :: [A.Located Src.Infix] -> Parser E.Module [A.Located Src.Infix]
181+chompInfixes infixes =
180182 oneOfWithFallback
181183 [ do binop <- Decl.infix_
182− chompBinops (binop:binops)
184+ chompInfixes (binop:infixes)
183185 ]
184− binops
186+ infixes
185187
186188
187189
188190-- MODULE DOC COMMENT
189191
190192
191−chompModuleDocComment :: Parser E.Module (Maybe Space.DocComment)
193+chompModuleDocComment :: Parser E.Module (Maybe Src.Comment)
192194chompModuleDocComment =
193195 oneOfWithFallback
194196 [