{-# 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 <Ctrl-D> to exit and commit the multi-line input). Passing Nothing disables multi-line input support.
--
--   * Banner: Text Displayed at initialisation. It takes an argument so it can take into account if the current line is part of a multi-line input.
--
--   * Initialiser: Run at initialisation.
--
--   * Finaliser: Run on <Ctrl-D>, it can be used to output a custom exit message or to choose whether to exit or not depending on the application state
--
-- A simple evaluation function might simply echo the output back to the screen.
--
-- > -- Evaluation : handle each line user inputs
-- > cmd :: String -> Repl ()
-- > cmd input = liftIO $ print input
--
-- Several tab completion options are available, the most common is the 'WordCompleter' which completes on single
-- words separated by spaces from a list of matches. The internal logic can be whatever is required and can also
-- access a StateT instance to query application state.
--
-- > -- Tab Completion: return a completion for partial words entered
-- > completer :: Monad m => WordCompleter m
-- > completer n = do
-- >   let names = ["kirk", "spock", "mccoy"]
-- >   return $ filter (isPrefixOf n) names
--
-- Input which is prefixed by a colon (commands like \":type\" and \":help\") queries an association list of
-- functions which map to custom logic. The function takes a space-separated list of augments in it's first
-- argument. If the entire line is desired then the 'unwords' function can be used to concatenate.
--
-- > -- Commands
-- > help :: [String] -> Repl ()
-- > help args = liftIO $ print $ "Help: " ++ show args
-- >
-- > say :: String -> Repl ()
-- > say arg = do
-- >   _ <- liftIO $ callCommand $ "cowsay" ++ " " ++ arg
-- >   return ()
--
-- (You may need the following import in pull `callCommand` into scope)
--
-- > import System.Process (callCommand)
--
-- Now we need only map these functions to their commands.
--
-- > options :: Options (HaskelineT IO)
-- > options = [
-- >     ("help", help . words)  -- :help
-- >   , ("say", say)            -- :say
-- >   ]
--
-- The initialiser function is simply an IO action that is called at the start of the shell.
--
-- > ini :: Repl ()
-- > ini = liftIO $ putStrLn "Welcome!"
--
-- The finaliser function is an IO action that is called at the end of the shell.
--
-- > final :: Repl ExitDecision
-- > final = do
-- >   liftIO $ putStrLn "Goodbye!"
-- >   return Exit
--
-- Putting it all together we have a little shell.
--
-- > main :: IO ()
-- > main = evalRepl (const . pure $ ">>> ") cmd options (Just ':') (Just "paste") (Word completer) ini final

--
-- Alternatively instead of initialising the repl from position arguments you
-- can pass the 'ReplOpts' record with explicitly named arguments.
--
-- > main_alt :: IO ()
-- > main_alt = evalReplOpts $ ReplOpts
-- >   { banner           = const (pure ">>> ")
-- >   , command          = cmd
-- >   , options          = opts
-- >   , prefix           = Just ':'
-- >   , multilineCommand = Nothing
-- >   , tabComplete      = (Word0 completer)
-- >   , initialiser      = ini
-- >   , finaliser        = final
-- >   }
--
-- Putting this in a file we can test out our cow-trek shell.
--
-- > $ runhaskell Main.hs
-- > Welcome!
-- > >>> <TAB>
-- > kirk spock mccoy
-- >
-- > >>> k<TAB>
-- > kirk
-- >
-- > >>> spam
-- > "spam"
-- >
-- > >>> :say Hello Haskell
-- >  _______________
-- > < Hello Haskell >
-- >  ---------------
-- >         \   ^__^
-- >          \  (oo)\_______
-- >             (__)\       )\/\
-- >                 ||----w |
-- >                 ||     ||
--
-- See <https://github.com/sdiehl/repline> for more examples.
module System.Console.Repline
  ( -- * Repline Monad
    HaskelineT,
    runHaskelineT,
    MonadHaskeline,

    -- * 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 {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
--
-- 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 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)
  => (MultiLine -> HaskelineT m String) -- ^ Banner function
  -> Command (HaskelineT m) -- ^ Command function
  -> Options (HaskelineT m) -- ^ options function
  -> Maybe Char -- ^ options prefix
  -> Maybe String -- ^ multi-line command
  -> HaskelineT m ExitDecision -- ^ Finaliser ( runs on <Ctrl-D> )
  -> HaskelineT m ()
replLoop :: (MultiLine -> HaskelineT m String)
-> Command (HaskelineT m)
-> Options (HaskelineT m)
-> Maybe Char
-> Maybe String
-> HaskelineT m ExitDecision
-> HaskelineT m ()
replLoop MultiLine -> HaskelineT m String
banner Command (HaskelineT m)
cmdM Options (HaskelineT m)
opts Maybe Char
optsPrefix Maybe String
multiCommand HaskelineT m ExitDecision
finalz = HaskelineT m ()
loop
  where
    loop :: HaskelineT m ()
loop = do
      String
prefix <- MultiLine -> HaskelineT m String
banner MultiLine
SingleLine
      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
      Maybe String -> HaskelineT m ()
handleCommands Maybe String
minput
    handleCommands :: Maybe String -> HaskelineT m ()
handleCommands Maybe String
minput =
      case Maybe String
minput of
        Maybe String
Nothing ->
          HaskelineT m ExitDecision
finalz HaskelineT m ExitDecision
-> (ExitDecision -> HaskelineT m ()) -> HaskelineT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            ExitDecision
Continue -> HaskelineT m ()
loop
            ExitDecision
Exit -> HaskelineT m ()
forall (m :: * -> *). Monad m => m ()
exit
        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]
_)
                | String -> Maybe String
