Skip to content

Commit 75450ea

Browse files
paf31paf31
committed
Isolate the lexer changes
1 parent 6826392 commit 75450ea

File tree

12 files changed

+706
-464
lines changed

12 files changed

+706
-464
lines changed

‎hierarchy/Main.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -55,9 +55,9 @@ runModuleName :: P.ModuleName -> String
5555
runModuleName (P.ModuleName pns) = intercalate "_" (P.runProperName `map` pns)
5656

5757
readInput :: FilePath -> IO (Either Par.ParseError [P.Module])
58-
readInput p = do
59-
text <- U.readFile p
60-
return $ P.runIndentParser p P.parseModules text
58+
readInput filename = do
59+
content <- U.readFile filename
60+
return $ fmap (map snd) $ P.parseModulesFromFiles id [(filename, content)]
6161

6262
compile :: HierarchyOptions -> IO ()
6363
compile (HierarchyOptions input mOutput) = do

‎psci/Main.hs‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -127,7 +127,9 @@ getHistoryFilename = do
127127
-- Loads a file for use with imports.
128128
--
129129
loadModule :: FilePath -> IO (Either String [P.Module])
130-
loadModule filename = either (Left . show) Right . P.runIndentParser filename P.parseModules <$> U.readFile filename
130+
loadModule filename = do
131+
content <- U.readFile filename
132+
return $ either (Left . show) (Right . map snd) $ P.parseModulesFromFiles id [(filename, content)]
131133

132134
-- |
133135
-- Load all modules, including the Prelude

‎psci/Parser.hs‎

Lines changed: 33 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,8 @@ module Parser (
1717
parseCommand
1818
) where
1919

20+
import Prelude hiding (lex)
21+
2022
import Commands
2123

2224
import Data.Char (isSpace)
@@ -28,48 +30,58 @@ import Text.Parsec hiding ((<|>))
2830
import qualified Language.PureScript as P
2931
import qualified Language.PureScript.Parser.Common as C (mark, same)
3032

33+
parseRestWith :: P.TokenParser a -> Parsec String () a
34+
parseRestWith p = do
35+
s <- many anyChar
36+
case P.lex "" s >>= P.runTokenParser "" p of
37+
Left err -> fail (show err)
38+
Right a -> return a
39+
3140
-- |
3241
-- PSCI version of @let@.
3342
-- This is essentially let from do-notation.
3443
-- However, since we don't support the @Eff@ monad,
3544
-- we actually want the normal @let@.
3645
--
37-
psciLet :: Parsec String P.ParseState Command
38-
psciLet = Let <$> (P.Let <$> (P.reserved "let" *> P.indented *> C.mark (many1 (C.same *> P.parseDeclaration))))
46+
psciLet :: Parsec String () Command
47+
psciLet = Let <$> (P.Let <$> (string "let" *> spaces *> parseRestWith manyDecls))
48+
where
49+
manyDecls :: P.TokenParser [P.Declaration]
50+
manyDecls = C.mark (many1 (C.same *> P.parseDeclaration))
3951

