git.iko.soy/elk
on master help sign in
style: modern indentation
ed22dbdEvan Czaplicki
src/Parse/Parse.hs+49−34
compare with master
unifiedsplit
@@ -14,51 +14,66 @@ import qualified Parse.Module as Module
14import qualified Parse.Declaration as Decl
14import qualified Parse.Declaration as Decl
15import Transform.Declaration (combineAnnotations)
15import Transform.Declaration (combineAnnotations)
16
16
17−freshDef = commitIf (freshLine >> (letter <|> char '_')) $ do
18− freshLine
19− Decl.declaration <?> "another datatype or variable definition"
20
17
18+freshDef =
19+ commitIf (freshLine >> (letter <|> char '_')) $
20+ do freshLine
21+ Decl.declaration <?> "another datatype or variable definition"
22+
23+
24+decls =
21−decls = do d <- Decl.declaration <?> "at least one datatype or variable definition"
25+ do d <- Decl.declaration <?> "at least one datatype or variable definition"
22− (d:) <$> many freshDef
26+ (d:) <$> many freshDef
27+
23
28
24program :: OpTable -> String -> Either [P.Doc] M.ValidModule
29program :: OpTable -> String -> Either [P.Doc] M.ValidModule
25program table src =
30program table src =
26− do (M.Module names filePath exs ims sourceDecls) <-
31+ do (M.Module names filePath exs ims sourceDecls) <-
27− setupParserWithTable table programParser src
32+ setupParserWithTable table programParser src
33+
34+ decls <-
35+ either (\err -> Left [P.text err]) Right (combineAnnotations sourceDecls)
36+
37+ return $ M.Module names filePath exs ims decls
28
38
29− decls <-
30− either (\err -> Left [P.text err]) Right (combineAnnotations sourceDecls)
31− return $ M.Module names filePath exs ims decls
32
39
33programParser :: IParser M.SourceModule
40programParser :: IParser M.SourceModule
34programParser =
41programParser =
35− do (M.HeaderAndImports names exports imports) <- Module.headerAndImports
42+ do (M.HeaderAndImports names exports imports) <- Module.headerAndImports
36− declarations <- decls
43+ declarations <- decls
37− optional freshLine ; optional spaces ; eof
44+ optional freshLine ; optional spaces ; eof
38− return $ M.Module names "" exports imports declarations
45+ return $ M.Module names "" exports imports declarations
46+
39
47
40setupParserWithTable :: OpTable -> IParser a -> String -> Either [P.Doc] a
48setupParserWithTable :: OpTable -> IParser a -> String -> Either [P.Doc] a
41setupParserWithTable table p source =
49setupParserWithTable table p source =
42− do localTable <- setupParser parseFixities source
50+ do localTable <- setupParser parseFixities source
43− case Map.intersection table localTable of
51+ case Map.intersection table localTable of
44− overlap | not (Map.null overlap) -> Left [ msg overlap ]
52+ overlap | not (Map.null overlap) -> Left [ msg overlap ]
45− | otherwise ->
53+ | otherwise ->
46− flip setupParser source $ do
54+ flip setupParser source $
47− putState (Map.union table localTable)
55+ do putState (Map.union table localTable)
48− p
56+ p
49− where
57+ where
50− msg overlap =
58+ msg overlap =
59+ P.vcat
51− P.vcat [ P.text "Parse error:"
60+ [ P.text "Parse error:"
61+ , P.text $
52− , P.text $ "Overlapping definitions for infix operators: " ++
62+ "Overlapping definitions for infix operators: "
53− List.intercalate " " (Map.keys overlap)
63+ ++ List.intercalate " " (Map.keys overlap)
54− ]
64+ ]
55−
65+
66+
56−parseFixities = do
67+parseFixities =
57− decls <- onFreshLines (:) [] infixDecl
68+ do decls <- onFreshLines (:) [] infixDecl
58− return $ Map.fromList [ (op,(lvl,assoc)) | D.Fixity assoc lvl op <- decls ]
69+ return $ Map.fromList [ (op,(lvl,assoc)) | D.Fixity assoc lvl op <- decls ]
59−
70+
71+
60setupParser :: IParser a -> String -> Either [P.Doc] a
72setupParser :: IParser a -> String -> Either [P.Doc] a
61setupParser p source =
73setupParser p source =
62 case iParse p source of
74 case iParse p source of
63− Right result -> Right result
75+ Right result ->
76+ Right result
77+
78+ Left err ->
64− Left err -> Left [ P.text $ "Parse error at " ++ show err ]
79+ Left [ P.text $ "Parse error at " ++ show err ]