Skip to content

Commit b8d96cc

Browse files
hdgarroodhdgarrood
committed
Allow more declarations
The following declarations now "just work": data, type synonym, extern, extern data, extern instance, type class, type instance. Additionally, the behaviour allowing you to have any kind of declaration following 'let', eg 'let import M', is now disabled. Only type declarations and value declarations are now allowed following a 'let', like in the real parser.
1 parent 2bfb486 commit b8d96cc

File tree

4 files changed

+94
-58
lines changed

4 files changed

+94
-58
lines changed

‎psci/Commands.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -50,9 +50,9 @@ data Command
5050
--
5151
| Reset
5252
-- |
53-
-- Binds a value to a name
53+
-- Add some declarations to the current evaluation context.
5454
--
55-
| Let [Declaration]
55+
| Decls [Declaration]
5656
-- |
5757
-- Find the type of an expression
5858
--

‎psci/Main.hs‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -437,11 +437,11 @@ handleDeclaration val = do
437437
Nothing -> PSCI $ outputStrLn "Couldn't find node.js"
438438

439439
-- |
440-
-- Takes a let declaration and updates the environment, then run a make. If the declaration fails,
441-
-- restore the pre-let environment.
440+
-- Takes a list of declarations and updates the environment, then run a make. If the declaration fails,
441+
-- restore the original environment.
442442
--
443-
handleLet :: [P.Declaration] -> PSCI ()
444-
handleLet ds = do
443+
handleDecls :: [P.Declaration] -> PSCI ()
444+
handleDecls ds = do
445445
st <- PSCI $ lift get
446446
let st' = updateLets ds st
447447
let m = createTemporaryModule False st' (P.ObjectLiteral [])
@@ -599,7 +599,7 @@ handleCommand :: C.Command -> PSCI ()
599599
handleCommand (C.Expression val) = handleDeclaration val
600600
handleCommand C.Help = PSCI $ outputStrLn helpMessage
601601
handleCommand (C.Import im) = handleImport im
602-
handleCommand (C.Let l) = handleLet l
602+
handleCommand (C.Decls l) = handleDecls l
603603
handleCommand (C.LoadFile filePath) = do
604604
absPath <- psciIO $ expandTilde filePath
605605
exists <- psciIO $ doesFileExist absPath

‎psci/Parser.hs‎

Lines changed: 86 additions & 51 deletions
Original file line numberDiff line numberDiff line change
@@ -13,8 +13,8 @@
1313
--
1414
-----------------------------------------------------------------------------
1515

16-
module Parser (
17-
parseCommand
16+
module Parser
17+
( parseCommand
1818
) where
1919

2020
import Prelude hiding (lex)
@@ -38,53 +38,88 @@ parseCommand :: String -> Either String C.Command
3838
parseCommand 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

‎src/Language/PureScript/Parser/Declarations.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,7 @@ module Language.PureScript.Parser.Declarations (
2525
parseBinder,
2626
parseBinderNoParens,
2727
parseImportDeclaration',
28+
parseLocalDeclaration
2829
) where
2930

3031
import Prelude hiding (lex)

0 commit comments

Comments
 (0)