4052
-- |
4153
-- Parses PSCI metacommands or expressions input from the user.
4254
--
4355
parseCommand :: String -> Either ParseError Command
44-
parseCommand = P.runIndentParser "" $ choice
45-
[ P.whiteSpace *> char ':' *> (psciHelp <|> psciImport <|> psciLoadFile <|> psciQuit <|> psciReload <|> psciTypeOf <|> psciKindOf <|> psciBrowse <|> psciShowModules)
56+
parseCommand = flip parse "" $ choice
57+
[ spaces *> char ':' *> (psciHelp <|> psciImport <|> psciLoadFile <|> psciQuit <|> psciReload <|> psciTypeOf <|> psciKindOf <|> psciBrowse <|> psciShowModules)
4658
, try psciLet
4759
, psciExpression
4860
] <* eof
4961

5062
-- |
5163
-- Parses expressions entered at the PSCI repl.
5264
--
53-
psciExpression :: Parsec String P.ParseState Command
54-
psciExpression = Expression <$> P.parseValue
65+
psciExpression :: Parsec String () Command
66+
psciExpression = Expression <$> parseRestWith P.parseValue
5567

5668
-- |
5769
-- Parses 'Commands.Help' command.
5870
--
59-
psciHelp :: Parsec String P.ParseState Command
71+
psciHelp :: Parsec String () Command
6072
psciHelp = Help <$ char '?'
6173

6274
-- |
6375
-- Parses 'Commands.Import' command.
6476
--
65-
psciImport :: Parsec String P.ParseState Command
66-
psciImport = Import <$> (char 'i' *> P.whiteSpace *> P.moduleName)
77+
psciImport :: Parsec String () Command
78+
psciImport = Import <$> (char 'i' *> spaces *> parseRestWith P.moduleName)
6779

6880
-- |
6981
-- Parses 'Commands.LoadFile' command.
7082
--
71-
psciLoadFile :: Parsec String P.ParseState Command
72-
psciLoadFile = LoadFile . trimEnd <$> (char 'm' *> P.whiteSpace *> manyTill anyChar eof)
83+
psciLoadFile :: Parsec String () Command
84+
psciLoadFile = LoadFile . trimEnd <$> (char 'm' *> spaces *> manyTill anyChar eof)
7385

7486
-- | Trim end of input string
7587
trimEnd :: String -> String
@@ -78,35 +90,35 @@ trimEnd = reverse . dropWhile isSpace . reverse
7890
-- |
7991
-- Parses 'Commands.Quit' command.
8092
--
81-
psciQuit :: Parsec String P.ParseState Command
93+
psciQuit :: Parsec String () Command
8294
psciQuit = Quit <$ char 'q'
8395

8496
-- |
8597
-- Parses 'Commands.Reload' command.
8698
--
87-
psciReload :: Parsec String P.ParseState Command
99+
psciReload :: Parsec String () Command
88100
psciReload = Reset <$ char 'r'
89101

90102
-- |
91103
-- Parses 'Commands.TypeOf' command.
92104
--
93-
psciTypeOf :: Parsec String P.ParseState Command
94-
psciTypeOf = TypeOf <$> (char 't' *> P.whiteSpace *> P.parseValue)
105+
psciTypeOf :: Parsec String () Command
106+
psciTypeOf = TypeOf <$> (char 't' *> spaces *> parseRestWith P.parseValue)
95107

96108

97109
-- |
98110
-- Parses 'Commands.KindOf' command.
99111
--
100-
psciKindOf :: Parsec String P.ParseState Command
101-
psciKindOf = KindOf <$> (char 'k' *> P.whiteSpace *> P.parseType)
112+
psciKindOf :: Parsec String () Command
113+
psciKindOf = KindOf <$> (char 'k' *> spaces *> parseRestWith P.parseType)
102114

103115
-- |
104116
-- Parses 'Commands.Browse' command.
105117
--
106-
psciBrowse :: Parsec String P.ParseState Command
107-
psciBrowse = Browse <$> (char 'b' *> P.whiteSpace *> P.moduleName)
118+
psciBrowse :: Parsec String () Command
119+
psciBrowse = Browse <$> (char 'b' *> spaces *> parseRestWith P.moduleName)
108120

109121
-- |
110122
-- Show Command
111-
psciShowModules :: Parsec String P.ParseState Command
112-
psciShowModules = Show . trimEnd <$> (char 's' *> P.whiteSpace *> manyTill anyChar eof)
123+
psciShowModules :: Parsec String () Command
124+
psciShowModules = Show . trimEnd <$> (char 's' *> spaces *> manyTill anyChar eof)

‎purescript.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -65,6 +65,7 @@ library
6565
Language.PureScript.Optimizer.Unused
6666
Language.PureScript.Options
6767
Language.PureScript.Parser
68+
Language.PureScript.Parser.Lexer
6869
Language.PureScript.Parser.Common
6970
Language.PureScript.Parser.Declarations
7071
Language.PureScript.Parser.Kinds

‎src/Language/PureScript.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -219,7 +219,7 @@ make outputDir opts ms prefix = do
219219
rebuildIfNecessary graph toRebuild (Module moduleName' _ _ : ms') = do
220220
let externsFile = outputDir </> runModuleName moduleName' </> "externs.purs"
221221
externs <- readTextFile externsFile
222-
externsModules <- liftError . either (Left . show) Right $ P.runIndentParser externsFile P.parseModules externs
222+
externsModules <- liftError . fmap (map snd) . either (Left . show) Right $ P.parseModulesFromFiles id [(externsFile, externs)]
223223
case externsModules of
224224
[m'@(Module moduleName'' _ _)] | moduleName'' == moduleName' -> (:) (False, m') <$> rebuildIfNecessary graph toRebuild ms'
225225
_ -> liftError . Left $ "Externs file " ++ externsFile ++ " was invalid"

‎src/Language/PureScript/Parser.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -31,4 +31,5 @@ import Language.PureScript.Parser.Common as P
3131
import Language.PureScript.Parser.Types as P
3232
import Language.PureScript.Parser.State as P
3333
import Language.PureScript.Parser.Kinds as P
34+
import Language.PureScript.Parser.Lexer as P
3435
import Language.PureScript.Parser.Declarations as P

0 commit comments

Comments
 (0)