diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,6 +1,12 @@ HEAD ==== +0.4.0.0 +======= + +- Add multi-line input support +- Add finaliser option to control REPL exit on + 0.3.0.0 ======= diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2016-2019 Stephen Diehl +Copyright (c) 2016-2020 Stephen Diehl Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -18,6 +18,72 @@ * [Simple](examples/Simple.hs) * [Prefix](examples/Prefix.hs) * [Stateful](examples/Stateful.hs) +* [Multiline](examples/MultiLine.hs) + +Migration from 0.3.x +-------------------- + +This release adds two parameters to the `ReplOpts` constructor and `evalRepl` function. + +* `finaliser` +* `multilineCommand` + +The `finaliser` function is a function run when the Repl monad is is exited. + +```haskell +-- | Decide whether to exit the REPL or not +data ExitDecision + = Continue -- | Keep the REPL open + | Exit -- | Close the REPL and exit +``` + +For example: + +```haskell +final :: Repl ExitDecision +final = do + liftIO $ putStrLn "Goodbye!" + return Exit +``` + +The `multilineCommand` argument takes a command which invokes a multiline edit +mode in which the user can paste/enter text across multiple lines terminating +with a Ctrl-D / EOF. This can be used in conjunction with a customBanner +function to indicate the entry mode. + +```haskell +customBanner :: MultiLine -> Repl String +customBanner SingleLine = pure ">>> " +customBanner MultiLine = pure "| " +``` + +See [Multiline](examples/MultiLine.hs) for a complete example. + +Migration from 0.2.x +-------------------- + +The underlying `haskeline` library that provides readline support had a breaking +API change in 0.8.0.0 which removed the bespoke +`System.Console.Haskeline.MonadException` module in favour of using the +`exceptions` package. This is a *much* better design and I strongly encourage +upgrading. To migrate simply add the following bounds to your Cabal file. + +```yaml +build-depends: + repline >= 0.3.0.0 + haskeline >= 0.8.0.0 +``` + +You may also need to add the following to your `stack.yaml` file if using Stack. + +```yaml +resolver: lts-15.0 +packages: + - . +extra-deps: + - haskeline-0.8.0.0 + - repline-0.3.0.0 +``` Usage ----- diff --git a/examples/Multiline.hs b/examples/Multiline.hs new file mode 100644 --- /dev/null +++ b/examples/Multiline.hs @@ -0,0 +1,84 @@ +module Main (main, repl) where + +import Control.Monad.Trans +import Data.List (isPrefixOf) +import System.Console.Repline +import System.Process (callCommand) + +type Repl a = HaskelineT IO a + +-- Evaluation : handle each line user inputs +cmd :: String -> Repl () +cmd input = liftIO $ print input + +-- Commands +help :: [String] -> Repl () +help args = liftIO $ print $ "Help: " ++ show args + +say :: String -> Repl () +say args = do + _ <- liftIO $ callCommand $ "cowsay" ++ " " ++ args + return () + +load :: FilePath -> Repl () +load args = do + contents <- liftIO $ readFile args + liftIO $ putStrLn contents + +-- Options +opts :: [(String, String -> Repl ())] +opts = + [ ("help", help . words), -- :help + ("load", load), -- :load + ("say", say) -- :say + ] + +-- Tab Completion: return a completion for partial words entered +completer :: Monad m => WordCompleter m +completer n = do + let names = ["kirk", "spock", "mccoy"] + return $ filter (isPrefixOf n) names + +-- Completer +defaultMatcher :: (MonadIO m) => [([Char], CompletionFunc m)] +defaultMatcher = + [ -- Commands + (":load", fileCompleter), + (":help", wordCompleter completer) + ] + +byWord :: Monad m => WordCompleter m +byWord n = do + let names = fmap ((":" <>) . fst) opts + return $ filter (isPrefixOf n) names + +-- Initialiser function +ini :: Repl () +ini = liftIO $ putStrLn "Welcome!" + +-- Finaliser function +final :: Repl ExitDecision +final = do + liftIO $ putStrLn "Goodbye!" + return Exit + +customBanner :: MultiLine -> Repl String +customBanner SingleLine = pure ">>> " +customBanner MultiLine = pure "| " + +repl :: IO () +repl = + evalReplOpts $ + ReplOpts + { banner = customBanner, + command = cmd, + options = opts, + prefix = Just ':', + multilineCommand = Just "paste", + tabComplete = (Prefix (wordCompleter byWord) defaultMatcher), + initialiser = ini, + finaliser = final + } + +main :: IO () +main = pure () diff --git a/examples/Prefix.hs b/examples/Prefix.hs --- a/examples/Prefix.hs +++ b/examples/Prefix.hs @@ -32,17 +32,17 @@ let names = ["picard", "riker", "data", ":file", ":holiday"] return $ filter (isPrefixOf n) names -files :: [String] -> Repl () +files :: String -> Repl () files args = liftIO $ do - contents <- readFile (unwords args) + contents <- readFile args putStrLn contents -holidays :: [String] -> Repl () -holidays [] = liftIO $ putStrLn "Enter a holiday." +holidays :: String -> Repl () +holidays "" = liftIO $ putStrLn "Enter a holiday." holidays xs = liftIO $ do - putStrLn $ "Happy " ++ unwords xs ++ "!" + putStrLn $ "Happy " ++ xs ++ "!" -opts :: [(String, [String] -> Repl ())] +opts :: [(String, String -> Repl ())] opts = [ ("file", files), ("holiday", holidays) @@ -51,8 +51,11 @@ inits :: Repl () inits = return () +final :: Repl ExitDecision +final = return Exit + repl :: IO () -repl = evalRepl (pure ">>> ") cmd opts Nothing (Prefix (wordCompleter byWord) defaultMatcher) inits +repl = evalRepl (const $ pure ">>> ") cmd opts Nothing Nothing (Prefix (wordCompleter byWord) defaultMatcher) inits final main :: IO () main = pure () diff --git a/examples/Simple.hs b/examples/Simple.hs --- a/examples/Simple.hs +++ b/examples/Simple.hs @@ -21,22 +21,43 @@ help :: [String] -> Repl () help args = liftIO $ print $ "Help: " ++ show args -say :: [String] -> Repl () +say :: String -> Repl () say args = do - _ <- liftIO $ callCommand $ "cowsay" ++ " " ++ (unwords args) + _ <- liftIO $ callCommand $ "cowsay" ++ " " ++ args return () -opts :: [(String, [String] -> Repl ())] +opts :: [(String, String -> Repl ())] opts = - [ ("help", help), -- :help + [ ("help", help . words), -- :help ("say", say) -- :say ] ini :: Repl () ini = liftIO $ putStrLn "Welcome!" +final :: Repl ExitDecision +final = do + liftIO $ putStrLn "Goodbye!" + return Exit + +repl_alt :: IO () +repl_alt = evalReplOpts $ ReplOpts + { banner = const $ pure ">>> " + , command = cmd + , options = opts + , prefix = Just ':' + , multilineCommand = Just "paste" + , tabComplete = (Word0 completer) + , initialiser = ini + , finaliser = final + } + +customBanner :: MultiLine -> Repl String +customBanner SingleLine = pure ">>> " +customBanner MultiLine = pure "| " + repl :: IO () -repl = evalRepl (pure ">>> ") cmd opts (Just ':') (Word0 completer) ini +repl = evalRepl (const $ pure ">>> ") cmd opts (Just ':') (Just "paste") (Word0 completer) ini final main :: IO () main = pure () diff --git a/examples/Stateful.hs b/examples/Stateful.hs --- a/examples/Stateful.hs +++ b/examples/Stateful.hs @@ -6,6 +6,7 @@ import Control.Monad.State.Strict import Data.List (isPrefixOf) +import Data.Monoid import qualified Data.Set as Set import System.Console.Repline @@ -13,18 +14,18 @@ -- Stateful Completion ------------------------------------------------------------------------------- -type IState = Set.Set String +type IState = (Int, Set.Set String) type Repl a = HaskelineT (StateT IState IO) a -- Evaluation cmd :: String -> Repl () -cmd input = modify $ \s -> Set.insert input s +cmd input = modify . fmap $ \s -> Set.insert input s -- Completion comp :: (Monad m, MonadState IState m) => WordCompleter m comp n = do - ns <- get + (c, ns) <- get return $ filter (isPrefixOf n) (Set.toList ns) -- Commands @@ -32,22 +33,32 @@ help args = liftIO $ print $ "Help!" ++ show args puts :: [String] -> Repl () -puts args = modify $ \s -> Set.union s (Set.fromList args) +puts args = modify . fmap $ \s -> Set.union s (Set.fromList args) -opts :: [(String, [String] -> Repl ())] +opts :: [(String, String -> Repl ())] opts = - [ ("help", help), -- :help - ("puts", puts) -- :puts + [ ("help", help . words), -- :help + ("puts", puts . words) -- :puts ] ini :: Repl () ini = return () +final :: Repl ExitDecision +final = do + (count, s) <- get + if count == 0 + then return Exit + else do + liftIO . putStrLn $ "Exit in " <> show count <> "..." + put (count - 1, s) + return Continue + -- Tab completion inside of StateT repl :: IO () repl = - flip evalStateT Set.empty $ - evalRepl (pure ">>> ") cmd opts Nothing (Word comp) ini + flip evalStateT (3, Set.empty) $ + evalRepl (const $ pure ">>> ") cmd opts Nothing Nothing (Word comp) ini final main :: IO () main = pure () diff --git a/repline.cabal b/repline.cabal --- a/repline.cabal +++ b/repline.cabal @@ -1,35 +1,35 @@ -name: repline -version: 0.3.0.0 -synopsis: Haskeline wrapper for GHCi-like REPL interfaces. -license: MIT -license-file: LICENSE -author: Stephen Diehl -maintainer: stephen.m.diehl@gmail.com -copyright: 2014-2019 Stephen Diehl -category: User Interfaces -build-type: Simple -extra-source-files: README.md -cabal-version: >=1.10 +name: repline +version: 0.4.0.0 +synopsis: Haskeline wrapper for GHCi-like REPL interfaces. +license: MIT +license-file: LICENSE +author: Stephen Diehl +maintainer: stephen.m.diehl@gmail.com +copyright: 2014-2020 Stephen Diehl +category: User Interfaces +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 tested-with: - GHC == 7.6.1, - GHC == 7.6.2, - GHC == 7.6.3, - GHC == 7.8.1, - GHC == 7.8.2, - GHC == 7.8.3, - GHC == 7.8.4, - GHC == 7.10.1, - GHC == 7.10.2, - GHC == 7.10.3, - GHC == 8.0.1, - GHC == 8.2.1, - GHC == 8.4.1, - GHC == 8.6.1, - GHC == 8.8.1 - GHC == 8.10.1 -homepage: https://github.com/sdiehl/repline -bug-Reports: https://github.com/sdiehl/repline/issues + GHC ==7.6.1 + || ==7.6.2 + || ==7.6.3 + || ==7.8.1 + || ==7.8.2 + || ==7.8.3 + || ==7.8.4 + || ==7.10.1 + || ==7.10.2 + || ==7.10.3 + || ==8.0.1 + || ==8.2.1 + || ==8.4.1 + || ==8.6.1 + || ==8.8.1 + || ==8.10.1 +homepage: https://github.com/sdiehl/repline +bug-reports: https://github.com/sdiehl/repline/issues description: Haskeline wrapper for GHCi-like REPL interfaces. Composable with normal mtl transformers. @@ -37,52 +37,65 @@ README.md ChangeLog.md -Source-Repository head - Type: git - Location: git@github.com:sdiehl/repline.git +source-repository head + type: git + location: git@github.com:sdiehl/repline.git library - hs-source-dirs: src - exposed-modules: System.Console.Repline - ghc-options: -Wall + hs-source-dirs: src + exposed-modules: System.Console.Repline + ghc-options: -Wall build-depends: - base >= 4.6 && <5.0, - haskeline >= 0.8 && <0.9, - containers >= 0.5 && <0.7, - exceptions >= 0.10 && <0.11, - mtl >= 2.2 && <2.3, - process >= 1.2 && <2.0 - if !impl(ghc >= 8.0) - Build-Depends: fail >= 4.9 && <4.10 - default-language: Haskell2010 + base >=4.6 && <5.0 + , containers >=0.5 && <0.7 + , exceptions >=0.10 && <0.11 + , haskeline >=0.8 && <0.9 + , mtl >=2.2 && <2.3 + , process >=1.2 && <2.0 + if !impl(ghc >=8.0) + build-depends: fail ==4.9.* + + default-language: Haskell2010 + test-suite prefix - type: exitcode-stdio-1.0 - main-is: examples/Prefix.hs - default-language: Haskell2010 - build-depends: - base, - mtl, - containers, - repline + type: exitcode-stdio-1.0 + main-is: examples/Prefix.hs + default-language: Haskell2010 + build-depends: + base + , containers + , mtl + , repline test-suite simple - type: exitcode-stdio-1.0 - main-is: examples/Simple.hs - default-language: Haskell2010 - build-depends: - base, - mtl, - containers, - process, - repline + type: exitcode-stdio-1.0 + main-is: examples/Simple.hs + default-language: Haskell2010 + build-depends: + base + , containers + , mtl + , process + , repline test-suite stateful - type: exitcode-stdio-1.0 - main-is: examples/Stateful.hs - default-language: Haskell2010 - build-depends: - base, - mtl, - containers, - repline + type: exitcode-stdio-1.0 + main-is: examples/Stateful.hs + default-language: Haskell2010 + build-depends: + base + , containers + , mtl + , repline + +test-suite multiline + type: exitcode-stdio-1.0 + main-is: examples/Multiline.hs + default-language: Haskell2010 + build-depends: + base + , containers + , mtl + , process + , repline diff --git a/src/System/Console/Repline.hs b/src/System/Console/Repline.hs --- a/src/System/Console/Repline.hs +++ b/src/System/Console/Repline.hs @@ -1,156 +1,182 @@ -{-# LANGUAGE KindSignatures #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE NoMonomorphismRestriction #-} -{- | - -Repline exposes an additional monad transformer on top of Haskeline called 'HaskelineT'. It simplifies several -aspects of composing Haskeline with State and Exception monads in modern versions of mtl. - -> type Repl a = HaskelineT IO a - -The evaluator 'evalRepl' evaluates a 'HaskelineT' monad transformer by constructing a shell with several -custom functions and evaluating it inside of IO: - - * Commands: Handled on ordinary input. - - * Completions: Handled when tab key is pressed. - - * Options: Handled when a command prefixed by a prefix character is entered. - - * Command prefix character: Optional command prefix ( passing Nothing ignores the Options argument ). - - * Banner: Text Displayed at initialization. - - * Initializer: Run at initialization. - -A simple evaluation function might simply echo the output back to the screen. - -> -- Evaluation : handle each line user inputs -> cmd :: String -> Repl () -> cmd input = liftIO $ print input - -Several tab completion options are available, the most common is the 'WordCompleter' which completes on single -words separated by spaces from a list of matches. The internal logic can be whatever is required and can also -access a StateT instance to query application state. - -> -- Tab Completion: return a completion for partial words entered -> completer :: Monad m => WordCompleter m -> completer n = do -> let names = ["kirk", "spock", "mccoy"] -> return $ filter (isPrefixOf n) names - -Input which is prefixed by a colon (commands like \":type\" and \":help\") queries an association list of -functions which map to custom logic. The function takes a space-separated list of augments in it's first -argument. If the entire line is desired then the 'unwords' function can be used to concatenate. - -> -- Commands -> help :: [String] -> Repl () -> help args = liftIO $ print $ "Help: " ++ show args -> -> say :: [String] -> Repl () -> say args = do -> _ <- liftIO $ system $ "cowsay" ++ " " ++ (unwords args) -> return () - -Now we need only map these functions to their commands. - -> options :: [(String, [String] -> Repl ())] -> options = [ -> ("help", help) -- :help -> , ("say", say) -- :say -> ] - -The banner function is simply an IO action that is called at the start of the shell. - -> ini :: Repl () -> ini = liftIO $ putStrLn "Welcome!" - -Putting it all together we have a little shell. - -> main :: IO () -> main = evalRepl (pure ">>> ") cmd options (Just ':') (Word completer) ini - -Putting this in a file we can test out our cow-trek shell. - -> $ runhaskell Main.hs -> Welcome! -> >>> -> kirk spock mccoy -> -> >>> k -> kirk -> -> >>> spam -> "spam" -> -> >>> :say Hello Haskell -> _______________ -> < Hello Haskell > -> --------------- -> \ ^__^ -> \ (oo)\_______ -> (__)\ )\/\ -> ||----w | -> || || - -See for more examples. - --} - -module System.Console.Repline ( - -- * Repline Monad - HaskelineT, - runHaskelineT, - - -- * Toplevel - evalRepl, - ReplOpts(..), - evalReplOpts, - - -- * Repline Types - Cmd, - Options, - WordCompleter, - LineCompleter, - CompleterStyle(..), - Command, +-- | +-- +-- Repline exposes an additional monad transformer on top of Haskeline called 'HaskelineT'. It simplifies several +-- aspects of composing Haskeline with State and Exception monads in modern versions of mtl. +-- +-- > type Repl a = HaskelineT IO a +-- +-- The evaluator 'evalRepl' evaluates a 'HaskelineT' monad transformer by constructing a shell with several +-- custom functions and evaluating it inside of IO: +-- +-- * Commands: Handled on ordinary input. +-- +-- * Completions: Handled when tab key is pressed. +-- +-- * Options: Handled when a command prefixed by a prefix character is entered. +-- +-- * Command prefix character: Optional command prefix ( passing Nothing ignores the Options argument ). +-- +-- * Multi-line command: Optional command name that switches to a multi-line input. (Press to exit and commit the multi-line input). Passing Nothing disables multi-line input support. +-- +-- * Banner: Text Displayed at initialisation. It takes an argument so it can take into account if the current line is part of a multi-line input. +-- +-- * Initialiser: Run at initialisation. +-- +-- * Finaliser: Run on , it can be used to output a custom exit message or to choose whether to exit or not depending on the application state +-- +-- A simple evaluation function might simply echo the output back to the screen. +-- +-- > -- Evaluation : handle each line user inputs +-- > cmd :: String -> Repl () +-- > cmd input = liftIO $ print input +-- +-- Several tab completion options are available, the most common is the 'WordCompleter' which completes on single +-- words separated by spaces from a list of matches. The internal logic can be whatever is required and can also +-- access a StateT instance to query application state. +-- +-- > -- Tab Completion: return a completion for partial words entered +-- > completer :: Monad m => WordCompleter m +-- > completer n = do +-- > let names = ["kirk", "spock", "mccoy"] +-- > return $ filter (isPrefixOf n) names +-- +-- Input which is prefixed by a colon (commands like \":type\" and \":help\") queries an association list of +-- functions which map to custom logic. The function takes a space-separated list of augments in it's first +-- argument. If the entire line is desired then the 'unwords' function can be used to concatenate. +-- +-- > -- Commands +-- > help :: [String] -> Repl () +-- > help args = liftIO $ print $ "Help: " ++ show args +-- > +-- > say :: [String] -> Repl () +-- > say args = do +-- > _ <- liftIO $ system $ "cowsay" ++ " " ++ (unwords args) +-- > return () +-- +-- Now we need only map these functions to their commands. +-- +-- > options :: [(String, [String] -> Repl ())] +-- > options = [ +-- > ("help", help) -- :help +-- > , ("say", say) -- :say +-- > ] +-- +-- The initialiser function is simply an IO action that is called at the start of the shell. +-- +-- > ini :: Repl () +-- > ini = liftIO $ putStrLn "Welcome!" +-- +-- The finaliser function is an IO action that is called at the end of the shell. +-- +-- final :: Repl ExitDecision +-- final = do +-- liftIO $ putStrLn "Goodbye!" +-- return Exit +-- +-- Putting it all together we have a little shell. +-- +-- > main :: IO () +-- > main = evalRepl (pure ">>> ") cmd options (Just ':') (Word completer) ini +-- +-- Alternatively instead of initialising the repl from position arguments you +-- can pass the 'ReplOpts' record with explicitly named arguments. +-- +-- > main_alt :: IO () +-- > main_alt = evalReplOpts $ ReplOpts +-- > { banner = const (pure ">>> ") +-- > , command = cmd +-- > , options = opts +-- > , prefix = Just ':' +-- > , multilineCommand = Nothing +-- > , tabComplete = (Word0 completer) +-- > , initialiser = ini +-- > , finaliser = final +-- > } +-- +-- Putting this in a file we can test out our cow-trek shell. +-- +-- > $ runhaskell Main.hs +-- > Welcome! +-- > >>> +-- > kirk spock mccoy +-- > +-- > >>> k +-- > kirk +-- > +-- > >>> spam +-- > "spam" +-- > +-- > >>> :say Hello Haskell +-- > _______________ +-- > < Hello Haskell > +-- > --------------- +-- > \ ^__^ +-- > \ (oo)\_______ +-- > (__)\ )\/\ +-- > ||----w | +-- > || || +-- +-- See for more examples. +module System.Console.Repline + ( -- * Repline Monad + HaskelineT, + runHaskelineT, - -- * Completers - CompletionFunc, -- re-export - fallbackCompletion, + -- * Toplevel + evalRepl, + ReplOpts (..), + evalReplOpts, - wordCompleter, - listCompleter, - fileCompleter, - listWordCompleter, - runMatcher, - trimComplete, + -- * Repline Types + Cmd, + Options, + WordCompleter, + LineCompleter, + CompleterStyle (..), + Command, + ExitDecision (..), + MultiLine (..), - -- * Utilities - abort, - tryAction, - dontCrash, -) where + -- * Completers + CompletionFunc, -- re-export + fallbackCompletion, + wordCompleter, + listCompleter, + fileCompleter, + listWordCompleter, + runMatcher, + trimComplete, -import System.Console.Haskeline.Completion -import qualified System.Console.Haskeline as H + -- * Utilities + abort, + tryAction, + dontCrash, + ) +where -import Data.List (isPrefixOf) +import Control.Monad.Catch import Control.Monad.Fail as Fail -import Control.Monad.State.Strict import Control.Monad.Reader -import Control.Monad.Catch +import Control.Monad.State.Strict +import Data.List (isPrefixOf) +import qualified System.Console.Haskeline as H +import System.Console.Haskeline.Completion ------------------------------------------------------------------------------- -- Haskeline Transformer ------------------------------------------------------------------------------- +-- | Monad transformer for readline input newtype HaskelineT (m :: * -> *) a = HaskelineT {unHaskeline :: H.InputT m a} deriving ( Monad, @@ -172,14 +198,14 @@ class MonadCatch m => MonadHaskeline m where getInputLine :: String -> m (Maybe String) getInputChar :: String -> m (Maybe Char) - outputStr :: String -> m () - outputStrLn :: String -> m () + outputStr :: String -> m () + outputStrLn :: String -> m () instance (MonadMask m, MonadIO m) => MonadHaskeline (H.InputT m) where getInputLine = H.getInputLine getInputChar = H.getInputChar - outputStr = H.outputStr - outputStrLn = H.outputStrLn + outputStr = H.outputStr + outputStrLn = H.outputStrLn instance Fail.MonadFail m => Fail.MonadFail (HaskelineT m) where fail = lift . Fail.fail @@ -189,21 +215,32 @@ put = lift . put instance MonadReader r m => MonadReader r (HaskelineT m) where - ask = lift ask + ask = lift ask local f (HaskelineT m) = HaskelineT $ H.mapInputT (local f) m instance (MonadHaskeline m) => MonadHaskeline (StateT s m) where getInputLine = lift . getInputLine getInputChar = lift . getInputChar - outputStr = lift . outputStr - outputStrLn = lift . outputStrLn + outputStr = lift . outputStr + outputStrLn = lift . outputStrLn ------------------------------------------------------------------------------- -- Repl ------------------------------------------------------------------------------- -- | Command function synonym -type Cmd m = [String] -> m () +-- +-- The argument corresponds to the arguments of the command, it may contain +-- spaces or newlines (when input is multi-line). +-- +-- For example, with prefix @':'@ and command @"command"@ the argument 'String' for: +-- +-- @ +-- :command some arguments +-- @ +-- +-- is @"some arguments"@ +type Cmd m = String -> m () -- | Options function synonym type Options m = [(String, Cmd m)] @@ -225,46 +262,73 @@ -- | Catch all toplevel failures. dontCrash :: (MonadIO m, MonadCatch m) => m () -> m () -dontCrash m = catch m ( \ e@SomeException{} -> liftIO ( print e )) +dontCrash m = catch m (\e@SomeException {} -> liftIO (print e)) -- | Abort the current REPL loop, and continue. abort :: MonadThrow m => HaskelineT m a abort = throwM H.Interrupt -- | Completion loop. -replLoop :: (Functor m, MonadMask m, MonadIO m) - => HaskelineT m String -- ^ banner function - -> Command (HaskelineT m) -- ^ command function - -> Options (HaskelineT m) -- ^ options function - -> Maybe Char -- ^ options prefix - -> HaskelineT m () -replLoop banner cmdM opts optsPrefix = loop +replLoop :: + (Functor m, MonadMask m, MonadIO m) => + -- | Banner function + (MultiLine -> HaskelineT m String) -> + -- | Command function + Command (HaskelineT m) -> + -- | options function + Options (HaskelineT m) -> + -- | options prefix + Maybe Char -> + -- | multi-line command + Maybe String -> + -- | Finaliser ( runs on ) + HaskelineT m ExitDecision -> + HaskelineT m () +replLoop banner cmdM opts optsPrefix multiCommand finalz = loop where loop = do - prefix <- banner + prefix <- banner SingleLine minput <- H.handleInterrupt (return (Just "")) $ getInputLine prefix + handleCommands minput + handleCommands minput = case minput of - Nothing -> outputStrLn "Goodbye." + Nothing -> + finalz >>= \case + Continue -> loop + Exit -> exit Just "" -> loop Just (prefix_ : cmds) | null cmds -> handleInput [prefix_] >> loop | Just prefix_ == optsPrefix -> case words cmds of [] -> loop - (cmd : args) -> do - let optAction = optMatcher cmd opts args + (cmd : _) + | Just cmd == multiCommand -> do + outputStrLn "-- Entering multi-line mode. Press to finish." + loopMultiLine [] + (cmd : _) -> do + let -- If there are any arguments, cmd is followed by a + -- whitespace character (space, newline, ...) + arguments = drop (1 + length cmd) cmds + let optAction = optMatcher cmd opts arguments result <- H.handleInterrupt (return Nothing) $ Just <$> optAction maybe exit (const loop) result Just input -> do handleInput input loop + loopMultiLine prevs = do + prefix <- banner MultiLine + minput <- H.handleInterrupt (return (Just "")) $ getInputLine prefix + case minput of + Nothing -> handleCommands . Just . unlines $ reverse prevs + Just x -> loopMultiLine $ x : prevs handleInput input = H.handleInterrupt exit $ cmdM input exit = return () -- | Match the options. -optMatcher :: MonadHaskeline m => String -> Options m -> [String] -> m () +optMatcher :: MonadHaskeline m => String -> Options m -> String -> m () optMatcher s [] _ = outputStrLn $ "No such command :" ++ s -optMatcher s ((x, m):xs) args +optMatcher s ((x, m) : xs) args | s `isPrefixOf` x = m args | otherwise = optMatcher s xs args @@ -272,50 +336,85 @@ -- Toplevel ------------------------------------------------------------------------------- +-- | Decide whether to exit the REPL or not +data ExitDecision + = -- | Keep the REPL open + Continue + | -- | Close the REPL and exit + Exit + +-- | Context for the current line if it is part of a multi-line input or not +data MultiLine = MultiLine | SingleLine deriving (Eq, Show) + -- | REPL Options datatype -data ReplOpts m = ReplOpts { - banner :: HaskelineT m String -- ^ Banner - , command :: Command (HaskelineT m) -- ^ Command function - , options :: Options (HaskelineT m) -- ^ Options list and commands - , prefix :: Maybe Char -- ^ Optional command prefix ( passing Nothing ignores the Options argument ) - , tabComplete :: CompleterStyle m -- ^ Tab completion function - , initialiser :: HaskelineT m () -- ^ Initialiser +data ReplOpts m = ReplOpts + { -- | Banner + banner :: MultiLine -> HaskelineT m String, + -- | Command function + command :: Command (HaskelineT m), + -- | Options list and commands + options :: Options (HaskelineT m), + -- | Optional command prefix ( passing Nothing ignores the Options argument ) + prefix :: Maybe Char, + -- | Optional multi-line command ( passing Nothing disables multi-line support ) + multilineCommand :: Maybe String, + -- | Tab completion function + tabComplete :: CompleterStyle m, + -- | Initialiser + initialiser :: HaskelineT m (), + -- | Finaliser ( runs on ) + finaliser :: HaskelineT m ExitDecision } -- | Evaluate the REPL logic into a MonadCatch context from the ReplOpts -- configuration. evalReplOpts :: (MonadMask m, MonadIO m) => ReplOpts m -> m () -evalReplOpts ReplOpts {..} = evalRepl - banner - command - options - prefix - tabComplete - initialiser +evalReplOpts ReplOpts {..} = + evalRepl + banner + command + options + prefix + multilineCommand + tabComplete + initialiser + finaliser -- | Evaluate the REPL logic into a MonadCatch context. -evalRepl - :: (MonadMask m, MonadIO m) -- Terminal monad ( often IO ). - => HaskelineT m String -- ^ Banner - -> Command (HaskelineT m) -- ^ Command function - -> Options (HaskelineT m) -- ^ Options list and commands - -> Maybe Char -- ^ Optional command prefix ( passing Nothing ignores the Options argument ) - -> CompleterStyle m -- ^ Tab completion function - -> HaskelineT m a -- ^ Initialiser - -> m () -evalRepl banner cmd opts optsPrefix comp initz = runHaskelineT _readline (initz >> monad) +evalRepl :: + (MonadMask m, MonadIO m) => + -- | Banner + (MultiLine -> HaskelineT m String) -> + -- | Command function + Command (HaskelineT m) -> + -- | Options list and commands + Options (HaskelineT m) -> + -- | Optional command prefix ( passing Nothing ignores the Options argument ) + Maybe Char -> + -- | Optional multi-line command ( passing Nothing disables multi-line support ) + Maybe String -> + -- | Tab completion function + CompleterStyle m -> + -- | Initialiser + HaskelineT m a -> + -- | Finaliser ( runs on Ctrl-D ) + HaskelineT m ExitDecision -> + m () +evalRepl banner cmd opts optsPrefix multiCommand comp initz finalz = runHaskelineT _readline (initz >> monad) where - monad = replLoop banner cmd opts optsPrefix - _readline = H.Settings - { H.complete = mkCompleter comp - , H.historyFile = Just ".history" - , H.autoAddHistory = True - } + monad = replLoop banner cmd opts optsPrefix multiCommand finalz + _readline = + H.Settings + { H.complete = mkCompleter comp, + H.historyFile = Just ".history", + H.autoAddHistory = True + } -------------------------------------------------------------------------------- +------------------------------------------------------------------------------ -- Completions ------------------------------------------------------------------------------- +-- | Tab completer types data CompleterStyle m = -- | Completion function takes single word. Word (WordCompleter m) @@ -329,10 +428,10 @@ Prefix (CompletionFunc m) [(String, CompletionFunc m)] - -- | Combine two completions - | Combine (CompleterStyle m) (CompleterStyle m) - -- | Custom completion - | Custom (CompletionFunc m) + | -- | Combine two completions + Combine (CompleterStyle m) (CompleterStyle m) + | -- | Custom completion + Custom (CompletionFunc m) -- | Make a completer function from a completion type mkCompleter :: MonadIO m => CompleterStyle m -> CompletionFunc m