@@ -1,71 +1,48 @@
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2module Parse.Parse (program) where
2module Parse.Parse (program) where
4−import Text.Parsec (char, eof, letter, many, (<|>))
4+import Control.Monad (guard)
5−import qualified Text.Parsec.Error as Parsec
5+import Data.Text (Text, unpack)
7import qualified AST.Declaration as Decl
7import qualified AST.Declaration as Decl
8import qualified AST.Module as Module
8import qualified AST.Module as Module
9import qualified AST.Module.Name as ModuleName
9import qualified AST.Module.Name as ModuleName
10import qualified Elm.Package as Package
10import qualified Elm.Package as Package
11−import Parse.Helpers (IParser, commitIf, freshLine, newline, parse, spaces)
11+import Parse.Helpers
12import qualified Parse.Module as Parse (header)
12import qualified Parse.Module as Parse (header)
13import qualified Parse.Declaration as Parse (declaration)
13import 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
17import qualified Validate
14import qualified Validate
21−program :: Package.Name -> String -> Validate.Result wrn Module.Valid
18+-- PROGRAM
23− do modul <- toResult (parse (programParser pkgName) src)
24− Validate.module' modul
27−-- HEADERS AND DECLARATIONS
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)
39− (ModuleName.Canonical pkgName name)
41− (Module.Source tag settings docs exports imports decls)
44−declarations :: IParser [Decl.Source]
46− (:) <$> Parse.declaration
21+program :: Package.Name -> Text -> Validate.Result wrn Module.Valid
23+ case run (chompProgram pkgName) src of
25+ Validate.validate modul
50−freshDef :: IParser Decl.Source
27+ Left err ->
51−freshDef =
28+ error (unlines $ take 10 $ "TODO program parse error" : lines (unpack src)) err
52− commitIf (freshLine >> (letter <|> char '_')) $
58−-- PARSER OUTPUT TO RESULT
61−toResult :: Either Parsec.ParseError a -> Validate.Result wrn a
62−toResult parserOutput =
67− Left err ->
31+chompProgram :: Package.Name -> Parser Module.Source
68− let pos = R.fromSourcePos (Parsec.errorPos err)
32+chompProgram pkgName =
69− msgs = Parsec.errorMessages err
33+ do (Module.Header tag name exports settings docs imports) <- Parse.header
70− in
34+ decls <- chompDeclarations []
71− Result.throw (R.Region pos pos) (Error.Parse msgs)
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)
41+chompDeclarations :: [Decl.Source] -> Parser [Decl.Source]
42+chompDeclarations decls =
43+ do (decl, _, space) <- Parse.declaration
45+ [ do guard (space == Freshline)
46+ chompDeclarations (decl:decls)
47+ , return (reverse (decl:decls))