repline 0.1.7.0 → 0.4.3.0
raw patch · 9 files changed
Files
- ChangeLog.md +49/−0
- LICENSE +1/−1
- README.md +91/−18
- examples/Multiline.hs +85/−0
- examples/Prefix.hs +62/−0
- examples/Simple.hs +63/−0
- examples/Stateful.hs +65/−0
- repline.cabal +90/−27
- src/System/Console/Repline.hs +394/−204
+ ChangeLog.md view
@@ -0,0 +1,49 @@+HEAD+====++0.4.2.0+=======++- Add support for ghc 9.0, 9.2+- CI: Drop Travis and use Github Actions instead++0.4.1.0+=======++- Fix up documentation.+- Export `MonadHaskeline` from System.Control.Repline.++0.4.0.0+=======++- Add multi-line input support+- Add finaliser option to control REPL exit on <Ctrl-D>++0.3.0.0+=======++- Upgrades to lower bound to Haskeline 0.8.0.0.+- No longer requires MonadException.+- MonadCatch, MonadThrow, MonadMask instances.++0.2.2.0+=======++- `ReplOpts` configuration type and `evalReplOpts` function.+- Only use `fail` for GHC<8.0++0.2.1.0+=======++- Add `exceptions` dependency.+- Add a `MonadFail` instance to `HaskelineT`.++0.2.0.0+=======++- `evalRepl` has changed signature.++0.1.0.0+=======++- Initial release.
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2016-2017 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
README.md view
@@ -1,13 +1,90 @@ Repline ------- -[](https://travis-ci.org/sdiehl/repline)+[](https://travis-ci.org/sdiehl/repline) [](https://hackage.haskell.org/package/repline) Slightly higher level wrapper for creating GHCi-like REPL monads that are composable with normal MTL transformers. Mostly exists because I got tired of implementing the same interface for simple shells over and over and decided to canonize the giant pile of hacks that I use to make Haskeline work. +See+[Documentation](https://hackage.haskell.org/package/repline-0.4.0.0/docs/System-Console-Repline.html)+for more detailed usage.++Examples+--------++* [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 ----- @@ -43,14 +120,15 @@ ini = liftIO $ putStrLn "Welcome!" repl :: IO ()-repl = evalRepl ">>> " cmd options (Word completer) ini+repl = evalRepl (pure ">>> ") cmd options Nothing (Word completer) ini ``` Trying it out: ```haskell-$ runhaskell Simple.hs-# Or if in a sandbox: cabal exec runhaskell Simple.hs+$ stack repl Simple.hs+Prelude> main+ Welcome! >>> <TAB> kirk spock mccoy@@ -62,9 +140,9 @@ "spam" >>> :say Hello Haskell- _______________ + _______________ < Hello Haskell >- --------------- + --------------- \ ^__^ \ (oo)\_______ (__)\ )\/\@@ -113,12 +191,12 @@ -- Tab completion inside of StateT repl :: IO () repl = flip evalStateT Set.empty- $ evalRepl ">>> " cmd opts (Word comp) init+ $ evalRepl (pure ">>> ") cmd opts Nothing (Word comp) ini ``` Prefix Completion-----------------+----------------- Just as GHCi will provide different tab completion for kind-level vs type-level symbols based on which prefix the user has entered, we can also set up a provide this as a first-level construct using a ``Prefix`` tab@@ -164,13 +242,15 @@ init = return () repl :: IO ()-repl = evalRepl ">> " cmd opts (Prefix (wordCompleter byWord) defaultMatcher) init+repl = evalRepl (pure ">>> ") cmd opts Nothing (Prefix (wordCompleter byWord) defaultMatcher) init ``` Trying it out: ```haskell-$ runhaskell Main.hs+$ stack repl examples/Prefix.hs+Prelude> main+ >>> :file <TAB> sample1.txt sample2.txt @@ -180,15 +260,8 @@ christmas thanksgiving festivus ``` -Installation---------------```bash-$ cabal install repline-```- License ------- -Copyright (c) 2014-2017, Stephen Diehl+Copyright (c) 2014-2020, Stephen Diehl Released under the MIT License
+ examples/Multiline.hs view
@@ -0,0 +1,85 @@+module Main (main, repl) where++import Control.Monad.Trans+import Data.List (isPrefixOf)+import Data.Monoid+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 ()
+ examples/Prefix.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}++module Main (main, repl) where++import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.State.Strict+import Data.List (isPrefixOf)+import qualified Data.Set as Set+import System.Console.Repline++-------------------------------------------------------------------------------+-- Prefix Completion+-------------------------------------------------------------------------------++type Repl a = HaskelineT IO a++-- Evaluation+cmd :: String -> Repl ()+cmd input = liftIO $ print input++-- Prefix tab completeter+defaultMatcher :: MonadIO m => [(String, CompletionFunc m)]+defaultMatcher =+ [ (":file", fileCompleter),+ (":holiday", listCompleter ["christmas", "thanksgiving", "festivus"])+ ]++-- Default tab completer+byWord :: Monad m => WordCompleter m+byWord n = do+ let names = ["picard", "riker", "data", ":file", ":holiday"]+ return $ filter (isPrefixOf n) names++files :: String -> Repl ()+files args = liftIO $ do+ contents <- readFile args+ putStrLn contents++holidays :: String -> Repl ()+holidays "" = liftIO $ putStrLn "Enter a holiday."+holidays xs = liftIO $ do+ putStrLn $ "Happy " ++ xs ++ "!"++opts :: [(String, String -> Repl ())]+opts =+ [ ("file", files),+ ("holiday", holidays)+ ]++inits :: Repl ()+inits = return ()++final :: Repl ExitDecision+final = return Exit++repl :: IO ()+repl = evalRepl (const $ pure ">>> ") cmd opts Nothing Nothing (Prefix (wordCompleter byWord) defaultMatcher) inits final++main :: IO ()+main = pure ()
+ examples/Simple.hs view
@@ -0,0 +1,63 @@+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++-- 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++-- Commands+help :: [String] -> Repl ()+help args = liftIO $ print $ "Help: " ++ show args++say :: String -> Repl ()+say args = do+ _ <- liftIO $ callCommand $ "cowsay" ++ " " ++ args+ return ()++opts :: [(String, String -> Repl ())]+opts =+ [ ("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 (const $ pure ">>> ") cmd opts (Just ':') (Just "paste") (Word0 completer) ini final++main :: IO ()+main = pure ()
+ examples/Stateful.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}++module Main (main, repl) where++import Control.Monad.IO.Class (liftIO)+import Control.Monad.State.Strict+import Data.List (isPrefixOf)+import Data.Monoid+import qualified Data.Set as Set+import System.Console.Repline++-------------------------------------------------------------------------------+-- Stateful Completion+-------------------------------------------------------------------------------++type IState = (Int, Set.Set String)++type Repl a = HaskelineT (StateT IState IO) a++-- Evaluation+cmd :: String -> Repl ()+cmd input = modify . fmap $ \s -> Set.insert input s++-- Completion+comp :: (Monad m, MonadState IState m) => WordCompleter m+comp n = do+ (c, ns) <- get+ return $ filter (isPrefixOf n) (Set.toList ns)++-- Commands+help :: [String] -> Repl ()+help args = liftIO $ print $ "Help!" ++ show args++puts :: [String] -> Repl ()+puts args = modify . fmap $ \s -> Set.union s (Set.fromList args)++opts :: [(String, String -> Repl ())]+opts =+ [ ("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 (3, Set.empty) $+ evalRepl (const $ pure ">>> ") cmd opts Nothing Nothing (Word comp) ini final++main :: IO ()+main = pure ()
repline.cabal view
@@ -1,33 +1,96 @@-name: repline-version: 0.1.7.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-2017 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.3, GHC == 7.8.3, GHC == 7.10.1-homepage: https://github.com/sdiehl/repline-Bug-Reports: https://github.com/sdiehl/repline/issues+name: repline+version: 0.4.3.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-2022 Stephen Diehl+category: User Interfaces+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10+tested-with:+ GHC ==8.2.2+ || ==8.4.4+ || ==8.6.2+ || ==8.6.3+ || ==8.6.4+ || ==8.6.5+ || ==8.8.1+ || ==8.10.1+ || ==8.10.7+ || ==9.0.1+ || ==9.2 -Description:+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. -Source-Repository head- Type: git- Location: git@github.com:sdiehl/repline.git+extra-source-files:+ README.md+ ChangeLog.md +source-repository head+ type: git+ location: git@github.com:sdiehl/repline.git+ library- hs-source-dirs: src- exposed-modules: System.Console.Repline+ hs-source-dirs: src+ exposed-modules: System.Console.Repline+ ghc-options: -Wall build-depends:- base >= 4.6 && <5.0,- containers >= 0.5 && <0.6,- mtl >= 2.2 && <2.3,- process >= 1.2 && <2.0,- haskeline >= 0.7 && <0.8- default-language: Haskell2010+ base >=4.6 && <5.0+ , containers >=0.5 && <0.8+ , exceptions >=0.10 && <0.11+ , haskeline >=0.8 && <0.9+ , mtl >=2.2 && <2.4+ , 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+ , containers+ , mtl+ , repline++test-suite simple+ 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+ , 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
src/System/Console/Repline.hs view
@@ -1,305 +1,495 @@-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# 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 colon is entered.-- * 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 ">>> " cmd options (Word completer) ini--Putting this in a file we can test out our cow-trek shell.--> $ runhaskell Main.hs-> Welcome!-> >>> <TAB>-> kirk spock mccoy->-> >>> k<TAB>-> kirk->-> >>> spam-> "spam"->-> >>> :say Hello Haskell-> _______________-> < Hello Haskell >-> ----------------> \ ^__^-> \ (oo)\_______-> (__)\ )\/\-> ||----w |-> || ||--See <https://github.com/sdiehl/repline> for more examples.---}--module System.Console.Repline (- HaskelineT,- runHaskelineT,-- 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 <Ctrl-D> 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 <Ctrl-D>, 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 arg = do+-- > _ <- liftIO $ callCommand $ "cowsay" ++ " " ++ arg+-- > return ()+--+-- (You may need the following import in pull `callCommand` into scope)+--+-- > import System.Process (callCommand)+--+-- Now we need only map these functions to their commands.+--+-- > options :: Options (HaskelineT IO)+-- > options = [+-- > ("help", help . words) -- :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 (const . pure $ ">>> ") cmd options (Just ':') (Just "paste") (Word completer) ini final - CompletionFunc, -- re-export+--+-- 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!+-- > >>> <TAB>+-- > kirk spock mccoy+-- >+-- > >>> k<TAB>+-- > kirk+-- >+-- > >>> spam+-- > "spam"+-- >+-- > >>> :say Hello Haskell+-- > _______________+-- > < Hello Haskell >+-- > ---------------+-- > \ ^__^+-- > \ (oo)\_______+-- > (__)\ )\/\+-- > ||----w |+-- > || ||+--+-- See <https://github.com/sdiehl/repline> for more examples.+module System.Console.Repline+ ( -- * Repline Monad+ HaskelineT,+ runHaskelineT,+ MonadHaskeline, - wordCompleter,- listCompleter,- fileCompleter,- listWordCompleter,+ -- * Toplevel+ evalRepl,+ ReplOpts (..),+ evalReplOpts, - runMatcher,- evalRepl,- abort,- tryAction,+ -- * Repline Types+ Cmd,+ Options,+ WordCompleter,+ LineCompleter,+ CompleterStyle (..),+ Command,+ ExitDecision (..),+ MultiLine (..), - trimComplete,-) where+ -- * Completers+ CompletionFunc, -- re-export+ fallbackCompletion,+ wordCompleter,+ listCompleter,+ fileCompleter,+ listWordCompleter,+ runMatcher,+ trimComplete, -import System.Console.Haskeline.Completion-import System.Console.Haskeline.MonadException-import qualified System.Console.Haskeline as H+ -- * Utilities+ abort,+ tryAction,+ dontCrash,+ )+where -import Data.List (isPrefixOf)-import Control.Applicative+import Control.Monad.Catch+import Control.Monad.Fail as Fail+import Control.Monad.Fix (MonadFix)+import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Reader import Control.Monad.State.Strict+import Data.List (isPrefixOf)+import qualified System.Console.Haskeline as H+import System.Console.Haskeline.Completion ------------------------------------------------------------------------------- -- Haskeline Transformer ------------------------------------------------------------------------------- -newtype HaskelineT (m :: * -> *) a = HaskelineT { unHaskeline :: H.InputT m a }- deriving (Monad, Functor, Applicative, MonadIO, MonadException, MonadTrans, MonadHaskeline)+-- | Monad transformer for readline input+newtype HaskelineT (m :: * -> *) a = HaskelineT {unHaskeline :: H.InputT m a}+ deriving+ ( Monad,+ Functor,+ Applicative,+ MonadIO,+ MonadFix,+ MonadTrans,+ MonadHaskeline,+ MonadThrow,+ MonadCatch,+ MonadMask+ ) -runHaskelineT :: MonadException m => H.Settings m -> HaskelineT m a -> m a+-- | Run HaskelineT monad+runHaskelineT :: (MonadMask m, MonadIO m) => H.Settings m -> HaskelineT m a -> m a runHaskelineT s m = H.runInputT s (H.withInterrupt (unHaskeline m)) -class MonadException m => MonadHaskeline m where+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 MonadException m => MonadHaskeline (H.InputT m) where+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+ instance MonadState s m => MonadState s (HaskelineT m) where get = lift get put = lift . put +instance MonadReader r m => MonadReader r (HaskelineT m) where+ 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 ------------------------------------------------------------------------------- -type Cmd m = [String] -> m ()+-- | Command function synonym+--+-- 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)]++-- | Command function synonym type Command m = String -> m () +-- | Word completer type WordCompleter m = (String -> m [String])++-- | Line completer type LineCompleter m = (String -> String -> m [Completion]) -- | Wrap a HasklineT action so that if an interrupt is thrown the shell continues as normal.-tryAction :: MonadException m => HaskelineT m a -> HaskelineT m a+tryAction :: (MonadMask m, MonadIO m) => HaskelineT m a -> HaskelineT m a tryAction (HaskelineT f) = HaskelineT (H.withInterrupt loop)- where loop = handle (\H.Interrupt -> loop) f+ where+ loop = handle (\H.Interrupt -> loop) f +-- | Catch all toplevel failures.+dontCrash :: (MonadIO m, MonadCatch m) => m () -> m ()+dontCrash m = catch m (\e@SomeException {} -> liftIO (print e))+ -- | Abort the current REPL loop, and continue.-abort :: MonadIO m => HaskelineT m a-abort = throwIO H.Interrupt+abort :: MonadThrow m => HaskelineT m a+abort = throwM H.Interrupt -- | Completion loop.-replLoop :: MonadException m- => String- -> Command (HaskelineT m)- -> Options (HaskelineT m)- -> HaskelineT m ()-replLoop banner cmdM opts = loop+replLoop ::+ (Functor m, MonadMask m, MonadIO m)+ => (MultiLine -> HaskelineT m String) -- ^ Banner function+ -> Command (HaskelineT m) -- ^ Command function+ -> Options (HaskelineT m) -- ^ options function+ -> Maybe Char -- ^ options prefix+ -> Maybe String -- ^ multi-line command+ -> HaskelineT m ExitDecision -- ^ Finaliser ( runs on <Ctrl-D> )+ -> HaskelineT m ()+replLoop banner cmdM opts optsPrefix multiCommand finalz = loop where loop = do- minput <- H.handleInterrupt (return (Just "")) $ getInputLine 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 ":" -> loop-- Just (':' : cmds) -> do- let (cmd:args) = words cmds- optMatcher cmd opts args- loop-+ Just (prefix_ : cmds)+ | null cmds -> handleInput [prefix_] >> loop+ | Just prefix_ == optsPrefix ->+ case words cmds of+ [] -> loop+ (cmd : _)+ | Just cmd == multiCommand -> do+ outputStrLn "-- Entering multi-line mode. Press <Ctrl-D> 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- H.handleInterrupt (return ()) $ cmdM input+ 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 --- | Evaluate the REPL logic into a MonadException context.-evalRepl :: MonadException m -- Terminal monad ( often IO ).- => String -- ^ Banner- -> Command (HaskelineT m) -- ^ Command function- -> Options (HaskelineT m) -- ^ Options list and commands- -> CompleterStyle m -- ^ Tab completion function- -> HaskelineT m a -- ^ Initializer- -> m ()-evalRepl banner cmd opts comp initz = runHaskelineT _readline (initz >> monad)+-------------------------------------------------------------------------------+-- 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+ 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 <Ctrl-D> )+ 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+ multilineCommand+ tabComplete+ initialiser+ finaliser++-- | Evaluate the REPL logic into a MonadCatch context.+evalRepl ::+ (MonadMask m, MonadIO m)+ => (MultiLine -> 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 )+ -> Maybe String -- ^ Optional multi-line command ( passing Nothing disables multi-line support )+ -> CompleterStyle m -- ^ Tab completion function+ -> HaskelineT m a -- ^ Initialiser+ -> HaskelineT m ExitDecision -- ^ Finaliser ( runs on Ctrl-D )+ -> m ()+evalRepl banner cmd opts optsPrefix multiCommand comp initz finalz = runHaskelineT _readline (initz >> monad) where- monad = replLoop banner cmd opts- _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 ------------------------------------------------------------------------------- ---type CompletionFunc m = (String, String) -> m (String, [Completion])-+-- | Tab completer types data CompleterStyle m- = Word (WordCompleter m) -- ^ Completion function takes single word.- | Word0 (WordCompleter m) -- ^ Completion function takes single word ( no space ).- | Cursor (LineCompleter m) -- ^ Completion function takes tuple of full line.- | File -- ^ Completion function completes files in CWD.- | Prefix+ = -- | Completion function takes single word.+ Word (WordCompleter m)+ | -- | Completion function takes single word ( no space ).+ Word0 (WordCompleter m)+ | -- | Completion function takes tuple of full line.+ Cursor (LineCompleter m)+ | -- | Completion function completes files in CWD.+ File+ | -- | Conditional tab completion based on prefix.+ Prefix (CompletionFunc m)- [(String, CompletionFunc m)] -- ^ Conditional tab completion based on prefix.+ [(String, 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-mkCompleter (Word f) = completeWord (Just '\\') " \t()[]" (_simpleComplete f)-mkCompleter (Word0 f) = completeWord (Just '\\') " \t()[]" (_simpleCompleteNoSpace f)-mkCompleter (Cursor f) = completeWordWithPrev (Just '\\') " \t()[]" (unRev0 f)-mkCompleter File = completeFilename+mkCompleter (Word f) = completeWord (Just '\\') " \t()[]" (_simpleComplete f)+mkCompleter (Word0 f) = completeWord (Just '\\') " \t()[]" (_simpleCompleteNoSpace f)+mkCompleter (Cursor f) = completeWordWithPrev (Just '\\') " \t()[]" (unRev0 f)+mkCompleter File = completeFilename mkCompleter (Prefix def opts) = runMatcher opts def+mkCompleter (Combine a b) = fallbackCompletion (mkCompleter a) (mkCompleter b)+mkCompleter (Custom f) = f -- haskeline takes the first argument as the reversed string, don't know why unRev0 :: LineCompleter m -> LineCompleter m-unRev0 f x y = f (reverse x) y+unRev0 f x = f (reverse x) +-- | Trim completion trimComplete :: String -> Completion -> Completion trimComplete prefix (Completion a b c) = Completion (drop (length prefix) a) b c _simpleComplete :: (Monad m) => (String -> m [String]) -> String -> m [Completion]-_simpleComplete f word = f word >>= return . map simpleCompletion+_simpleComplete f word = map simpleCompletion <$> f word _simpleCompleteNoSpace :: (Monad m) => (String -> m [String]) -> String -> m [Completion]-_simpleCompleteNoSpace f word = f word >>= return . map completionNoSpace+_simpleCompleteNoSpace f word = map completionNoSpace <$> f word completionNoSpace :: String -> Completion completionNoSpace str = Completion str str False +-- | Word completer function wordCompleter :: Monad m => WordCompleter m -> CompletionFunc m-wordCompleter f (start, n) = (completeWord (Just '\\') " \t()[]" (_simpleComplete f)) (start, n)+wordCompleter f (start, n) = completeWord (Just '\\') " \t()[]" (_simpleComplete f) (start, n) +-- | List completer function listCompleter :: Monad m => [String] -> CompletionFunc m-listCompleter names (start, n) = completeWord (Just '\\') " \t()[]" (_simpleComplete (complete_aux names)) (start, n)+listCompleter names (start, n) = completeWord (Just '\\') " \t()[]" (_simpleComplete (completeAux names)) (start, n) +-- | List word completer listWordCompleter :: Monad m => [String] -> WordCompleter m-listWordCompleter = complete_aux+listWordCompleter = completeAux +-- | File completer function fileCompleter :: MonadIO m => CompletionFunc m fileCompleter = completeFilename -complete_aux :: Monad m => [String] -> WordCompleter m-complete_aux names n = return $ filter (isPrefixOf n) names+completeAux :: Monad m => [String] -> WordCompleter m+completeAux names n = return $ filter (isPrefixOf n) names -completeMatcher :: (Monad m) => CompletionFunc m -> String- -> [(String, CompletionFunc m)]- -> CompletionFunc m+completeMatcher ::+ (Monad m) =>+ CompletionFunc m ->+ String ->+ [(String, CompletionFunc m)] ->+ CompletionFunc m completeMatcher def _ [] args = def args completeMatcher def [] _ args = def args-completeMatcher def s ((x, f):xs) args+completeMatcher def s ((x, f) : xs) args | x `isPrefixOf` s = f args | otherwise = completeMatcher def s xs args -runMatcher :: Monad m => [(String, CompletionFunc m)]- -> CompletionFunc m- -> CompletionFunc m-runMatcher opts def (start, n) = do- (completeMatcher def (n ++ reverse start) opts) (start, n)+-- | Return a completion function a line fragment+runMatcher ::+ Monad m =>+ [(String, CompletionFunc m)] ->+ CompletionFunc m ->+ CompletionFunc m+runMatcher opts def (start, n) =+ completeMatcher def (n ++ reverse start) opts (start, n)