forall a. a -> Maybe a
Just String
cmd Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe String
multiCommand -> do
                  Command (HaskelineT m)
forall (m :: * -> *). MonadHaskeline m => String -> m ()
outputStrLn String
"-- Entering multi-line mode. Press <Ctrl-D> to finish."
                  [String] -> HaskelineT m ()
loopMultiLine []
              (String
cmd : [String]
_) -> do
                let -- If there are any arguments, cmd is followed by a
                    -- whitespace character (space, newline, ...)
                    arguments :: String
arguments = Int -> String -> String
forall a. Int -> [a] -> [a]
drop (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
cmd) String
cmds
                let optAction :: HaskelineT m ()
optAction = String -> Options (HaskelineT m) -> Command (HaskelineT m)
forall (m :: * -> *).
MonadHaskeline m =>
String -> Options m -> String -> m ()
optMatcher String
cmd Options (HaskelineT m)
opts String
arguments
                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
    loopMultiLine :: [String] -> HaskelineT m ()
loopMultiLine [String]
prevs = do
      String
prefix <- MultiLine -> HaskelineT m String
banner MultiLine
MultiLine
      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 -> Maybe String -> HaskelineT m ()
handleCommands (Maybe String -> HaskelineT m ())
-> ([String] -> Maybe String) -> [String] -> HaskelineT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> ([String] -> String) -> [String] -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> HaskelineT m ()) -> [String] -> HaskelineT m ()
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
reverse [String]
prevs
        Just String
x -> [String] -> HaskelineT m ()
loopMultiLine ([String] -> HaskelineT m ()) -> [String] -> HaskelineT m ()
forall a b. (a -> b) -> a -> b
$ String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
prevs
    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
-------------------------------------------------------------------------------

-- | 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 (MultiLine -> MultiLine -> Bool
(MultiLine -> MultiLine -> Bool)
-> (MultiLine -> MultiLine -> Bool) -> Eq MultiLine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultiLine -> MultiLine -> Bool
$c/= :: MultiLine -> MultiLine -> Bool
== :: MultiLine -> MultiLine -> Bool
$c== :: MultiLine -> MultiLine -> Bool
Eq, Int -> MultiLine -> String -> String
[MultiLine] -> String -> String
MultiLine -> String
(Int -> MultiLine -> String -> String)
-> (MultiLine -> String)
-> ([MultiLine] -> String -> String)
-> Show MultiLine
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [MultiLine] -> String -> String
$cshowList :: [MultiLine] -> String -> String
show :: MultiLine -> String
$cshow :: MultiLine -> String
showsPrec :: Int -> MultiLine -> String -> String
$cshowsPrec :: Int -> MultiLine -> String -> String
Show)

