4aae11a · rowtype-yoga/purescript-native

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

on golang help sign in

Merge pull request #955 from mrhania/psci-commands-overhaul

4aae11aGary Burgess12 years ago

psci/Commands.hs−20

compare with golang

unifiedsplit

@@ -65,23 +65,3 @@ data Command

65 -- Show command

66 --

67 | Show String

68−

69−-- |

70−-- The help menu.

71−--

72−help :: [(String, String, String)]

73−help =

74− [ (":?", "", "Show this help menu")

75− , (":i", "<module>", "Import <module> for use in PSCI")

76− , (":b", "<module>", "Browse <module>")

77− , (":m", "<file>", "Load <file> for importing")

78− , (":q", "", "Quit PSCi")

79− , (":r", "", "Reset")

80− , (":s", "import", "Show imported modules")

81− , (":s", "loaded", "Show loaded modules")

82− , (":t", "<expr>", "Show the type of <expr>")

83− , (":k", "<type>", "Show the kind of <type>")

84− ]

85−

86−commands :: [String]

87−commands = map (\ (a, _, _) -> a) help

psci/Directive.hsnew file+82

@@ -0,0 +1,82 @@

1+-----------------------------------------------------------------------------

2+--

3+-- Module : Directive

4+-- Copyright :

5+-- License : MIT

6+--

7+-- Maintainer :

8+-- Stability : experimental

9+-- Portability :

10+--

11+-- |

12+-- Directives for PSCI.

13+--

14+-----------------------------------------------------------------------------

15+

16+module Directive where

17+

18+import Data.List (nub, isPrefixOf)

19+

20+data Directive

21+ = Help

22+ | Quit

23+ | Reset

24+ | Import

25+ | Browse

26+ | Load

27+ | Type

28+ | Kind

29+ | Show

30+ deriving Eq

31+

32+-- |

33+-- Maps given directive to relating command strings.

34+--

35+commands :: Directive -> [String]

36+commands Help = ["?", "help"]

37+commands Quit = ["quit"]

38+commands Reset = ["reset"]

39+commands Import = ["import"]

40+commands Browse = ["browse"]

41+commands Load = ["load", "module"]

42+commands Type = ["type"]

43+commands Kind = ["kind"]

44+commands Show = ["show"]

45+

46+-- |

47+-- Tries to parse given string into a directive.

48+--

49+parseDirective :: String -> Maybe Directive

50+parseDirective cmd =

51+ case filter (matches . snd) mapping of

52+ [directive] -> Just $ fst directive

53+ _ -> Nothing

54+ where

55+ mapping :: [(Directive, [String])]

56+ mapping = zip directives (map commands directives)

57+

58+ matches :: [String] -> Bool

59+ matches = any (cmd `isPrefixOf`)

60+

61+-- |

62+-- The help menu.

63+--

64+help :: [(Directive, String, String)]

65+help =

66+ [ (Help, "", "Show this help menu")

67+ , (Quit, "", "Quit PSCi")

68+ , (Reset, "", "Reset")

69+ , (Import, "<module>", "Import <module> for use in PSCI")

70+ , (Browse, "<module>", "Browse <module>")

71+ , (Load, "<file>", "Load <file> for importing")

72+ , (Type, "<expr>", "Show the type of <expr>")

73+ , (Kind, "<type>", "Show the kind of <type>")

74+ , (Show, "import", "Show imported modules")

75+ , (Show, "loaded", "Show loaded modules")

76+ ]

77+

78+-- |

79+-- List of all avaliable directives.

80+--

81+directives :: [Directive]

82+directives = nub . map (\(dir, _, _) -> dir) $ help

psci/Main.hs+50−33

@@ -54,7 +54,8 @@ import qualified Language.PureScript.AST as D

54import qualified Language.PureScript.Names as N

55import qualified Paths_purescript as Paths

57−import Commands as C

57+import qualified Commands as C

58+import qualified Directive as D

58import Parser

59import Parser

60data PSCiOptions = PSCiOptions

61data PSCiOptions = PSCiOptions

@@ -170,9 +171,17 @@ expandTilde p = return p

170--

171--

171helpMessage :: String

