{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

-- |
--
-- Repline exposes an additional monad transformer on top of Haskeline called 'HaskelineT'. It simplifies several
-- aspects of composing Haskeline with State and Exception monads in modern versions of mtl.
--
-- > type Repl a = HaskelineT IO a
--
-- The evaluator 'evalRepl' evaluates a 'HaskelineT' monad transformer by constructing a shell with several
-- custom functions and evaluating it inside of IO:
--
--   * Commands: Handled on ordinary input.
--
--   * Completions: Handled when tab key is pressed.
--
--   * Options: Handled when a command prefixed by a prefix character is entered.
--
--   * Command prefix character: Optional command prefix ( passing Nothing ignores the Options argument ).
--
--   * Banner: Text Displayed at initialization.
--
--   * Initializer: Run at initialization.
--
-- A simple evaluation function might simply echo the output back to the screen.
--
-- > -- Evaluation : handle each line user inputs
-- > cmd :: String -> Repl ()
-- > cmd input = liftIO $ print input
--
-- Several tab completion options are available, the most common is the 'WordCompleter' which completes on single
-- words separated by spaces from a list of matches. The internal logic can be whatever is required and can also
-- access a StateT instance to query application state.
--
-- > -- Tab Completion: return a completion for partial words entered
-- > completer :: Monad m => WordCompleter m
-- > completer n = do
-- >   let names = ["kirk", "spock", "mccoy"]
-- >   return $ filter (isPrefixOf n) names
--
-- Input which is prefixed by a colon (commands like \":type\" and \":help\") queries an association list of
-- functions which map to custom logic. The function takes a space-separated list of augments in it's first
-- argument. If the entire line is desired then the 'unwords' function can be used to concatenate.
--
-- > -- Commands
-- > help :: [String] -> Repl ()
-- > help args = liftIO $ print $ "Help: " ++ show args
-- >
-- > say :: [String] -> Repl ()
-- > say args = do
-- >   _ <- liftIO $ system $ "cowsay" ++ " " ++ (unwords args)
-- >   return ()
--
-- Now we need only map these functions to their commands.
--
-- > options :: [(String, [String] -> Repl ())]
-- > options = [
-- >     ("help", help)  -- :help
-- >   , ("say", say)    -- :say
-- >   ]
--
-- The banner function is simply an IO action that is called at the start of the shell.
--
-- > ini :: Repl ()
-- > ini = liftIO $ putStrLn "Welcome!"
--
-- Putting it all together we have a little shell.
--
-- > main :: IO ()
-- > main = evalRepl (pure ">>> ") cmd options (Just ':') (Word completer) ini
--
-- 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      = pure ">>> "
-- >   , command     = cmd
-- >   , options     = opts
-- >   , prefix      = Just ':'
-- >   , tabComplete = (Word0 completer)
-- >   , initialiser = 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
  ( -- * Repline Monad
    HaskelineT,
    runHaskelineT,

    -- * Toplevel
    evalRepl,
    ReplOpts (..),
    evalReplOpts,

    -- * Repline Types
    Cmd,
    Options,
    WordCompleter,
    LineCompleter,
    CompleterStyle (..),
    Command,

    -- * 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.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 {HaskelineT m a -> InputT m a
unHaskeline :: H.InputT m a}
  deriving
    ( Applicative (HaskelineT m)
a -> HaskelineT m a
Applicative (HaskelineT m)
-> (forall a b.
    HaskelineT m a -> (a -> HaskelineT m b) -> HaskelineT m b)
-> (forall a b. HaskelineT m a -> HaskelineT m b -> HaskelineT m b)
-> (forall a. a -> HaskelineT m a)
-> Monad (HaskelineT m)
HaskelineT m a -> (a -> HaskelineT m b) -> HaskelineT m b
HaskelineT m a -> HaskelineT m b -> HaskelineT m b
forall a. a -> HaskelineT m a
forall a b. HaskelineT m a -> HaskelineT m b -> HaskelineT m b
forall a b.
HaskelineT m a -> (a -> HaskelineT m b) -> HaskelineT m b
forall (m :: * -> *). Monad m => Applicative (HaskelineT m)
forall (m :: * -> *) a. Monad m => a -> HaskelineT m a
forall (m :: * -> *) a b.
Monad m =>
HaskelineT m a -> HaskelineT m b -> HaskelineT m b
forall (m :: * -> *) a b.
Monad m =>
HaskelineT m a -> (a -> HaskelineT m b) -> HaskelineT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> HaskelineT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> HaskelineT m a
>> :: HaskelineT m a -> HaskelineT m b -> HaskelineT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
HaskelineT m a -> HaskelineT m b -> HaskelineT m b
>>= :: HaskelineT m a -> (a -> HaskelineT m b) -> HaskelineT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
HaskelineT m a -> (a -> HaskelineT m b) -> HaskelineT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (HaskelineT m)
Monad,
      a -> HaskelineT m b -> HaskelineT m a
(a -> b) -> HaskelineT m a -> HaskelineT m b
(forall a b. (a -> b) -> HaskelineT m a -> HaskelineT m b)
-> (forall a b. a -> HaskelineT m b -> HaskelineT m a)
-> Functor (HaskelineT m)
forall a b. a -> HaskelineT m b -> HaskelineT m a
forall a b. (a -> b) -> HaskelineT m a -> HaskelineT m b
forall (m :: * -> *) a b.
Functor m =>
a -> HaskelineT m b -> HaskelineT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> HaskelineT m a -> HaskelineT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> HaskelineT m b -> HaskelineT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> HaskelineT m b -> HaskelineT m a
fmap :: (a -> b) -> HaskelineT m a -> HaskelineT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> HaskelineT m a -> HaskelineT m b
Functor,
      Functor (HaskelineT m)
a -> HaskelineT m a
Functor (HaskelineT m)
-> (forall a. a -> HaskelineT m a)
-> (forall a b.
    HaskelineT m (a -> b) -> HaskelineT m a -> HaskelineT m b)
-> (forall a b c.
    (a -> b -> c)
    -> HaskelineT m a -> HaskelineT m b -> HaskelineT m c)
-> (forall a b. HaskelineT m a -> HaskelineT m b -> HaskelineT m b)
-> (forall a b. HaskelineT m a -> HaskelineT m b -> HaskelineT m a)
-> Applicative (HaskelineT m)
HaskelineT m a -> HaskelineT m b -> HaskelineT m b
HaskelineT m a -> HaskelineT m b -> HaskelineT m a
HaskelineT m (a -> b) -> HaskelineT m a -> HaskelineT m b
(a -> b -> c) -> HaskelineT m a -> HaskelineT m b -> HaskelineT m c
forall a. a -> HaskelineT m a
forall a b. HaskelineT m a -> HaskelineT m b -> HaskelineT m a
forall a b. HaskelineT m a -> HaskelineT m b -> HaskelineT m b
forall a b.
HaskelineT m (a -> b) -> HaskelineT m a -> HaskelineT m b
forall a b c.
(a -> b -> c) -> HaskelineT m a -> HaskelineT m b -> HaskelineT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (HaskelineT m)
forall (m :: * -> *) a. Applicative m => a -> HaskelineT m a
forall (m :: * -> *) a b.
Applicative m =>
HaskelineT m a -> HaskelineT m b -> HaskelineT m a
forall (m :: * -> *) a b.
Applicative m =>
HaskelineT m a -> HaskelineT m b -> HaskelineT m b
forall (m :: * -> *) a b.
Applicative m =>
HaskelineT m (a -> b) -> HaskelineT m a -> HaskelineT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> HaskelineT m a -> HaskelineT m b -> HaskelineT m c
<* :: HaskelineT m a -> HaskelineT m b -> HaskelineT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
HaskelineT m a -> HaskelineT m b -> HaskelineT m a
*> :: HaskelineT m a -> HaskelineT m b -> HaskelineT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
HaskelineT m a -> HaskelineT m b -> HaskelineT m b
liftA2 :: (a -> b -> c) -> HaskelineT m a -> HaskelineT m b -> HaskelineT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> HaskelineT m a -> HaskelineT m b -> HaskelineT m c
<*> :: HaskelineT m (a -> b) -> HaskelineT m a -> HaskelineT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
HaskelineT m (a -> b) -> HaskelineT m a -> HaskelineT m b
pure :: a -> HaskelineT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> HaskelineT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (HaskelineT m)
Applicative,
      Monad (HaskelineT m)
Monad (HaskelineT m)
-> (forall a. IO a -> HaskelineT m a) -> MonadIO (HaskelineT m)
IO a -> HaskelineT m a
forall a. IO a -> HaskelineT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (HaskelineT m)
forall (m :: * -> *) a. MonadIO m => IO a -> HaskelineT m a
liftIO :: IO a -> HaskelineT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> HaskelineT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (HaskelineT m)
MonadIO,
      Monad (HaskelineT m)
Monad (HaskelineT m)
-> (forall a. (a -> HaskelineT m a) -> HaskelineT m a)
-> MonadFix (HaskelineT m)
(a -> HaskelineT m a) -> HaskelineT m a
forall a. (a -> HaskelineT m a) -> HaskelineT m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall (m :: * -> *). MonadFix m => Monad (HaskelineT m)
forall (m :: * -> *) a.
MonadFix m =>
(a -> HaskelineT m a) -> HaskelineT m a
mfix :: (a -> HaskelineT m a) -> HaskelineT m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> HaskelineT m a) -> HaskelineT m a
$cp1MonadFix :: forall (m :: * -> *). MonadFix m => Monad (HaskelineT m)
MonadFix,
      m a -> HaskelineT m a
(forall (m :: * -> *) a. Monad m => m a -> HaskelineT m a)
-> MonadTrans HaskelineT
forall (m :: * -> *) a. Monad m => m a -> HaskelineT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> HaskelineT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> HaskelineT m a
MonadTrans,
      MonadCatch (HaskelineT m)
String -> HaskelineT m (Maybe Char)
String -> HaskelineT m (Maybe String)
String -> HaskelineT m ()
MonadCatch (HaskelineT m)
-> (String -> HaskelineT m (Maybe String))
-> (String -> HaskelineT m (Maybe Char))
-> (String -> HaskelineT m ())
-> (String -> HaskelineT m ())
-> MonadHaskeline (HaskelineT m)
forall (m :: * -> *).
MonadCatch m
-> (String -> m (Maybe String))
-> (String -> m (Maybe Char))
-> (String -> m ())
-> (String -> m ())
-> MonadHaskeline m
forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
MonadCatch (HaskelineT m)
forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
String -> HaskelineT m (Maybe Char)
forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
String -> HaskelineT m (Maybe String)
forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
String -> HaskelineT m ()
outputStrLn :: String -> HaskelineT m ()
$coutputStrLn :: forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
String -> HaskelineT m ()
outputStr :: String -> HaskelineT m ()
$coutputStr :: forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
String -> HaskelineT m ()
getInputChar :: String -> HaskelineT m (Maybe Char)
$cgetInputChar :: forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
String -> HaskelineT m (Maybe Char)
getInputLine :: String -> HaskelineT m (Maybe String)
$cgetInputLine :: forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
String -> HaskelineT m (Maybe String)
$cp1MonadHaskeline :: forall (m :: * -> *).
(MonadMask m, MonadIO m) =>
MonadCatch (HaskelineT m)
MonadHaskeline,
      Monad (HaskelineT m)
e -> HaskelineT m a
Monad (HaskelineT m)
-> (forall e a. Exception e => e -> HaskelineT m a)
-> MonadThrow (HaskelineT m)
forall e a. Exception e => e -> HaskelineT m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (HaskelineT m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> HaskelineT m a
throwM :: e -> HaskelineT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> HaskelineT m a
$cp1MonadThrow :: forall (m :: * -> *). MonadThrow m => Monad (HaskelineT m)
MonadThrow,
      MonadThrow (HaskelineT m)
MonadThrow (HaskelineT m)
-> (forall e a.
    Exception e =>
    HaskelineT m a -> (e -> HaskelineT m a) -> HaskelineT m a)
-> MonadCatch (HaskelineT m)
HaskelineT m a -> (e -> HaskelineT m a) -> HaskelineT m a
forall e a.
Exception e =>
HaskelineT m a -> (e -> HaskelineT m a) -> HaskelineT m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: * -> *). MonadCatch m => MonadThrow (HaskelineT m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
HaskelineT m a -> (e -> HaskelineT m a) -> HaskelineT m a
catch :: HaskelineT m a -> (e -> HaskelineT m a) -> HaskelineT m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
HaskelineT m a -> (e -> HaskelineT m a) -> HaskelineT m a
$cp1MonadCatch :: forall (m :: * -> *). MonadCatch m => MonadThrow (HaskelineT m)
MonadCatch,
      MonadCatch (HaskelineT m)
MonadCatch (HaskelineT m)
-> (forall b.
    ((forall a. HaskelineT m a -> HaskelineT m a) -> HaskelineT m b)
    -> HaskelineT m b)
-> (forall b.
    ((forall a. HaskelineT m a -> HaskelineT m a) -> HaskelineT m b)
    -> HaskelineT m b)
-> (forall a b c.
    HaskelineT m a
    -> (a -> ExitCase b -> HaskelineT m c)
    -> (a -> HaskelineT m b)
    -> HaskelineT m (b, c))
-> MonadMask (HaskelineT m)
HaskelineT m a
-> (a -> ExitCase b -> HaskelineT m c)
-> (a -> HaskelineT m b)
-> HaskelineT m (b, c)
((forall a. HaskelineT m a -> HaskelineT m a) -> HaskelineT m b)
-> HaskelineT m b
((forall a. HaskelineT m a -> HaskelineT m a) -> HaskelineT m b)
-> HaskelineT m b
forall b.
((forall a. HaskelineT m a -> HaskelineT m a) -> HaskelineT m b)
-> HaskelineT m b
forall a b c.
HaskelineT m a
-> (a -> ExitCase b -> HaskelineT m c)
-> (a -> HaskelineT m b)
-> HaskelineT m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
forall (m :: * -> *). MonadMask m => MonadCatch (HaskelineT m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. HaskelineT m a -> HaskelineT m a) -> HaskelineT m b)
-> HaskelineT m b
forall (m :: * -> *) a b c.
MonadMask m =>
HaskelineT m a
-> (a -> ExitCase b -> HaskelineT m c)
-> (a -> HaskelineT m b)
-> HaskelineT m (b, c)
generalBracket :: HaskelineT m a
-> (a -> ExitCase b -> HaskelineT m c)
-> (a -> HaskelineT m b)
-> HaskelineT m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
HaskelineT m a
-> (a -> ExitCase b -> HaskelineT m c)
-> (a -> HaskelineT m b)
-> HaskelineT m (b, c)
uninterruptibleMask :: ((forall a. HaskelineT m a -> HaskelineT m a) -> HaskelineT m b)
-> HaskelineT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. HaskelineT m a -> HaskelineT m a) -> HaskelineT m b)
-> HaskelineT m b
mask :: ((forall a. HaskelineT m a -> HaskelineT m a) -> HaskelineT m b)
-> HaskelineT m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. HaskelineT m a -> HaskelineT m a) -> HaskelineT m b)
-> HaskelineT m b
$cp1MonadMask :: forall (m :: * -> *). MonadMask m => MonadCatch (HaskelineT m)
MonadMask
    )

