@@ -1,71 +1,48 @@
11{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
22module Parse.Parse (program) where
33
4−import Text.Parsec (char, eof, letter, many, (<|>))
5−import qualified Text.Parsec.Error as Parsec
4+import Control.Monad (guard)
5+import Data.Text (Text, unpack)
66
77import qualified AST.Declaration as Decl
88import qualified AST.Module as Module
99import qualified AST.Module.Name as ModuleName
1010import qualified Elm.Package as Package
11−import Parse.Helpers (IParser, commitIf, freshLine, newline, parse, spaces)
11+import Parse.Helpers
1212import qualified Parse.Module as Parse (header)
1313import qualified Parse.Declaration as Parse (declaration)
14−import qualified Reporting.Region as R
15−import qualified Reporting.Error.Syntax as Error
16−import qualified Reporting.Result as Result
1714import qualified Validate
1815
1916
2017
21−program :: Package.Name -> String -> Validate.Result wrn Module.Valid
22−program pkgName src =
23− do modul <- toResult (parse (programParser pkgName) src)
24− Validate.module' modul
25−
26−
27−-- HEADERS AND DECLARATIONS
28−
29−
30−programParser :: Package.Name -> IParser Module.Source
31−programParser pkgName =
32− do (Module.Header tag name exports settings docs imports) <- Parse.header
33− decls <- declarations
34− many (spaces <|> newline)
35− eof
36−
37− return $
38− Module.Module
39− (ModuleName.Canonical pkgName name)
40− ""
41− (Module.Source tag settings docs exports imports decls)
42−
18+-- PROGRAM
4319
44−declarations :: IParser [Decl.Source]
45−declarations =
46− (:) <$> Parse.declaration
47− <*> many freshDef
4820
21+program :: Package.Name -> Text -> Validate.Result wrn Module.Valid
22+program pkgName src =
23+ case run (chompProgram pkgName) src of
24+ Right modul ->
25+ Validate.validate modul
4926
50−freshDef :: IParser Decl.Source
51−freshDef =
52− commitIf (freshLine >> (letter <|> char '_')) $
53− do freshLine
54− Parse.declaration
55−
56−
57−
58−-- PARSER OUTPUT TO RESULT
59−
27+ Left err ->
28+ error (unlines $ take 10 $ "TODO program parse error" : lines (unpack src)) err
6029
61−toResult :: Either Parsec.ParseError a -> Validate.Result wrn a
62−toResult parserOutput =
63− case parserOutput of
64− Right result ->
65− return result
6630
67− Left err ->
68− let pos = R.fromSourcePos (Parsec.errorPos err)
69− msgs = Parsec.errorMessages err
70− in
71− Result.throw (R.Region pos pos) (Error.Parse msgs)
31+chompProgram :: Package.Name -> Parser Module.Source
32+chompProgram pkgName =
33+ do (Module.Header tag name exports settings docs imports) <- Parse.header
34+ decls <- chompDeclarations []
35+ endOfFile
36+ let moduleName = ModuleName.Canonical pkgName name
37+ let source = Module.Source tag settings docs exports imports decls
38+ return (Module.Module moduleName "" source)
39+
40+
41+chompDeclarations :: [Decl.Source] -> Parser [Decl.Source]
42+chompDeclarations decls =
43+ do (decl, _, space) <- Parse.declaration
44+ oneOf
45+ [ do guard (space == Freshline)
46+ chompDeclarations (decl:decls)
47+ , return (reverse (decl:decls))
48+ ]