repline-0.4.2.0/0000755000000000000000000000000007346545000011502 5ustar0000000000000000repline-0.4.2.0/ChangeLog.md0000644000000000000000000000136307346545000013656 0ustar0000000000000000HEAD ==== 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. repline-0.4.2.0/LICENSE0000644000000000000000000000204607346545000012511 0ustar0000000000000000Copyright (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 "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. repline-0.4.2.0/README.md0000644000000000000000000001436207346545000012767 0ustar0000000000000000Repline ------- [![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 ----- ```haskell 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 $ system $ "cowsay" ++ " " ++ (unwords args) return () options :: [(String, [String] -> Repl ())] options = [ ("help", help) -- :help , ("say", say) -- :say ] ini :: Repl () ini = liftIO $ putStrLn "Welcome!" repl :: IO () repl = evalRepl (pure ">>> ") cmd options Nothing (Word completer) ini ``` Trying it out: ```haskell $ stack repl Simple.hs Prelude> main Welcome! >>> kirk spock mccoy >>> k kirk >>> spam "spam" >>> :say Hello Haskell _______________ < Hello Haskell > --------------- \ ^__^ \ (oo)\_______ (__)\ )\/\ ||----w | || || ``` Stateful Tab Completion ----------------------- Quite often tab completion is dependent on the internal state of the Repl so we'd like to query state of the interpreter for tab completions based on actions performed themselves within the Repl, this is modeleted naturally as a monad transformer stack with ``StateT`` on top of ``HaskelineT``. ```haskell type IState = Set.Set String type Repl a = HaskelineT (StateT IState IO) a -- Evaluation cmd :: String -> Repl () cmd input = modify $ \s -> Set.insert input s -- Completion comp :: (Monad m, MonadState IState m) => WordCompleter m comp n = do 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 $ \s -> Set.union s (Set.fromList args) opts :: [(String, [String] -> Repl ())] opts = [ ("help", help) -- :help , ("puts", puts) -- :puts ] ini :: Repl () ini = return () -- Tab completion inside of StateT repl :: IO () repl = flip evalStateT Set.empty $ 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 completer which takes care of the string matching behind the API. ```haskell 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 (unwords args) putStrLn contents holidays :: [String] -> Repl () holidays [] = liftIO $ putStrLn "Enter a holiday." holidays xs = liftIO $ do putStrLn $ "Happy " ++ unwords xs ++ "!" opts :: [(String, [String] -> Repl ())] opts = [ ("file", files) , ("holiday", holidays) ] init :: Repl () init = return () repl :: IO () repl = evalRepl (pure ">>> ") cmd opts Nothing (Prefix (wordCompleter byWord) defaultMatcher) init ``` Trying it out: ```haskell $ stack repl examples/Prefix.hs Prelude> main >>> :file sample1.txt sample2.txt >>> :file sample1.txt >>> :holiday christmas thanksgiving festivus ``` License ------- Copyright (c) 2014-2020, Stephen Diehl Released under the MIT License repline-0.4.2.0/Setup.hs0000644000000000000000000000005607346545000013137 0ustar0000000000000000import Distribution.Simple main = defaultMain repline-0.4.2.0/examples/0000755000000000000000000000000007346545000013320 5ustar0000000000000000repline-0.4.2.0/examples/Multiline.hs0000644000000000000000000000362507346545000015624 0ustar0000000000000000module 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 () repline-0.4.2.0/examples/Prefix.hs0000644000000000000000000000305407346545000015113 0ustar0000000000000000{-# 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 () repline-0.4.2.0/examples/Simple.hs0000644000000000000000000000276007346545000015112 0ustar0000000000000000module 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 () repline-0.4.2.0/examples/Stateful.hs0000644000000000000000000000307507346545000015450 0ustar0000000000000000{-# 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-0.4.2.0/repline.cabal0000644000000000000000000000420307346545000014123 0ustar0000000000000000name: repline version: 0.4.2.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 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. 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 ghc-options: -Wall build-depends: base >=4.6 && <5.0 , containers >=0.5 && <0.7 , 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 repline-0.4.2.0/src/System/Console/0000755000000000000000000000000007346545000015157 5ustar0000000000000000repline-0.4.2.0/src/System/Console/Repline.hs0000644000000000000000000004046607346545000017123 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# 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 ). -- -- * 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 -- -- 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, -- * Toplevel evalRepl, ReplOpts (..), evalReplOpts, -- * Repline Types Cmd, Options, WordCompleter, LineCompleter, CompleterStyle (..), Command, ExitDecision (..), MultiLine (..), -- * Completers CompletionFunc, -- re-export fallbackCompletion, wordCompleter, listCompleter, fileCompleter, listWordCompleter, runMatcher, trimComplete, -- * Utilities abort, tryAction, dontCrash, ) where 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 ------------------------------------------------------------------------------- -- | 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 ) -- | 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 MonadCatch m => MonadHaskeline m where getInputLine :: String -> m (Maybe String) getInputChar :: String -> m (Maybe Char) 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 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 ------------------------------------------------------------------------------- -- Repl ------------------------------------------------------------------------------- -- | 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 :: (MonadMask m, MonadIO m) => HaskelineT m a -> HaskelineT m a tryAction (HaskelineT f) = HaskelineT (H.withInterrupt loop) 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 :: MonadThrow m => HaskelineT m a abort = throwM H.Interrupt -- | Completion 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 prefix <- banner SingleLine minput <- H.handleInterrupt (return (Just "")) $ getInputLine prefix handleCommands minput handleCommands minput = case minput of 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 : _) | 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 s [] _ = outputStrLn $ "No such command :" ++ s optMatcher s ((x, m) : xs) args | s `isPrefixOf` x = m args | otherwise = optMatcher s xs args ------------------------------------------------------------------------------- -- 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 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) | -- | 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)] | -- | 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 (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 = 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 = map simpleCompletion <$> f word _simpleCompleteNoSpace :: (Monad m) => (String -> m [String]) -> String -> m [Completion] _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) -- | List completer function listCompleter :: Monad m => [String] -> CompletionFunc m listCompleter names (start, n) = completeWord (Just '\\') " \t()[]" (_simpleComplete (completeAux names)) (start, n) -- | List word completer listWordCompleter :: Monad m => [String] -> WordCompleter m listWordCompleter = completeAux -- | File completer function fileCompleter :: MonadIO m => CompletionFunc m fileCompleter = completeFilename 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 def _ [] args = def args completeMatcher def [] _ args = def args completeMatcher def s ((x, f) : xs) args | x `isPrefixOf` s = f args | otherwise = completeMatcher def s xs args -- | 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)