-- | Run HaskelineT monad
runHaskelineT :: (MonadMask m, MonadIO m) => H.Settings m -> HaskelineT m a -> m a
runHaskelineT :: Settings m -> HaskelineT m a -> m a
runHaskelineT Settings m
s HaskelineT m a
m = Settings m -> InputT m a -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Settings m -> InputT m a -> m a
H.runInputT Settings m
s (InputT m a -> InputT m a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
InputT m a -> InputT m a
H.withInterrupt (HaskelineT m a -> InputT m a
forall (m :: * -> *) a. HaskelineT m a -> InputT m a
unHaskeline HaskelineT m a
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 :: String -> InputT m (Maybe String)
getInputLine = String -> InputT m (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
H.getInputLine
  getInputChar :: String -> InputT m (Maybe Char)
getInputChar = String -> InputT m (Maybe Char)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe Char)
H.getInputChar
  outputStr :: String -> InputT m ()
outputStr = String -> InputT m ()
forall (m :: * -> *). MonadIO m => String -> InputT m ()
H.outputStr
  outputStrLn :: String -> InputT m ()
outputStrLn = String -> InputT m ()
forall (m :: * -> *). MonadIO m => String -> InputT m ()
H.outputStrLn

instance Fail.MonadFail m => Fail.MonadFail (HaskelineT m) where
  fail :: String -> HaskelineT m a
fail = m a -> HaskelineT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> HaskelineT m a)
-> (String -> m a) -> String -> HaskelineT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail

instance MonadState s m => MonadState s (HaskelineT m) where
  get :: HaskelineT m s
get = m s -> HaskelineT m s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
  put :: s -> HaskelineT m ()
put = m () -> HaskelineT m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> HaskelineT m ()) -> (s -> m ()) -> s -> HaskelineT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put

