820a885 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Simplify parsing of commands in psci. Correct some indentation issues.

820a885Phil Freeman12 years ago

psci/Main.hs+2−2

compare with golang

unifiedsplit

@@ -443,7 +443,7 @@ handleKindOf typ = do

443-- |

444-- Parses the input and returns either a Metacommand or an expression.

445--

446−getCommand :: Bool -> InputT (StateT PSCiState IO) (Either Par.ParseError (Maybe Command))

446+getCommand :: Bool -> InputT (StateT PSCiState IO) (Either String (Maybe Command))

447getCommand singleLineMode = do

448 firstLine <- getInputLine "> "

449 case firstLine of

@@ -521,7 +521,7 @@ loop (PSCiOptions singleLineMode files) = do

521 go = do

522 c <- getCommand singleLineMode

523 case c of

524− Left err -> outputStrLn (show err) >> go

524+ Left err -> outputStrLn err >> go

525 Right Nothing -> go

526 Right (Just Quit) -> outputStrLn quitMessage

527 Right (Just c') -> runPSCI (handleCommand c') >> go

psci/Parser.hs+47−89

@@ -30,95 +30,53 @@ import Text.Parsec hiding ((<|>))

30import qualified Language.PureScript as P

31import qualified Language.PureScript.Parser.Common as C (mark, same)

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−

40−-- |

41−-- PSCI version of @let@.

42−-- This is essentially let from do-notation.

43−-- However, since we don't support the @Eff@ monad,

44−-- we actually want the normal @let@.

45−--

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))

51−

52-- |

33-- |

53-- Parses PSCI metacommands or expressions input from the user.

34-- Parses PSCI metacommands or expressions input from the user.

54--

35--

55−parseCommand :: String -> Either ParseError Command

36+parseCommand :: String -> Either String Command

56−parseCommand = flip parse "" $ choice

37+parseCommand cmdString =

38+ case splitCommand cmdString of

58− , try psciLet

39+ Just ('?', _) -> return Help

40+ Just ('q', _) -> return Quit

41+ Just ('r', _) -> return Reset

42+ Just ('i', moduleName) -> Import <$> parseRest P.moduleName moduleName

43+ Just ('b', moduleName) -> Browse <$> parseRest P.moduleName moduleName

44+ Just ('m', filename) -> return $ LoadFile (trimEnd filename)

45+ Just ('s', command) -> return $ Show (trimEnd command)

46+ Just ('t', expr) -> TypeOf <$> parseRest P.parseValue expr

47+ Just ('k', ty) -> KindOf <$> parseRest P.parseType ty

48+ Just _ -> Left $ "Unrecognized command. Type :? for help."

59− , psciExpression

49+ Nothing -> parseRest (psciLet <|> psciExpression) cmdString

60− ] <* eof

50+ where

61−

51+ parseRest :: P.TokenParser a -> String -> Either String a

52+ parseRest p s = either (Left . show) Right $ do

53+ ts <- P.lex "" s

54+ P.runTokenParser "" (p <* eof) ts

55+

56+ trimEnd :: String -> String

57+ trimEnd = reverse . dropWhile isSpace . reverse

58+

59+ -- |

60+ -- Split a command into a command char and the trailing string

61+ --

62+ splitCommand :: String -> Maybe (Char, String)

63+ splitCommand (':' : c : s) = Just (c, dropWhile isSpace s)

64+ splitCommand _ = Nothing

65+

62−-- |

66+ -- |

63−-- Parses expressions entered at the PSCI repl.

67+ -- Parses expressions entered at the PSCI repl.

64−--

68+ --

65−psciExpression :: Parsec String () Command

69+ psciExpression :: P.TokenParser Command

66−psciExpression = Expression <$> parseRestWith P.parseValue

70+ psciExpression = Expression <$> P.parseValue

67−

71+

68−-- |

69−-- Parses 'Commands.Help' command.

70−--

71−psciHelp :: Parsec String () Command

72−psciHelp = Help <$ char '?'

73−

74−-- |

75−-- Parses 'Commands.Import' command.

76−--

77−psciImport :: Parsec String () Command

78−psciImport = Import <$> (char 'i' *> spaces *> parseRestWith P.moduleName)

79−

80−-- |

81−-- Parses 'Commands.LoadFile' command.

82−--