172helpMessage :: String

172helpMessage = "The following commands are available:\n\n " ++

173helpMessage = "The following commands are available:\n\n " ++

173− intercalate "\n " (map line C.help)

174+ intercalate "\n " (map line D.help)

175+ where

174− where line :: (String, String, String) -> String

176+ line :: (D.Directive, String, String) -> String

175− line (cmd, arg, desc) = intercalate " " [cmd, arg, replicate (11 - length arg) ' ', desc]

177+ line (dir, arg, desc) = intercalate " "

178+ [ cmd

179+ , replicate (11 - length cmd) ' '

180+ , arg

181+ , replicate (11 - length arg) ' '

182+ , desc

183+ ]

184+ where cmd = ":" ++ head (D.commands dir)

176

185

177-- |

186-- |

178-- The welcome prologue.

187-- The welcome prologue.

@@ -205,19 +214,24 @@ data CompletionContext = Command String | FilePath String | Module | Identifier

205-- Decide what kind of completion we need based on input.

214-- Decide what kind of completion we need based on input.

206completionContext :: String -> String -> Maybe CompletionContext

215completionContext :: String -> String -> Maybe CompletionContext

207completionContext cmd@"" _ = Just $ Multiple [Command cmd, Identifier]

216completionContext cmd@"" _ = Just $ Multiple [Command cmd, Identifier]

208−completionContext cmd@(':' : _ ) _

217+completionContext (':' : cmd) word =

218+ case D.parseDirective dstr of

219+ Just directive | dstr `elem` D.commands directive -> context directive

209− | cmd `elem` C.commands || cmd == ":" = Just $ Command cmd

220+ _ -> Just $ Command cmd

210−completionContext (':' : c : _) word = case c of

221+ where

222+ dstr :: String

223+ dstr = takeWhile (not . isSpace) cmd

224+

225+ context :: D.Directive -> Maybe CompletionContext

211− 'i' -> Just Module

226+ context D.Import = Just Module

212− 'b' -> Just Module

227+ context D.Browse = Just Module

213− 'm' -> Just $ FilePath word

228+ context D.Load = Just $ FilePath word

214− 'q' -> Nothing

229+ context D.Quit = Nothing

215− 'r' -> Nothing

230+ context D.Reset = Nothing

216− '?' -> Nothing

231+ context D.Help = Nothing

217− 's' -> Just $ Fixed ["import", "loaded"]

232+ context D.Show = Just $ Fixed ["import", "loaded"]

218− 't' -> Just Identifier

233+ context D.Type = Just Identifier

219− 'k' -> Just Type

234+ context D.Kind = Just Type

220− _ -> Nothing

221completionContext _ _ = Just Identifier

235completionContext _ _ = Just Identifier

222

236

223-- |

237-- |

@@ -238,13 +252,16 @@ completion = completeWordWithPrev Nothing " \t\n\r" findCompletions

238 return $ sortBy sorter completions

252 return $ sortBy sorter completions

239

253

240 getCompletion :: CompletionContext -> StateT PSCiState IO [Either String Completion]

254 getCompletion :: CompletionContext -> StateT PSCiState IO [Either String Completion]

241− getCompletion (Command s) = return $ (map Left) $ nub $ filter (isPrefixOf s) C.commands

242 getCompletion (FilePath f) = (map Right) <$> listFiles f

255 getCompletion (FilePath f) = (map Right) <$> listFiles f

243 getCompletion Module = (map Left) <$> getModuleNames

256 getCompletion Module = (map Left) <$> getModuleNames

244 getCompletion Identifier = (map Left) <$> ((++) <$> getIdentNames <*> getDctorNames)

257 getCompletion Identifier = (map Left) <$> ((++) <$> getIdentNames <*> getDctorNames)

245 getCompletion Type = (map Left) <$> getTypeNames

258 getCompletion Type = (map Left) <$> getTypeNames

246 getCompletion (Fixed list) = return $ (map Left) list

259 getCompletion (Fixed list) = return $ (map Left) list

247 getCompletion (Multiple contexts) = concat <$> mapM getCompletion contexts

260 getCompletion (Multiple contexts) = concat <$> mapM getCompletion contexts

