on master help sign in
Convert program parser to new parsing system
1f0970fEvan Czaplicki
src/Parse/Parse.hs+29−52
@@ -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
3
3
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)
6
6
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
18
15
19
16
20
17
21−program :: Package.Name -> String -> Validate.Result wrn Module.Valid
18+-- PROGRAM
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−
43
19
44−declarations :: IParser [Decl.Source]
45−declarations =
46− (:) <$> Parse.declaration
47− <*> many freshDef
48
20
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
49
26
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 '_')) $
53− do freshLine
54− Parse.declaration
55−
56−
57−
58−-- PARSER OUTPUT TO RESULT
59−
60
29
61−toResult :: Either Parsec.ParseError a -> Validate.Result wrn a
62−toResult parserOutput =
63− case parserOutput of
64− Right result ->
65− return result
66
30
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)
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+ ]