instance MonadReader r m => MonadReader r (HaskelineT m) where
  ask :: HaskelineT m r
ask = m r -> HaskelineT m r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: (r -> r) -> HaskelineT m a -> HaskelineT m a
local r -> r
f (HaskelineT InputT m a
m) = InputT m a -> HaskelineT m a
forall (m :: * -> *) a. InputT m a -> HaskelineT m a
HaskelineT (InputT m a -> HaskelineT m a) -> InputT m a -> HaskelineT m a
forall a b. (a -> b) -> a -> b
$ (forall b. m b -> m b) -> InputT m a -> InputT m a
forall (m :: * -> *) a.
(forall b. m b -> m b) -> InputT m a -> InputT m a
H.mapInputT ((r -> r) -> m b -> m b
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f) InputT m a
m

instance (MonadHaskeline m) => MonadHaskeline (StateT s m) where
  getInputLine :: String -> StateT s m (Maybe String)
getInputLine = m (Maybe String) -> StateT s m (Maybe String)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe String) -> StateT s m (Maybe String))
-> (String -> m (Maybe String))
-> String
-> StateT s m (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m (Maybe String)
forall (m :: * -> *).
MonadHaskeline m =>
String -> m (Maybe String)
getInputLine
  getInputChar :: String -> StateT s m (Maybe Char)
getInputChar = m (Maybe Char) -> StateT s m (Maybe Char)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe Char) -> StateT s m (Maybe Char))
-> (String -> m (Maybe Char)) -> String -> StateT s m (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m (Maybe Char)
forall (m :: * -> *). MonadHaskeline m => String -> m (Maybe Char)
getInputChar
  outputStr :: String -> StateT s m ()
outputStr = m () -> StateT s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ())
-> (String -> m ()) -> String -> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m ()
forall (m :: * -> *). MonadHaskeline m => String -> m ()
outputStr
  outputStrLn :: String -> StateT s m ()