83−psciLoadFile :: Parsec String () Command

84−psciLoadFile = LoadFile . trimEnd <$> (char 'm' *> spaces *> manyTill anyChar eof)

85−

86−-- | Trim end of input string

87−trimEnd :: String -> String

88−trimEnd = reverse . dropWhile isSpace . reverse

89−

90−-- |

91−-- Parses 'Commands.Quit' command.

92−--

93−psciQuit :: Parsec String () Command

94−psciQuit = Quit <$ char 'q'

95−

96−-- |

97−-- Parses 'Commands.Reload' command.

98−--

99−psciReload :: Parsec String () Command

100−psciReload = Reset <$ char 'r'

101−

102−-- |

72+ -- |

103−-- Parses 'Commands.TypeOf' command.

73+ -- PSCI version of @let@.

104−--

74+ -- This is essentially let from do-notation.

105−psciTypeOf :: Parsec String () Command

75+ -- However, since we don't support the @Eff@ monad,

106−psciTypeOf = TypeOf <$> (char 't' *> spaces *> parseRestWith P.parseValue)

76+ -- we actually want the normal @let@.

107−

108−

109−-- |

110−-- Parses 'Commands.KindOf' command.

111−--

77+ --

112−psciKindOf :: Parsec String () Command

78+ psciLet :: P.TokenParser Command

113−psciKindOf = KindOf <$> (char 'k' *> spaces *> parseRestWith P.parseType)

79+ psciLet = Let <$> (P.Let <$> (P.reserved "let" *> P.indented *> manyDecls))

114−

80+ where

115−-- |

81+ manyDecls :: P.TokenParser [P.Declaration]

116−-- Parses 'Commands.Browse' command.

82+ manyDecls = C.mark (many1 (C.same *> P.parseDeclaration))

117−--

118−psciBrowse :: Parsec String () Command

119−psciBrowse = Browse <$> (char 'b' *> spaces *> parseRestWith P.moduleName)

120−

121−-- |

122−-- Show Command

123−psciShowModules :: Parsec String () Command

124−psciShowModules = Show . trimEnd <$> (char 's' *> spaces *> manyTill anyChar eof)

purescript.cabal+6−6

@@ -104,7 +104,7 @@ library

104 buildable: True

105 hs-source-dirs: src

106 other-modules: Paths_purescript

107− ghc-options: -Wall -O2

107+ ghc-options: -Wall -fno-warn-warnings-deprecations -O2

108

109executable psc

110 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

@@ -114,7 +114,7 @@ executable psc

114 buildable: True

115 hs-source-dirs: psc

116 other-modules:

117− ghc-options: -Wall -O2 -fno-warn-unused-do-bind

117+ ghc-options: -Wall -fno-warn-warnings-deprecations -O2 -fno-warn-unused-do-bind

118

119executable psc-make

120 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

@@ -124,7 +124,7 @@ executable psc-make

124 buildable: True

125 hs-source-dirs: psc-make

126 other-modules:

127− ghc-options: -Wall -O2 -fno-warn-unused-do-bind

127+ ghc-options: -Wall -fno-warn-warnings-deprecations -O2 -fno-warn-unused-do-bind

128

129executable psci

130 build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

@@ -137,7 +137,7 @@ executable psci

137 hs-source-dirs: psci

138 other-modules: Commands

139 Parser

140− ghc-options: -Wall -O2

140+ ghc-options: -Wall -fno-warn-warnings-deprecations -O2

141

142executable psc-docs

143 build-depends: base >=4 && <5, purescript -any, utf8-string -any,

@@ -146,7 +146,7 @@ executable psc-docs

146 buildable: True

147 hs-source-dirs: psc-docs

148 other-modules:

149− ghc-options: -Wall -O2

149+ ghc-options: -Wall -fno-warn-warnings-deprecations -O2

150

151executable hierarchy

152 build-depends: base >=4 && <5, purescript -any, utf8-string -any, optparse-applicative >= 0.10.0,

@@ -155,7 +155,7 @@ executable hierarchy

155 buildable: True

156 hs-source-dirs: hierarchy

157 other-modules:

158− ghc-options: -Wall -O2

158+ ghc-options: -Wall -fno-warn-warnings-deprecations -O2

159

160test-suite tests

161 build-depends: base >=4 && <5, containers -any, directory -any,