-- | REPL Options datatype
data ReplOpts m = ReplOpts
  { -- | Banner
    ReplOpts m -> MultiLine -> HaskelineT m String
banner :: MultiLine -> 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,
    -- | Optional multi-line command ( passing Nothing disables multi-line support )
    ReplOpts m -> Maybe String
multilineCommand :: Maybe String,
    -- | Tab completion function
    ReplOpts m -> CompleterStyle m
tabComplete :: CompleterStyle m,
    -- | Initialiser
    ReplOpts m -> HaskelineT m ()
initialiser :: HaskelineT m (),
    -- | Finaliser ( runs on <Ctrl-D> )
    ReplOpts m -> HaskelineT m ExitDecision
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 m -> m ()
evalReplOpts ReplOpts {Options (HaskelineT m)
Maybe Char
Maybe String
CompleterStyle m
HaskelineT m ()
HaskelineT m ExitDecision
Command (HaskelineT m)
MultiLine -> HaskelineT m String
finaliser :: HaskelineT m ExitDecision
initialiser :: HaskelineT m ()
tabComplete :: CompleterStyle m
multilineCommand :: Maybe String
prefix :: Maybe Char
options :: Options (HaskelineT m)
command :: Command (HaskelineT m)
banner :: MultiLine -> HaskelineT m String
finaliser :: forall (m :: * -> *). ReplOpts m -> HaskelineT m ExitDecision
initialiser :: forall (m :: * -> *). ReplOpts m -> HaskelineT m ()
tabComplete :: forall (m :: * -> *). ReplOpts m -> CompleterStyle m
multilineCommand :: forall (m :: * -> *). ReplOpts m -> Maybe String
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 -> MultiLine -> HaskelineT m String
..} =
  (MultiLine -> HaskelineT m String)
-> Command (HaskelineT m)
-> Options (HaskelineT m)
-> Maybe Char
-> Maybe String
-> CompleterStyle m
-> HaskelineT m ()
-> HaskelineT m ExitDecision
-> m ()
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
(MultiLine -> HaskelineT m String)
-> Command (HaskelineT m)
-> Options (HaskelineT m)
-> Maybe Char
-> Maybe String
-> CompleterStyle m
-> HaskelineT m a
-> HaskelineT m ExitDecision
-> m ()
evalRepl
    MultiLine -> HaskelineT m String
banner
    Command (HaskelineT m)
command
    Options (HaskelineT m)
options
    Maybe Char
prefix
    Maybe String
multilineCommand
    CompleterStyle m
tabComplete
    HaskelineT m ()
initialiser
    HaskelineT m ExitDecision
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 :: (MultiLine -> HaskelineT m String)
-> Command (HaskelineT m)
-> Options (HaskelineT m)
-> Maybe Char
-> Maybe String
-> CompleterStyle m
-> HaskelineT m a
-> HaskelineT m ExitDecision
-> m ()
evalRepl MultiLine -> HaskelineT m String
banner Command (HaskelineT m)
cmd Options (HaskelineT m)
opts Maybe Char
optsPrefix Maybe String
multiCommand CompleterStyle m
comp HaskelineT m a
initz HaskelineT m ExitDecision
finalz = 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 = (MultiLine -> HaskelineT m String)
-> Command (HaskelineT m)
-> Options (HaskelineT m)
-> Maybe Char
-> Maybe String
-> HaskelineT m ExitDecision
-> HaskelineT m ()
forall (m :: * -> *).
(Functor m, MonadMask m, MonadIO m) =>
(MultiLine -> HaskelineT m String)
-> Command (HaskelineT m)
-> Options (HaskelineT m)
-> Maybe Char
-> Maybe String
-> HaskelineT m ExitDecision
-> HaskelineT m ()
replLoop MultiLine -> HaskelineT m String
banner Command (HaskelineT m)
cmd Options (HaskelineT m)
opts Maybe Char
optsPrefix Maybe String
multiCommand HaskelineT m ExitDecision
finalz
    _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)