261+ getCompletion (Command cmd) = return . map (Left . (":" ++)) . nub $ matching

262+ where

263+ matching :: [String]

264+ matching = filter (isPrefixOf cmd) . concatMap (D.commands) $ D.directives

248

265

249 getLoadedModules :: StateT PSCiState IO [P.Module]

266 getLoadedModules :: StateT PSCiState IO [P.Module]

250 getLoadedModules = map snd . psciLoadedModules <$> get

267 getLoadedModules = map snd . psciLoadedModules <$> get

@@ -540,7 +557,7 @@ handleKindOf typ = do

540-- |

557-- |

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

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

542--

559--

543−getCommand :: Bool -> InputT (StateT PSCiState IO) (Either String (Maybe Command))

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

544getCommand singleLineMode = do

561getCommand singleLineMode = do

545 firstLine <- getInputLine "> "

562 firstLine <- getInputLine "> "

546 case firstLine of

563 case firstLine of

@@ -555,12 +572,12 @@ getCommand singleLineMode = do

555-- |

572-- |

556-- Performs an action for each meta-command given, and also for expressions..

573-- Performs an action for each meta-command given, and also for expressions..

557--

574--

558−handleCommand :: Command -> PSCI ()

575+handleCommand :: C.Command -> PSCI ()

559−handleCommand (Expression val) = handleDeclaration val

576+handleCommand (C.Expression val) = handleDeclaration val

560−handleCommand Help = PSCI $ outputStrLn helpMessage

577+handleCommand C.Help = PSCI $ outputStrLn helpMessage

561−handleCommand (Import moduleName) = handleImport moduleName

578+handleCommand (C.Import moduleName) = handleImport moduleName

562−handleCommand (Let l) = handleLet l

579+handleCommand (C.Let l) = handleLet l

563−handleCommand (LoadFile filePath) = do

580+handleCommand (C.LoadFile filePath) = do

564 absPath <- psciIO $ expandTilde filePath

581 absPath <- psciIO $ expandTilde filePath

565 exists <- psciIO $ doesFileExist absPath

582 exists <- psciIO $ doesFileExist absPath

566 if exists then do

583 if exists then do

@@ -571,7 +588,7 @@ handleCommand (LoadFile filePath) = do

571 Right mods -> PSCI . lift $ modify (updateModules (map ((,) (Right absPath)) mods))

588 Right mods -> PSCI . lift $ modify (updateModules (map ((,) (Right absPath)) mods))

572 else

589 else

573 PSCI . outputStrLn $ "Couldn't locate: " ++ filePath

590 PSCI . outputStrLn $ "Couldn't locate: " ++ filePath

574−handleCommand Reset = do

591+handleCommand C.Reset = do

575 files <- psciImportedFilenames <$> PSCI (lift get)

592 files <- psciImportedFilenames <$> PSCI (lift get)

576 PSCI . lift . modify $ \st -> st

593 PSCI . lift . modify $ \st -> st

577 { psciImportedFilenames = files

594 { psciImportedFilenames = files

@@ -579,14 +596,14 @@ handleCommand Reset = do

579 , psciLetBindings = []

596 , psciLetBindings = []

580 }

597 }

581 loadAllImportedModules

598 loadAllImportedModules

582−handleCommand (TypeOf val) = handleTypeOf val

599+handleCommand (C.TypeOf val) = handleTypeOf val

583−handleCommand (KindOf typ) = handleKindOf typ

600+handleCommand (C.KindOf typ) = handleKindOf typ

584−handleCommand (Browse moduleName) = handleBrowse moduleName

601+handleCommand (C.Browse moduleName) = handleBrowse moduleName

585−handleCommand (Show "loaded") = handleShowLoadedModules

602+handleCommand (C.Show "loaded") = handleShowLoadedModules

586−handleCommand (Show "import") = handleShowImportedModules

603+handleCommand (C.Show "import") = handleShowImportedModules

587handleCommand _ = PSCI $ outputStrLn "Unknown command"

604handleCommand _ = PSCI $ outputStrLn "Unknown command"

588

605

589−loadUserConfig :: IO (Maybe [Command])