outputStrLn = m () -> StateT s m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ())
-> (String -> m ()) -> String -> StateT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m ()
forall (m :: * -> *). MonadHaskeline m => String -> m ()
outputStrLn

-------------------------------------------------------------------------------
-- Repl
-------------------------------------------------------------------------------

-- | Command function synonym
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 m a -> HaskelineT m a
tryAction (HaskelineT InputT m a
f) = InputT m a -> HaskelineT m a
forall (m :: * -> *) a. InputT m a -> HaskelineT m a
HaskelineT (InputT m a -> InputT m a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
InputT m a -> InputT m a
H.withInterrupt InputT m a
loop)
  where
    loop :: InputT m a
loop = (Interrupt -> InputT m a) -> InputT m a -> InputT m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle (\Interrupt
H.Interrupt -> InputT m a
loop) InputT m a
f

-- | Catch all toplevel failures.
dontCrash :: (MonadIO m, MonadCatch m) => m () -> m ()
dontCrash :: m () -> m ()
dontCrash m ()
m = m () -> (SomeException -> m ()) -> m ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch m ()
m (\e :: SomeException
e@SomeException {} -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (SomeException -> IO ()
forall a. Show a => a -> IO ()
print SomeException
e))

-- | Abort the current REPL loop, and continue.
abort :: MonadThrow m => HaskelineT m a
abort :: HaskelineT m a
abort = Interrupt -> HaskelineT m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM Interrupt
H.Interrupt

