@@ -13,8 +13,8 @@
1313--
1414-----------------------------------------------------------------------------
1515
16−module Parser (
17− parseCommand
16+module Parser
17+ ( parseCommand
1818 ) where
1919
2020import Prelude hiding (lex)
@@ -38,53 +38,88 @@ parseCommand :: String -> Either String C.Command
3838parseCommand cmdString =
3939 case cmdString of
4040 (':' : cmd) -> parseDirective cmd
41− _ -> parseRest (psciImport <|> psciLet <|> psciExpression) cmdString
41+ _ -> parseRest psciCommand cmdString
42+
43+parseRest :: P.TokenParser a -> String -> Either String a
44+parseRest p s = either (Left . show) Right $ do
45+ ts <- P.lex "" s
46+ P.runTokenParser "" (p <* eof) ts
47+
48+psciCommand :: P.TokenParser C.Command
49+psciCommand = choice (map try parsers)
4250 where
43− parseRest :: P.TokenParser a -> String -> Either String a
44− parseRest p s = either (Left . show) Right $ do
45− ts <- P.lex "" s
46− P.runTokenParser "" (p <* eof) ts
47−
48− trim :: String -> String
49− trim = trimEnd . trimStart
50−
51− trimStart :: String -> String
52− trimStart = dropWhile isSpace
53−
54− trimEnd :: String -> String
55− trimEnd = reverse . trimStart . reverse
56−
57− parseDirective :: String -> Either String C.Command
58− parseDirective cmd =
59− case D.parseDirective dstr of
60− Just D.Help -> return C.Help
61− Just D.Quit -> return C.Quit
62− Just D.Reset -> return C.Reset
63− Just D.Browse -> C.Browse <$> parseRest P.moduleName arg
64− Just D.Load -> return $ C.LoadFile (trim arg)
65− Just D.Show -> return $ C.Show (trim arg)
66− Just D.Type -> C.TypeOf <$> parseRest P.parseValue arg
67− Just D.Kind -> C.KindOf <$> parseRest P.parseType arg
68− Nothing -> Left $ "Unrecognized command. Type :? for help."
69− where (dstr, arg) = break isSpace cmd
70−
71− -- |
72− -- Parses expressions entered at the PSCI repl.
73− --
74− psciExpression :: P.TokenParser C.Command
75− psciExpression = C.Expression <$> P.parseValue
76−
77− -- |
78− -- PSCI version of @let@.
79− -- This is essentially let from do-notation.
80− -- However, since we don't support the @Eff@ monad,
81− -- we actually want the normal @let@.
82− --
83− psciLet :: P.TokenParser C.Command
84− psciLet = C.Let <$> (P.reserved "let" *> P.indented *> manyDecls)
85− where
86− manyDecls :: P.TokenParser [P.Declaration]
87− manyDecls = C.mark (many1 (C.same *> P.parseDeclaration))
88−
89− psciImport :: P.TokenParser C.Command
90− psciImport = C.Import <$> P.parseImportDeclaration'
51+ parsers =
52+ [ psciLet
53+ , psciImport
54+ , psciOtherDeclaration
55+ , psciExpression
56+ ]
57+
58+trim :: String -> String
59+trim = trimEnd . trimStart
60+
61+trimStart :: String -> String
62+trimStart = dropWhile isSpace
63+
64+trimEnd :: String -> String
65+trimEnd = reverse . trimStart . reverse
66+
67+parseDirective :: String -> Either String C.Command
68+parseDirective cmd =
69+ case D.parseDirective dstr of
70+ Just D.Help -> return C.Help
71+ Just D.Quit -> return C.Quit
72+ Just D.Reset -> return C.Reset
73+ Just D.Browse -> C.Browse <$> parseRest P.moduleName arg
74+ Just D.Load -> return $ C.LoadFile (trim arg)
75+ Just D.Show -> return $ C.Show (trim arg)
76+ Just D.Type -> C.TypeOf <$> parseRest P.parseValue arg
77+ Just D.Kind -> C.KindOf <$> parseRest P.parseType arg
78+ Nothing -> Left $ "Unrecognized command. Type :? for help."
79+ where (dstr, arg) = break isSpace cmd
80+
81+-- |
82+-- Parses expressions entered at the PSCI repl.
83+--
84+psciExpression :: P.TokenParser C.Command
85+psciExpression = C.Expression <$> P.parseValue
86+
87+-- |
88+-- PSCI version of @let@.
89+-- This is essentially let from do-notation.
90+-- However, since we don't support the @Eff@ monad,
91+-- we actually want the normal @let@.
92+--
93+psciLet :: P.TokenParser C.Command
94+psciLet = C.Decls <$> (P.reserved "let" *> P.indented *> manyDecls)
95+ where
96+ manyDecls :: P.TokenParser [P.Declaration]
97+ manyDecls = C.mark (many1 (C.same *> P.parseLocalDeclaration))
98+
99+-- | Imports must be handled separately from other declarations, so that
100+-- :show import works, for example.
101+psciImport :: P.TokenParser C.Command
102+psciImport = C.Import <$> P.parseImportDeclaration'
103+
104+-- | Any other declaration that we don't need a 'special case' parser for
105+-- (like let or import declarations).
106+psciOtherDeclaration :: P.TokenParser C.Command
107+psciOtherDeclaration = C.Decls . (:[]) <$> do
108+ decl <- discardPositionInfo <$> P.parseDeclaration
109+ if acceptable decl
110+ then return decl
111+ else fail "this kind of declaration is not supported in psci"
112+
113+discardPositionInfo :: P.Declaration -> P.Declaration
114+discardPositionInfo (P.PositionedDeclaration _ _ d) = d
115+discardPositionInfo d = d
116+
117+acceptable :: P.Declaration -> Bool
118+acceptable (P.DataDeclaration _ _ _ _) = True
119+acceptable (P.TypeSynonymDeclaration _ _ _) = True
120+acceptable (P.ExternDeclaration _ _ _ _) = True
121+acceptable (P.ExternDataDeclaration _ _) = True
122+acceptable (P.ExternInstanceDeclaration _ _ _ _) = True
123+acceptable (P.TypeClassDeclaration _ _ _ _) = True
124+acceptable (P.TypeInstanceDeclaration _ _ _ _ _) = True
125+acceptable _ = False