diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -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 + +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. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,13 +1,90 @@ Repline ------- -[![Build Status](https://travis-ci.org/sdiehl/repline.svg)](https://travis-ci.org/sdiehl/repline) +[![Build Status](https://travis-ci.org/sdiehl/repline.svg?branch=master)](https://travis-ci.org/sdiehl/repline) [![Hackage](https://img.shields.io/hackage/v/repline.svg)](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! >>> 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 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 diff --git a/examples/Multiline.hs b/examples/Multiline.hs new file mode 100644 --- /dev/null +++ b/examples/Multiline.hs @@ -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 () diff --git a/examples/Prefix.hs b/examples/Prefix.hs new file mode 100644 --- /dev/null +++ b/examples/Prefix.hs @@ -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 () diff --git a/examples/Simple.hs b/examples/Simple.hs new file mode 100644 --- /dev/null +++ b/examples/Simple.hs @@ -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 () diff --git a/examples/Stateful.hs b/examples/Stateful.hs new file mode 100644 --- /dev/null +++ b/examples/Stateful.hs @@ -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 () diff --git a/repline.cabal b/repline.cabal --- a/repline.cabal +++ b/repline.cabal @@ -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 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,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! -> >>> -> kirk spock mccoy -> -> >>> k -> kirk -> -> >>> spam -> "spam" -> -> >>> :say Hello Haskell -> _______________ -> < Hello Haskell > -> --------------- -> \ ^__^ -> \ (oo)\_______ -> (__)\ )\/\ -> ||----w | -> || || - -See 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 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 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! +-- > >>> +-- > 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, + 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 ) + -> 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 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 ) + 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)