{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module System.Console.Repline (
HaskelineT,
runHaskelineT,
evalRepl,
ReplOpts(..),
evalReplOpts,
Cmd,
Options,
WordCompleter,
LineCompleter,
CompleterStyle(..),
Command,
CompletionFunc,
wordCompleter,
listCompleter,
fileCompleter,
listWordCompleter,
runMatcher,
trimComplete,
abort,
tryAction,
dontCrash,
) where
import System.Console.Haskeline.Completion
import System.Console.Haskeline.MonadException
import qualified System.Console.Haskeline as H
import Data.List (isPrefixOf)
import Control.Applicative
import Control.Monad.Fail as Fail
import Control.Monad.State.Strict
import Control.Monad.Reader
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, MonadIO (HaskelineT m)
MonadIO (HaskelineT m) =>
(forall a.
(RunIO (HaskelineT m) -> IO (HaskelineT m a)) -> HaskelineT m a)
-> MonadException (HaskelineT m)
(RunIO (HaskelineT m) -> IO (HaskelineT m a)) -> HaskelineT m a
forall a.
(RunIO (HaskelineT m) -> IO (HaskelineT m a)) -> HaskelineT m a
forall (m :: * -> *).
MonadIO m =>
(forall a. (RunIO m -> IO (m a)) -> m a) -> MonadException m
forall (m :: * -> *). MonadException m => MonadIO (HaskelineT m)
forall (m :: * -> *) a.
MonadException m =>
(RunIO (HaskelineT m) -> IO (HaskelineT m a)) -> HaskelineT m a
controlIO :: (RunIO (HaskelineT m) -> IO (HaskelineT m a)) -> HaskelineT m a
$ccontrolIO :: forall (m :: * -> *) a.
MonadException m =>
(RunIO (HaskelineT m) -> IO (HaskelineT m a)) -> HaskelineT m a
$cp1MonadException :: forall (m :: * -> *). MonadException m => MonadIO (HaskelineT m)
MonadException, 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, MonadException (HaskelineT m)
String -> HaskelineT m (Maybe Char)
String -> HaskelineT m (Maybe String)
String -> HaskelineT m ()
MonadException (HaskelineT m) =>
(String -> HaskelineT m (Maybe String))
-> (String -> HaskelineT m (Maybe Char))
-> (String -> HaskelineT m ())
-> (String -> HaskelineT m ())
-> MonadHaskeline (HaskelineT m)
forall (m :: * -> *).
MonadException m =>
MonadException (HaskelineT m)
forall (m :: * -> *).
MonadException m =>
String -> HaskelineT m (Maybe Char)
forall (m :: * -> *).
MonadException m =>
String -> HaskelineT m (Maybe String)
forall (m :: * -> *). MonadException m => String -> HaskelineT m ()
forall (m :: * -> *).
MonadException m =>
(String -> m (Maybe String))
-> (String -> m (Maybe Char))
-> (String -> m ())
-> (String -> m ())
-> MonadHaskeline m
outputStrLn :: String -> HaskelineT m ()
$coutputStrLn :: forall (m :: * -> *). MonadException m => String -> HaskelineT m ()
outputStr :: String -> HaskelineT m ()
$coutputStr :: forall (m :: * -> *). MonadException m => String -> HaskelineT m ()
getInputChar :: String -> HaskelineT m (Maybe Char)
$cgetInputChar :: forall (m :: * -> *).
MonadException m =>
String -> HaskelineT m (Maybe Char)
getInputLine :: String -> HaskelineT m (Maybe String)
$cgetInputLine :: forall (m :: * -> *).
MonadException m =>
String -> HaskelineT m (Maybe String)
$cp1MonadHaskeline :: forall (m :: * -> *).
MonadException m =>
MonadException (HaskelineT m)
MonadHaskeline)
runHaskelineT :: MonadException m => H.Settings m -> HaskelineT m a -> m a
runHaskelineT :: Settings m -> HaskelineT m a -> m a
runHaskelineT s :: Settings m
s m :: HaskelineT m a
m = Settings m -> InputT m a -> m a
forall (m :: * -> *) a.
MonadException m =>
Settings m -> InputT m a -> m a
H.runInputT Settings m
s (InputT m a -> InputT m a
forall (m :: * -> *) a.
MonadException 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 MonadException m => MonadHaskeline m where
getInputLine :: String -> m (Maybe String)
getInputChar :: String -> m (Maybe Char)
outputStr :: String -> m ()
outputStrLn :: String -> m ()
instance MonadException m => MonadHaskeline (H.InputT m) where
getInputLine :: String -> InputT m (Maybe String)
getInputLine = String -> InputT m (Maybe String)
forall (m :: * -> *).
MonadException m =>
String -> InputT m (Maybe String)
H.getInputLine
getInputChar :: String -> InputT m (Maybe Char)
getInputChar = String -> InputT m (Maybe Char)
forall (m :: * -> *).
MonadException 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 f :: r -> r
f (HaskelineT m :: 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
type Cmd m = [String] -> m ()
type Options m = [(String, Cmd m)]
type Command m = String -> m ()
type WordCompleter m = (String -> m [String])
type LineCompleter m = (String -> String -> m [Completion])
tryAction :: MonadException m => HaskelineT m a -> HaskelineT m a
tryAction :: HaskelineT m a -> HaskelineT m a
tryAction (HaskelineT f :: 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.
MonadException 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.
(MonadException m, Exception e) =>
(e -> m a) -> m a -> m a
handle (\H.Interrupt -> InputT m a
loop) InputT m a
f
dontCrash :: (MonadIO m, H.MonadException m) => m () -> m ()
dontCrash :: m () -> m ()
dontCrash m :: m ()
m = m () -> (SomeException -> m ()) -> m ()
forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
H.catch m ()
m ( \ e :: SomeException
e@SomeException{} -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ( String -> IO ()
putStrLn ( SomeException -> String
forall a. Show a => a -> String
show SomeException
e ) ) )
abort :: MonadIO m => HaskelineT m a
abort :: HaskelineT m a
abort = Interrupt -> HaskelineT m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO Interrupt
H.Interrupt
replLoop :: (Functor m, MonadException m)
=> HaskelineT m String
-> Command (HaskelineT m)
-> Options (HaskelineT m)
-> Maybe Char
-> HaskelineT m ()
replLoop :: HaskelineT m String
-> Command (HaskelineT m)
-> Options (HaskelineT m)
-> Maybe Char
-> HaskelineT m ()
replLoop banner :: HaskelineT m String
banner cmdM :: Command (HaskelineT m)
cmdM opts :: Options (HaskelineT m)
opts optsPrefix :: 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. MonadException 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 "")) (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
Nothing -> Command (HaskelineT m)
forall (m :: * -> *). MonadHaskeline m => String -> m ()
outputStrLn "Goodbye."
Just "" -> HaskelineT m ()
loop
Just (prefix :: Char
prefix: cmds :: 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
(cmd :: String
cmd:args :: [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. MonadException 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 input :: String
input -> do
Command (HaskelineT m)
handleInput String
input
HaskelineT m ()
loop
handleInput :: Command (HaskelineT m)
handleInput input :: String
input = HaskelineT m () -> HaskelineT m () -> HaskelineT m ()
forall (m :: * -> *) a. MonadException 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 ()
optMatcher :: MonadHaskeline m => String -> Options m -> [String] -> m ()
optMatcher :: String -> Options m -> [String] -> m ()
optMatcher s :: String
s [] _ = String -> m ()
forall (m :: * -> *). MonadHaskeline m => String -> m ()
outputStrLn (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "No such command :" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
optMatcher s :: String
s ((x :: String
x, m :: [String] -> m ()
m):xs :: Options m
xs) args :: [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
data ReplOpts m = ReplOpts {
ReplOpts m -> HaskelineT m String
banner :: HaskelineT m String
, ReplOpts m -> Command (HaskelineT m)
command :: Command (HaskelineT m)
, ReplOpts m -> Options (HaskelineT m)
options :: Options (HaskelineT m)
, ReplOpts m -> Maybe Char
prefix :: Maybe Char
, ReplOpts m -> CompleterStyle m
tabComplete :: CompleterStyle m
, ReplOpts m -> HaskelineT m ()
initialiser :: HaskelineT m ()
}
evalReplOpts :: (Functor m, MonadException m) => ReplOpts m -> m ()
evalReplOpts :: ReplOpts m -> m ()
evalReplOpts (ReplOpts {..}) = HaskelineT m String
-> Command (HaskelineT m)
-> Options (HaskelineT m)
-> Maybe Char
-> CompleterStyle m
-> HaskelineT m ()
-> m ()
forall (m :: * -> *) a.
(Functor m, MonadException 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
evalRepl :: (Functor m, MonadException m)
=> HaskelineT m String
-> Command (HaskelineT m)
-> Options (HaskelineT m)
-> Maybe Char
-> CompleterStyle m
-> HaskelineT m a
-> m ()
evalRepl :: HaskelineT m String
-> Command (HaskelineT m)
-> Options (HaskelineT m)
-> Maybe Char
-> CompleterStyle m
-> HaskelineT m a
-> m ()
evalRepl banner :: HaskelineT m String
banner cmd :: Command (HaskelineT m)
cmd opts :: Options (HaskelineT m)
opts optsPrefix :: Maybe Char
optsPrefix comp :: CompleterStyle m
comp initz :: HaskelineT m a
initz = Settings m -> HaskelineT m () -> m ()
forall (m :: * -> *) a.
MonadException 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, MonadException 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 ".history"
, autoAddHistory :: Bool
H.autoAddHistory = Bool
True
}
data CompleterStyle m
= Word (WordCompleter m)
| Word0 (WordCompleter m)
| Cursor (LineCompleter m)
| File
| Prefix
(CompletionFunc m)
[(String, CompletionFunc m)]
mkCompleter :: MonadIO m => CompleterStyle m -> CompletionFunc m
mkCompleter :: CompleterStyle m -> CompletionFunc m
mkCompleter (Word f :: 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 '\\') " \t()[]" (WordCompleter m -> String -> m [Completion]
forall (m :: * -> *).
Monad m =>
(String -> m [String]) -> String -> m [Completion]
_simpleComplete WordCompleter m
f)
mkCompleter (Word0 f :: 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 '\\') " \t()[]" (WordCompleter m -> String -> m [Completion]
forall (m :: * -> *).
Monad m =>
(String -> m [String]) -> String -> m [Completion]
_simpleCompleteNoSpace WordCompleter m
f)
mkCompleter (Cursor f :: 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 '\\') " \t()[]" (LineCompleter m -> LineCompleter m
forall (m :: * -> *). LineCompleter m -> LineCompleter m
unRev0 LineCompleter m
f)
mkCompleter File = CompletionFunc m
forall (m :: * -> *). MonadIO m => CompletionFunc m
completeFilename
mkCompleter (Prefix def :: CompletionFunc m
def opts :: [(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
unRev0 :: LineCompleter m -> LineCompleter m
unRev0 :: LineCompleter m -> LineCompleter m
unRev0 f :: LineCompleter m
f x :: String
x = LineCompleter m
f (String -> String
forall a. [a] -> [a]
reverse String
x)
trimComplete :: String -> Completion -> Completion
trimComplete :: String -> Completion -> Completion
trimComplete prefix :: String
prefix (Completion a :: String
a b :: String
b c :: 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 f :: String -> m [String]
f word :: String
word = String -> m [String]
f String
word m [String] -> ([String] -> m [Completion]) -> m [Completion]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Completion] -> m [Completion]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Completion] -> m [Completion])
-> ([String] -> [Completion]) -> [String] -> m [Completion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Completion) -> [String] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map String -> Completion
simpleCompletion
_simpleCompleteNoSpace :: (Monad m) => (String -> m [String]) -> String -> m [Completion]
_simpleCompleteNoSpace :: (String -> m [String]) -> String -> m [Completion]
_simpleCompleteNoSpace f :: String -> m [String]
f word :: String
word = String -> m [String]
f String
word m [String] -> ([String] -> m [Completion]) -> m [Completion]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Completion] -> m [Completion]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Completion] -> m [Completion])
-> ([String] -> [Completion]) -> [String] -> m [Completion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Completion) -> [String] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map String -> Completion
completionNoSpace
completionNoSpace :: String -> Completion
completionNoSpace :: String -> Completion
completionNoSpace str :: String
str = String -> String -> Bool -> Completion
Completion String
str String
str Bool
False
wordCompleter :: Monad m => WordCompleter m -> CompletionFunc m
wordCompleter :: WordCompleter m -> CompletionFunc m
wordCompleter f :: WordCompleter m
f (start :: String
start, n :: 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 '\\') " \t()[]" (WordCompleter m -> String -> m [Completion]
forall (m :: * -> *).
Monad m =>
(String -> m [String]) -> String -> m [Completion]
_simpleComplete WordCompleter m
f) (String
start, String
n)
listCompleter :: Monad m => [String] -> CompletionFunc m
listCompleter :: [String] -> CompletionFunc m
listCompleter names :: [String]
names (start :: String
start, n :: 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 '\\') " \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
complete_aux [String]
names)) (String
start, String
n)
listWordCompleter :: Monad m => [String] -> WordCompleter m
listWordCompleter :: [String] -> WordCompleter m
listWordCompleter = [String] -> WordCompleter m
forall (m :: * -> *). Monad m => [String] -> WordCompleter m
complete_aux
fileCompleter :: MonadIO m => CompletionFunc m
fileCompleter :: CompletionFunc m
fileCompleter = CompletionFunc m
forall (m :: * -> *). MonadIO m => CompletionFunc m
completeFilename
complete_aux :: Monad m => [String] -> WordCompleter m
complete_aux :: [String] -> WordCompleter m
complete_aux names :: [String]
names n :: 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 def :: CompletionFunc m
def _ [] args :: (String, String)
args = CompletionFunc m
def (String, String)
args
completeMatcher def :: CompletionFunc m
def [] _ args :: (String, String)
args = CompletionFunc m
def (String, String)
args
completeMatcher def :: CompletionFunc m
def s :: String
s ((x :: String
x, f :: CompletionFunc m
f):xs :: [(String, CompletionFunc m)]
xs) args :: (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
runMatcher
:: Monad m => [(String, CompletionFunc m)]
-> CompletionFunc m
-> CompletionFunc m
runMatcher :: [(String, CompletionFunc m)]
-> CompletionFunc m -> CompletionFunc m
runMatcher opts :: [(String, CompletionFunc m)]
opts def :: CompletionFunc m
def (start :: String
start, n :: 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)