606+loadUserConfig :: IO (Maybe [C.Command])

590loadUserConfig = do

607loadUserConfig = do

591 configFile <- (</> ".psci") <$> getCurrentDirectory

608 configFile <- (</> ".psci") <$> getCurrentDirectory

592 exists <- doesFileExist configFile

609 exists <- doesFileExist configFile

@@ -622,7 +639,7 @@ loop PSCiOptions{..} = do

622 case c of

639 case c of

623 Left err -> outputStrLn err >> go

640 Left err -> outputStrLn err >> go

624 Right Nothing -> go

641 Right Nothing -> go

625− Right (Just Quit) -> outputStrLn quitMessage

642+ Right (Just C.Quit) -> outputStrLn quitMessage

626 Right (Just c') -> runPSCI (loadAllImportedModules >> handleCommand c') >> go

643 Right (Just c') -> runPSCI (loadAllImportedModules >> handleCommand c') >> go

627

644

628multiLineMode :: Parser Bool

645multiLineMode :: Parser Bool

psci/Parser.hs+31−25

@@ -19,7 +19,8 @@ module Parser (

20import Prelude hiding (lex)

22−import Commands

22+import qualified Commands as C

23+import qualified Directive as D

24import Data.Char (isSpace)

25import Data.Char (isSpace)

@@ -33,41 +34,46 @@ import qualified Language.PureScript.Parser.Common as C (mark, same)

33-- |

34-- |

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

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

35--

36--

36−parseCommand :: String -> Either String Command

37+parseCommand :: String -> Either String C.Command

37parseCommand cmdString =

38parseCommand cmdString =

38− case splitCommand cmdString of

39+ case cmdString of

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

40+ (':' : cmd) -> parseDirective cmd

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."

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

41+ _ -> parseRest (psciLet <|> psciExpression) cmdString

50 where

42 where

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

43 parseRest :: P.TokenParser a -> String -> Either String a

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

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

53 ts <- P.lex "" s

45 ts <- P.lex "" s

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

46 P.runTokenParser "" (p <* eof) ts

48+ trim :: String -> String

49+ trim = trimEnd . trimStart

50+

51+ trimStart :: String -> String

52+ trimStart = dropWhile isSpace

53+

56 trimEnd :: String -> String

54 trimEnd :: String -> String

57− trimEnd = reverse . dropWhile isSpace . reverse

55+ trimEnd = reverse . trimStart . reverse

59− -- |

57+ parseDirective :: String -> Either String C.Command

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

58+ parseDirective cmd =

61− --

59+ case D.parseDirective dstr of

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

60+ Just D.Help -> return C.Help

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

61+ Just D.Quit -> return C.Quit

64− splitCommand _ = Nothing

62+ Just D.Reset -> return C.Reset

63+ Just D.Import -> C.Import <$> parseRest P.moduleName arg

64+ Just D.Browse -> C.Browse <$> parseRest P.moduleName arg

65+ Just D.Load -> return $ C.LoadFile (trim arg)

66+ Just D.Show -> return $ C.Show (trim arg)

67+ Just D.Type -> C.TypeOf <$> parseRest P.parseValue arg

68+ Just D.Kind -> C.KindOf <$> parseRest P.parseType arg

69+ Nothing -> Left $ "Unrecognized command. Type :? for help."

70+ where (dstr, arg) = break isSpace cmd

66 -- |

72 -- |

67 -- Parses expressions entered at the PSCI repl.

73 -- Parses expressions entered at the PSCI repl.

68 --

74 --

69− psciExpression :: P.TokenParser Command

75+ psciExpression :: P.TokenParser C.Command

70− psciExpression = Expression <$> P.parseValue

76+ psciExpression = C.Expression <$> P.parseValue

72 -- |

78 -- |

73 -- PSCI version of @let@.

79 -- PSCI version of @let@.

@@ -75,8 +81,8 @@ parseCommand cmdString =

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

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

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

82 -- we actually want the normal @let@.

77 --

83 --

78− psciLet :: P.TokenParser Command

84+ psciLet :: P.TokenParser C.Command

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

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

80 where

86 where

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

87 manyDecls :: P.TokenParser [P.Declaration]

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

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