-- | Completion loop.
replLoop ::
  (Functor m, MonadMask m, MonadIO m) =>
  -- | banner function
  HaskelineT m String ->
  -- | command function
  Command (HaskelineT m) ->
  -- | options function
  Options (HaskelineT m) ->
  -- | options prefix
  Maybe Char ->
  HaskelineT m ()
replLoop :: HaskelineT m String
-> Command (HaskelineT m)
-> Options (HaskelineT m)
-> Maybe Char
-> HaskelineT m ()
replLoop HaskelineT m String
banner Command (HaskelineT m)
cmdM Options (HaskelineT m)
opts Maybe Char
optsPrefix = HaskelineT m ()
loop
  where
    loop :: HaskelineT m ()
loop = do
      String
prefix <- HaskelineT m String
banner
      Maybe String
minput <- HaskelineT m (Maybe String)
-> HaskelineT m (Maybe String) -> HaskelineT m (Maybe String)
forall (m :: * -> *) a. MonadMask m => m a -> m a -> m a
H.handleInterrupt (Maybe String -> HaskelineT m (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
"")) (HaskelineT m (Maybe String) -> HaskelineT m (Maybe String))
-> HaskelineT m (Maybe String) -> HaskelineT m (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> HaskelineT m (Maybe String)
forall (m :: * -> *).
MonadHaskeline m =>
String -> m (Maybe String)
getInputLine String
prefix
      case Maybe String
minput of
        Maybe String
Nothing -> Command (HaskelineT m)
forall (m :: * -> *). MonadHaskeline m => String -> m ()
outputStrLn String
"Goodbye."
        Just String
"" -> HaskelineT m ()
loop
        Just (Char
prefix_ : String
cmds)
          | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cmds -> Command (HaskelineT m)
handleInput [Char
prefix_] HaskelineT m () -> HaskelineT m () -> HaskelineT m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HaskelineT m ()
loop
          | Char -> Maybe Char
forall a. a -> Maybe a
Just Char
prefix_ Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Char
optsPrefix ->
            case String -> [String]
words String
cmds of
              [] -> HaskelineT m ()
loop
              (String
cmd : [String]
args) -> do
                let optAction :: HaskelineT m ()
optAction = String -> Options (HaskelineT m) -> [String] -> HaskelineT m ()
forall (m :: * -> *).
MonadHaskeline m =>
String -> Options m -> [String] -> m ()
optMatcher String
cmd Options (HaskelineT m)
opts [String]
args
                Maybe ()
result <- HaskelineT m (Maybe ())
-> HaskelineT m (Maybe ()) -> HaskelineT m (Maybe ())
forall (m :: * -> *) a. MonadMask m => m a -> m a -> m a
H.handleInterrupt (Maybe () -> HaskelineT m (Maybe ())
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ()
forall a. Maybe a
Nothing) (HaskelineT m (Maybe ()) -> HaskelineT m (Maybe ()))
-> HaskelineT m (Maybe ()) -> HaskelineT m (Maybe ())
forall a b. (a -> b) -> a -> b
$ () -> Maybe ()
forall a. a -> Maybe a
Just (() -> Maybe ()) -> HaskelineT m () -> HaskelineT m (Maybe ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HaskelineT m ()
optAction
                HaskelineT m ()
-> (() -> HaskelineT m ()) -> Maybe () -> HaskelineT m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HaskelineT m ()
forall (m :: * -> *). Monad m => m ()
exit (HaskelineT m () -> () -> HaskelineT m ()
forall a b. a -> b -> a
const HaskelineT m ()
loop) Maybe ()
result
        Just String
input -> do
          Command (HaskelineT m)
handleInput String
input
          HaskelineT m ()
loop
    handleInput :: Command (HaskelineT m)
handleInput String
input = HaskelineT m () -> HaskelineT m () -> HaskelineT m ()
forall (m :: * -> *) a. MonadMask m => m a -> m a -> m a
H.handleInterrupt HaskelineT m ()
forall (m :: * -> *). Monad m => m ()
exit (HaskelineT m () -> HaskelineT m ())
-> HaskelineT m () -> HaskelineT m ()
forall a b. (a -> b) -> a -> b
$ Command (HaskelineT m)
cmdM String
input
    exit :: m ()
exit = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Match the options.
optMatcher :: MonadHaskeline m => String -> Options m -> [String] -> m ()
optMatcher :: String -> Options m -> [String] -> m ()
optMatcher String
s [] [String]
_ = String -> m ()
forall (m :: * -> *). MonadHaskeline m => String -> m ()
outputStrLn (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"No such command :" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
optMatcher String
s ((String
x, [String] -> m ()
m) : Options m
xs) [String]
args
  | String
s String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x = [String] -> m ()
m [String]
args
  | Bool
otherwise = String -> Options m -> [String] -> m ()
forall (m :: * -> *).
MonadHaskeline m =>
String -> Options m -> [String] -> m ()
optMatcher String
s Options m
xs [String]
args

-------------------------------------------------------------------------------
-- Toplevel
-------------------------------------------------------------------------------

-- | REPL Options datatype
data ReplOpts m
  = ReplOpts
      { -- | Banner
        ReplOpts m -> HaskelineT m String
banner :: HaskelineT m String,
        -- | Command function
        ReplOpts m -> Command (HaskelineT m)
command :: Command (HaskelineT m),
        -- | Options list and commands
        ReplOpts m -> Options (HaskelineT m)
options :: Options (HaskelineT m),
        -- | Optional command prefix ( passing Nothing ignores the Options argument )
        ReplOpts m -> Maybe Char
prefix :: Maybe Char,
        -- | Tab completion function
        ReplOpts m -> CompleterStyle m
tabComplete :: CompleterStyle m,
        -- | Initialiser
        ReplOpts m -> HaskelineT m ()
initialiser :: HaskelineT m ()
      }

-- | Evaluate the REPL logic into a MonadCatch context from the ReplOpts
-- configuration.
evalReplOpts :: (MonadMask m, MonadIO m) => ReplOpts m -> m ()
evalReplOpts :: ReplOpts m -> m ()
evalReplOpts ReplOpts {Options (HaskelineT m)
Maybe Char
CompleterStyle m
HaskelineT m String
HaskelineT m ()
Command (HaskelineT m)
initialiser :: HaskelineT m ()
tabComplete :: CompleterStyle m
prefix :: Maybe Char
options :: Options (HaskelineT m)
command :: Command (HaskelineT m)
banner :: HaskelineT m String
initialiser :: forall (m :: * -> *). ReplOpts m -> HaskelineT m ()
tabComplete :: forall (m :: * -> *). ReplOpts m -> CompleterStyle m
prefix :: forall (m :: * -> *). ReplOpts m -> Maybe Char
options :: forall (m :: * -> *). ReplOpts m -> Options (HaskelineT m)
command :: forall (m :: * -> *). ReplOpts m -> Command (HaskelineT m)
banner :: forall (m :: * -> *). ReplOpts m -> HaskelineT m String
..} =
  HaskelineT m String
-> Command (HaskelineT m)
-> Options (HaskelineT m)
-> Maybe Char
-> CompleterStyle m
-> HaskelineT m ()
-> m ()
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
HaskelineT m String
-> Command (HaskelineT m)
-> Options (HaskelineT m)
-> Maybe Char
-> CompleterStyle m
-> HaskelineT m a
-> m ()
evalRepl
    HaskelineT m String
banner
    Command (HaskelineT m)
command
    Options (HaskelineT m)
options
    Maybe Char
prefix
    CompleterStyle m
tabComplete
    HaskelineT m ()
initialiser

-- | Evaluate the REPL logic into a MonadCatch context.
evalRepl ::
  (MonadMask m, MonadIO m) => -- Terminal monad ( often IO ).

  -- | Banner
  HaskelineT m String ->
  -- | Command function
  Command (HaskelineT m) ->
  -- | Options list and commands
  Options (HaskelineT m) ->
  -- | Optional command prefix ( passing Nothing ignores the Options argument )
  Maybe Char ->
  -- | Tab completion function
  CompleterStyle m ->
  -- | Initialiser
  HaskelineT m a ->
  m ()
evalRepl :: HaskelineT m String
-> Command (HaskelineT m)
-> Options (HaskelineT m)
-> Maybe Char
-> CompleterStyle m
-> HaskelineT m a
-> m ()
evalRepl HaskelineT m String
banner Command (HaskelineT m)
cmd Options (HaskelineT m)
opts Maybe Char
optsPrefix CompleterStyle m
comp HaskelineT m a
initz = Settings m -> HaskelineT m () -> m ()
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
Settings m -> HaskelineT m a -> m a
runHaskelineT Settings m
_readline (HaskelineT m a
initz HaskelineT m a -> HaskelineT m () -> HaskelineT m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HaskelineT m ()
monad)
  where
    monad :: HaskelineT m ()
monad = HaskelineT m String
-> Command (HaskelineT m)
-> Options (HaskelineT m)
-> Maybe Char
-> HaskelineT m ()
forall (m :: * -> *).
(Functor m, MonadMask m, MonadIO m) =>
HaskelineT m String
-> Command (HaskelineT m)
-> Options (HaskelineT m)
-> Maybe Char
-> HaskelineT m ()
replLoop HaskelineT m String
banner Command (HaskelineT m)
cmd Options (HaskelineT m)
opts Maybe Char
optsPrefix
    _readline :: Settings m
_readline =
      Settings :: forall (m :: * -> *).
CompletionFunc m -> Maybe String -> Bool -> Settings m
H.Settings
        { complete :: CompletionFunc m
H.complete = CompleterStyle m -> CompletionFunc m
forall (m :: * -> *).
MonadIO m =>
CompleterStyle m -> CompletionFunc m
mkCompleter CompleterStyle m
comp,
          historyFile :: Maybe String
H.historyFile = String -> Maybe String
forall a. a -> Maybe a
Just String
".history",
          autoAddHistory :: Bool
H.autoAddHistory = Bool
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 :: CompleterStyle m -> CompletionFunc m
mkCompleter (Word WordCompleter m
f) = Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
forall (m :: * -> *).
Monad m =>
Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
completeWord (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\\') String
" \t()[]" (WordCompleter m -> String -> m [Completion]
forall (m :: * -> *).
Monad m =>
(String -> m [String]) -> String -> m [Completion]
_simpleComplete WordCompleter m
f)
mkCompleter (Word0 WordCompleter m
f) = Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
forall (m :: * -> *).
Monad m =>
Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
completeWord (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\\') String
" \t()[]" (WordCompleter m -> String -> m [Completion]
forall (m :: * -> *).
Monad m =>
(String -> m [String]) -> String -> m [Completion]
_simpleCompleteNoSpace WordCompleter m
f)
mkCompleter (Cursor LineCompleter m
f) = Maybe Char -> String -> LineCompleter m -> CompletionFunc m
forall (m :: * -> *).
Monad m =>
Maybe Char
-> String
-> (String -> String -> m [Completion])
-> CompletionFunc m
completeWordWithPrev (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\\') String
" \t()[]" (LineCompleter m -> LineCompleter m
forall (m :: * -> *). LineCompleter m -> LineCompleter m
unRev0 LineCompleter m
f)
mkCompleter CompleterStyle m
File = CompletionFunc m
forall (m :: * -> *). MonadIO m => CompletionFunc m
completeFilename
mkCompleter (Prefix CompletionFunc m
def [(String, CompletionFunc m)]
opts) = [(String, CompletionFunc m)]
-> CompletionFunc m -> CompletionFunc m
forall (m :: * -> *).
Monad m =>
[(String, CompletionFunc m)]
-> CompletionFunc m -> CompletionFunc m
runMatcher [(String, CompletionFunc m)]
opts CompletionFunc m
def
mkCompleter (Combine CompleterStyle m
a CompleterStyle m
b) = CompletionFunc m -> CompletionFunc m -> CompletionFunc m
forall (m :: * -> *).
Monad m =>
CompletionFunc m -> CompletionFunc m -> CompletionFunc m
fallbackCompletion (CompleterStyle m -> CompletionFunc m
forall (m :: * -> *).
MonadIO m =>
CompleterStyle m -> CompletionFunc m
mkCompleter CompleterStyle m
a) (CompleterStyle m -> CompletionFunc m
forall (m :: * -> *).
MonadIO m =>
CompleterStyle m -> CompletionFunc m
mkCompleter CompleterStyle m
b)
mkCompleter (Custom CompletionFunc m
f) = CompletionFunc m
f

-- haskeline takes the first argument as the reversed string, don't know why
unRev0 :: LineCompleter m -> LineCompleter m
unRev0 :: LineCompleter m -> LineCompleter m
unRev0 LineCompleter m
f String
x = LineCompleter m
f (String -> String
forall a. [a] -> [a]
reverse String
x)

-- | Trim completion
trimComplete :: String -> Completion -> Completion
trimComplete :: String -> Completion -> Completion
trimComplete String
prefix (Completion String
a String
b Bool
c) = String -> String -> Bool -> Completion
Completion (Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
prefix) String
a) String
b Bool
c

_simpleComplete :: (Monad m) => (String -> m [String]) -> String -> m [Completion]
_simpleComplete :: (String -> m [String]) -> String -> m [Completion]
_simpleComplete String -> m [String]
f String
word = (String -> Completion) -> [String] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map String -> Completion
simpleCompletion ([String] -> [Completion]) -> m [String] -> m [Completion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m [String]
f String
word

_simpleCompleteNoSpace :: (Monad m) => (String -> m [String]) -> String -> m [Completion]
_simpleCompleteNoSpace :: (String -> m [String]) -> String -> m [Completion]
_simpleCompleteNoSpace String -> m [String]
f String
word = (String -> Completion) -> [String] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map String -> Completion
completionNoSpace ([String] -> [Completion]) -> m [String] -> m [Completion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m [String]
f String
word

completionNoSpace :: String -> Completion
completionNoSpace :: String -> Completion
completionNoSpace String
str = String -> String -> Bool -> Completion
Completion String
str String
str Bool
False

-- | Word completer function
wordCompleter :: Monad m => WordCompleter m -> CompletionFunc m
wordCompleter :: WordCompleter m -> CompletionFunc m
wordCompleter WordCompleter m
f (String
start, String
n) = Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
forall (m :: * -> *).
Monad m =>
Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
completeWord (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\\') String
" \t()[]" (WordCompleter m -> String -> m [Completion]
forall (m :: * -> *).
Monad m =>
(String -> m [String]) -> String -> m [Completion]
_simpleComplete WordCompleter m
f) (String
start, String
n)

-- | List completer function
listCompleter :: Monad m => [String] -> CompletionFunc m
listCompleter :: [String] -> CompletionFunc m
listCompleter [String]
names (String
start, String
n) = Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
forall (m :: * -> *).
Monad m =>
Maybe Char
-> String -> (String -> m [Completion]) -> CompletionFunc m
completeWord (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\\') String
" \t()[]" ((String -> m [String]) -> String -> m [Completion]
forall (m :: * -> *).
Monad m =>
(String -> m [String]) -> String -> m [Completion]
_simpleComplete ([String] -> String -> m [String]
forall (m :: * -> *). Monad m => [String] -> WordCompleter m
completeAux [String]
names)) (String
start, String
n)

-- | List word completer
listWordCompleter :: Monad m => [String] -> WordCompleter m
listWordCompleter :: [String] -> WordCompleter m
listWordCompleter = [String] -> WordCompleter m
forall (m :: * -> *). Monad m => [String] -> WordCompleter m
completeAux

-- | File completer function
fileCompleter :: MonadIO m => CompletionFunc m
fileCompleter :: CompletionFunc m
fileCompleter = CompletionFunc m
forall (m :: * -> *). MonadIO m => CompletionFunc m
completeFilename

completeAux :: Monad m => [String] -> WordCompleter m
completeAux :: [String] -> WordCompleter m
completeAux [String]
names String
n = [String] -> m [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> m [String]) -> [String] -> m [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
n) [String]
names

completeMatcher ::
  (Monad m) =>
  CompletionFunc m ->
  String ->
  [(String, CompletionFunc m)] ->
  CompletionFunc m
completeMatcher :: CompletionFunc m
-> String -> [(String, CompletionFunc m)] -> CompletionFunc m
completeMatcher CompletionFunc m
def String
_ [] (String, String)
args = CompletionFunc m
def (String, String)
args
completeMatcher CompletionFunc m
def [] [(String, CompletionFunc m)]
_ (String, String)
args = CompletionFunc m
def (String, String)
args
completeMatcher CompletionFunc m
def String
s ((String
x, CompletionFunc m
f) : [(String, CompletionFunc m)]
xs) (String, String)
args
  | String
x String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
s = CompletionFunc m
f (String, String)
args
  | Bool
otherwise = CompletionFunc m
-> String -> [(String, CompletionFunc m)] -> CompletionFunc m
forall (m :: * -> *).
Monad m =>
CompletionFunc m
-> String -> [(String, CompletionFunc m)] -> CompletionFunc m
completeMatcher CompletionFunc m
def String
s [(String, CompletionFunc m)]
xs (String, String)
args

-- | Return a completion function a line fragment
runMatcher ::
  Monad m =>
  [(String, CompletionFunc m)] ->
  CompletionFunc m ->
  CompletionFunc m
runMatcher :: [(String, CompletionFunc m)]
-> CompletionFunc m -> CompletionFunc m
runMatcher [(String, CompletionFunc m)]
opts CompletionFunc m
def (String
start, String
n) =
  CompletionFunc m
-> String -> [(String, CompletionFunc m)] -> CompletionFunc m
forall (m :: * -> *).
Monad m =>
CompletionFunc m
-> String -> [(String, CompletionFunc m)] -> CompletionFunc m
completeMatcher CompletionFunc m
def (String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. [a] -> [a]
reverse String
start) [(String, CompletionFunc m)]
opts (String
start, String
n)