{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- | Helper functions and transformer to write your own REPLs.
module Linenoise.Repl
  ( ReplDirective (..)
  , ReplT (..)
  , replM
  , runReplT
  )
where

import Control.Applicative (Alternative)
import Control.Monad (MonadPlus)
import Control.Monad.Catch (MonadCatch, MonadThrow)
import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.IO.Unlift (MonadUnliftIO (..), wrappedWithRunInIO)
import Control.Monad.Reader (MonadReader, ReaderT (..), ask)
import Control.Monad.State.Strict (MonadState (..))
import Control.Monad.Trans (MonadTrans (..))
import Control.Monad.Zip (MonadZip)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Text (Text)
import Linenoise.Unlift (InputResult (..))
import qualified Linenoise.Unlift as Unlift

-- | Basic monad transformer with mutable state that can be used with all "Linenoise.Unlift" functions.
--   You do not have to use this, but it's here to cover most of what you would need without having
--   to roll your own newtype.
newtype ReplT r s m a = ReplT {forall r s (m :: * -> *) a.
ReplT r s m a -> ReaderT r (ReaderT (IORef s) m) a
unReplT :: ReaderT r (ReaderT (IORef s) m) a}
  deriving
    ( (forall a b. (a -> b) -> ReplT r s m a -> ReplT r s m b)
-> (forall a b. a -> ReplT r s m b -> ReplT r s m a)
-> Functor (ReplT r s m)
forall a b. a -> ReplT r s m b -> ReplT r s m a
forall a b. (a -> b) -> ReplT r s m a -> ReplT r s m b
forall r s (m :: * -> *) a b.
Functor m =>
a -> ReplT r s m b -> ReplT r s m a
forall r s (m :: * -> *) a b.
Functor m =>
(a -> b) -> ReplT r s m a -> ReplT r s m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall r s (m :: * -> *) a b.
Functor m =>
(a -> b) -> ReplT r s m a -> ReplT r s m b
fmap :: forall a b. (a -> b) -> ReplT r s m a -> ReplT r s m b
$c<$ :: forall r s (m :: * -> *) a b.
Functor m =>
a -> ReplT r s m b -> ReplT r s m a
<$ :: forall a b. a -> ReplT r s m b -> ReplT r s m a
Functor
    , Functor (ReplT r s m)
Functor (ReplT r s m) =>
(forall a. a -> ReplT r s m a)
-> (forall a b.
    ReplT r s m (a -> b) -> ReplT r s m a -> ReplT r s m b)
-> (forall a b c.
    (a -> b -> c) -> ReplT r s m a -> ReplT r s m b -> ReplT r s m c)
-> (forall a b. ReplT r s m a -> ReplT r s m b -> ReplT r s m b)
-> (forall a b. ReplT r s m a -> ReplT r s m b -> ReplT r s m a)
-> Applicative (ReplT r s m)
forall a. a -> ReplT r s m a
forall a b. ReplT r s m a -> ReplT r s m b -> ReplT r s m a
forall a b. ReplT r s m a -> ReplT r s m b -> ReplT r s m b
forall a b. ReplT r s m (a -> b) -> ReplT r s m a -> ReplT r s m b
forall a b c.
(a -> b -> c) -> ReplT r s m a -> ReplT r s m b -> ReplT r s m c
forall r s (m :: * -> *). Applicative m => Functor (ReplT r s m)
forall r s (m :: * -> *) a. Applicative m => a -> ReplT r s m a
forall r s (m :: * -> *) a b.
Applicative m =>
ReplT r s m a -> ReplT r s m b -> ReplT r s m a
forall r s (m :: * -> *) a b.
Applicative m =>
ReplT r s m a -> ReplT r s m b -> ReplT r s m b
forall r s (m :: * -> *) a b.
Applicative m =>
ReplT r s m (a -> b) -> ReplT r s m a -> ReplT r s m b
forall r s (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> ReplT r s m a -> ReplT r s m b -> ReplT r s 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
$cpure :: forall r s (m :: * -> *) a. Applicative m => a -> ReplT r s m a
pure :: forall a. a -> ReplT r s m a
$c<*> :: forall r s (m :: * -> *) a b.
Applicative m =>
ReplT r s m (a -> b) -> ReplT r s m a -> ReplT r s m b
<*> :: forall a b. ReplT r s m (a -> b) -> ReplT r s m a -> ReplT r s m b
$cliftA2 :: forall r s (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> ReplT r s m a -> ReplT r s m b -> ReplT r s m c
liftA2 :: forall a b c.
(a -> b -> c) -> ReplT r s m a -> ReplT r s m b -> ReplT r s m c
$c*> :: forall r s (m :: * -> *) a b.
Applicative m =>
ReplT r s m a -> ReplT r s m b -> ReplT r s m b
*> :: forall a b. ReplT r s m a -> ReplT r s m b -> ReplT r s m b
$c<* :: forall r s (m :: * -> *) a b.
Applicative m =>
ReplT r s m a -> ReplT r s m b -> ReplT r s m a
<* :: forall a b. ReplT r s m a -> ReplT r s m b -> ReplT r s m a
Applicative
    , Applicative (ReplT r s m)
Applicative (ReplT r s m) =>
(forall a b.
 ReplT r s m a -> (a -> ReplT r s m b) -> ReplT r s m b)
-> (forall a b. ReplT r s m a -> ReplT r s m b -> ReplT r s m b)
-> (forall a. a -> ReplT r s m a)
-> Monad (ReplT r s m)
forall a. a -> ReplT r s m a
forall a b. ReplT r s m a -> ReplT r s m b -> ReplT r s m b
forall a b. ReplT r s m a -> (a -> ReplT r s m b) -> ReplT r s m b
forall r s (m :: * -> *). Monad m => Applicative (ReplT r s m)
forall r s (m :: * -> *) a. Monad m => a -> ReplT r s m a
forall r s (m :: * -> *) a b.
Monad m =>
ReplT r s m a -> ReplT r s m b -> ReplT r s m b
forall r s (m :: * -> *) a b.
Monad m =>
ReplT r s m a -> (a -> ReplT r s m b) -> ReplT r s 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
$c>>= :: forall r s (m :: * -> *) a b.
Monad m =>
ReplT r s m a -> (a -> ReplT r s m b) -> ReplT r s m b
>>= :: forall a b. ReplT r s m a -> (a -> ReplT r s m b) -> ReplT r s m b
$c>> :: forall r s (m :: * -> *) a b.
Monad m =>
ReplT r s m a -> ReplT r s m b -> ReplT r s m b
>> :: forall a b. ReplT r s m a -> ReplT r s m b -> ReplT r s m b
$creturn :: forall r s (m :: * -> *) a. Monad m => a -> ReplT r s m a
return :: forall a. a -> ReplT r s m a
Monad
    , Monad (ReplT r s m)
Monad (ReplT r s m) =>
(forall a. IO a -> ReplT r s m a) -> MonadIO (ReplT r s m)
forall a. IO a -> ReplT r s m a
forall r s (m :: * -> *). MonadIO m => Monad (ReplT r s m)
forall r s (m :: * -> *) a. MonadIO m => IO a -> ReplT r s m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall r s (m :: * -> *) a. MonadIO m => IO a -> ReplT r s m a
liftIO :: forall a. IO a -> ReplT r s m a
MonadIO
    , Applicative (ReplT r s m)
Applicative (ReplT r s m) =>
(forall a. ReplT r s m a)
-> (forall a. ReplT r s m a -> ReplT r s m a -> ReplT r s m a)
-> (forall a. ReplT r s m a -> ReplT r s m [a])
-> (forall a. ReplT r s m a -> ReplT r s m [a])
-> Alternative (ReplT r s m)
forall a. ReplT r s m a
forall a. ReplT r s m a -> ReplT r s m [a]
forall a. ReplT r s m a -> ReplT r s m a -> ReplT r s m a
forall r s (m :: * -> *).
Alternative m =>
Applicative (ReplT r s m)
forall r s (m :: * -> *) a. Alternative m => ReplT r s m a
forall r s (m :: * -> *) a.
Alternative m =>
ReplT r s m a -> ReplT r s m [a]
forall r s (m :: * -> *) a.
Alternative m =>
ReplT r s m a -> ReplT r s m a -> ReplT r s m a
forall (f :: * -> *).
Applicative f =>
(forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
$cempty :: forall r s (m :: * -> *) a. Alternative m => ReplT r s m a
empty :: forall a. ReplT r s m a
$c<|> :: forall r s (m :: * -> *) a.
Alternative m =>
ReplT r s m a -> ReplT r s m a -> ReplT r s m a
<|> :: forall a. ReplT r s m a -> ReplT r s m a -> ReplT r s m a
$csome :: forall r s (m :: * -> *) a.
Alternative m =>
ReplT r s m a -> ReplT r s m [a]
some :: forall a. ReplT r s m a -> ReplT r s m [a]
$cmany :: forall r s (m :: * -> *) a.
Alternative m =>
ReplT r s m a -> ReplT r s m [a]
many :: forall a. ReplT r s m a -> ReplT r s m [a]
Alternative
    , Monad (ReplT r s m)
Alternative (ReplT r s m)
(Alternative (ReplT r s m), Monad (ReplT r s m)) =>
(forall a. ReplT r s m a)
-> (forall a. ReplT r s m a -> ReplT r s m a -> ReplT r s m a)
-> MonadPlus (ReplT r s m)
forall a. ReplT r s m a
forall a. ReplT r s m a -> ReplT r s m a -> ReplT r s m a
forall r s (m :: * -> *). MonadPlus m => Monad (ReplT r s m)
forall r s (m :: * -> *). MonadPlus m => Alternative (ReplT r s m)
forall r s (m :: * -> *) a. MonadPlus m => ReplT r s m a
forall r s (m :: * -> *) a.
MonadPlus m =>
ReplT r s m a -> ReplT r s m a -> ReplT r s m a
forall (m :: * -> *).
(Alternative m, Monad m) =>
(forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
$cmzero :: forall r s (m :: * -> *) a. MonadPlus m => ReplT r s m a
mzero :: forall a. ReplT r s m a
$cmplus :: forall r s (m :: * -> *) a.
MonadPlus m =>
ReplT r s m a -> ReplT r s m a -> ReplT r s m a
mplus :: forall a. ReplT r s m a -> ReplT r s m a -> ReplT r s m a
MonadPlus
    , Monad (ReplT r s m)
Monad (ReplT r s m) =>
(forall a. (a -> ReplT r s m a) -> ReplT r s m a)
-> MonadFix (ReplT r s m)
forall a. (a -> ReplT r s m a) -> ReplT r s m a
forall r s (m :: * -> *). MonadFix m => Monad (ReplT r s m)
forall r s (m :: * -> *) a.
MonadFix m =>
(a -> ReplT r s m a) -> ReplT r s m a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
$cmfix :: forall r s (m :: * -> *) a.
MonadFix m =>
(a -> ReplT r s m a) -> ReplT r s m a
mfix :: forall a. (a -> ReplT r s m a) -> ReplT r s m a
MonadFix
    , Monad (ReplT r s m)
Monad (ReplT r s m) =>
(forall a b. ReplT r s m a -> ReplT r s m b -> ReplT r s m (a, b))
-> (forall a b c.
    (a -> b -> c) -> ReplT r s m a -> ReplT r s m b -> ReplT r s m c)
-> (forall a b.
    ReplT r s m (a, b) -> (ReplT r s m a, ReplT r s m b))
-> MonadZip (ReplT r s m)
forall a b. ReplT r s m a -> ReplT r s m b -> ReplT r s m (a, b)
forall a b. ReplT r s m (a, b) -> (ReplT r s m a, ReplT r s m b)
forall a b c.
(a -> b -> c) -> ReplT r s m a -> ReplT r s m b -> ReplT r s m c
forall r s (m :: * -> *). MonadZip m => Monad (ReplT r s m)
forall r s (m :: * -> *) a b.
MonadZip m =>
ReplT r s m a -> ReplT r s m b -> ReplT r s m (a, b)
forall r s (m :: * -> *) a b.
MonadZip m =>
ReplT r s m (a, b) -> (ReplT r s m a, ReplT r s m b)
forall r s (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> ReplT r s m a -> ReplT r s m b -> ReplT r s m c
forall (m :: * -> *).
Monad m =>
(forall a b. m a -> m b -> m (a, b))
-> (forall a b c. (a -> b -> c) -> m a -> m b -> m c)
-> (forall a b. m (a, b) -> (m a, m b))
-> MonadZip m
$cmzip :: forall r s (m :: * -> *) a b.
MonadZip m =>
ReplT r s m a -> ReplT r s m b -> ReplT r s m (a, b)
mzip :: forall a b. ReplT r s m a -> ReplT r s m b -> ReplT r s m (a, b)
$cmzipWith :: forall r s (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> ReplT r s m a -> ReplT r s m b -> ReplT r s m c
mzipWith :: forall a b c.
(a -> b -> c) -> ReplT r s m a -> ReplT r s m b -> ReplT r s m c
$cmunzip :: forall r s (m :: * -> *) a b.
MonadZip m =>
ReplT r s m (a, b) -> (ReplT r s m a, ReplT r s m b)
munzip :: forall a b. ReplT r s m (a, b) -> (ReplT r s m a, ReplT r s m b)
MonadZip
    , Monad (ReplT r s m)
Monad (ReplT r s m) =>
(forall a. String -> ReplT r s m a) -> MonadFail (ReplT r s m)
forall a. String -> ReplT r s m a
forall r s (m :: * -> *). MonadFail m => Monad (ReplT r s m)
forall r s (m :: * -> *) a. MonadFail m => String -> ReplT r s m a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall r s (m :: * -> *) a. MonadFail m => String -> ReplT r s m a
fail :: forall a. String -> ReplT r s m a
MonadFail
    , Monad (ReplT r s m)
Monad (ReplT r s m) =>
(forall e a. (HasCallStack, Exception e) => e -> ReplT r s m a)
-> MonadThrow (ReplT r s m)
forall e a. (HasCallStack, Exception e) => e -> ReplT r s m a
forall r s (m :: * -> *). MonadThrow m => Monad (ReplT r s m)
forall r s (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> ReplT r s m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall r s (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> ReplT r s m a
throwM :: forall e a. (HasCallStack, Exception e) => e -> ReplT r s m a
MonadThrow
    , MonadThrow (ReplT r s m)
MonadThrow (ReplT r s m) =>
(forall e a.
 (HasCallStack, Exception e) =>
 ReplT r s m a -> (e -> ReplT r s m a) -> ReplT r s m a)
-> MonadCatch (ReplT r s m)
forall e a.
(HasCallStack, Exception e) =>
ReplT r s m a -> (e -> ReplT r s m a) -> ReplT r s m a
forall r s (m :: * -> *). MonadCatch m => MonadThrow (ReplT r s m)
forall r s (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
ReplT r s m a -> (e -> ReplT r s m a) -> ReplT r s m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall r s (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
ReplT r s m a -> (e -> ReplT r s m a) -> ReplT r s m a
catch :: forall e a.
(HasCallStack, Exception e) =>
ReplT r s m a -> (e -> ReplT r s m a) -> ReplT r s m a
MonadCatch
    , MonadReader r
    )

askRef :: Applicative m => ReplT r s m (IORef s)
askRef :: forall (m :: * -> *) r s. Applicative m => ReplT r s m (IORef s)
askRef = ReaderT r (ReaderT (IORef s) m) (IORef s) -> ReplT r s m (IORef s)
forall r s (m :: * -> *) a.
ReaderT r (ReaderT (IORef s) m) a -> ReplT r s m a
ReplT ((r -> ReaderT (IORef s) m (IORef s))
-> ReaderT r (ReaderT (IORef s) m) (IORef s)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (ReaderT (IORef s) m (IORef s) -> r -> ReaderT (IORef s) m (IORef s)
forall a b. a -> b -> a
const ((IORef s -> m (IORef s)) -> ReaderT (IORef s) m (IORef s)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT IORef s -> m (IORef s)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)))

refReplT :: ReplT r s m a -> r -> IORef s -> m a
refReplT :: forall r s (m :: * -> *) a. ReplT r s m a -> r -> IORef s -> m a
refReplT ReplT r s m a
n r
r = ReaderT (IORef s) m a -> IORef s -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT r (ReaderT (IORef s) m) a -> r -> ReaderT (IORef s) m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReplT r s m a -> ReaderT r (ReaderT (IORef s) m) a
forall r s (m :: * -> *) a.
ReplT r s m a -> ReaderT r (ReaderT (IORef s) m) a
unReplT ReplT r s m a
n) r
r)

instance MonadTrans (ReplT r s) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> ReplT r s m a
lift = ReaderT r (ReaderT (IORef s) m) a -> ReplT r s m a
forall r s (m :: * -> *) a.
ReaderT r (ReaderT (IORef s) m) a -> ReplT r s m a
ReplT (ReaderT r (ReaderT (IORef s) m) a -> ReplT r s m a)
-> (m a -> ReaderT r (ReaderT (IORef s) m) a)
-> m a
-> ReplT r s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT (IORef s) m a -> ReaderT r (ReaderT (IORef s) m) a
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (IORef s) m a -> ReaderT r (ReaderT (IORef s) m) a)
-> (m a -> ReaderT (IORef s) m a)
-> m a
-> ReaderT r (ReaderT (IORef s) m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT (IORef s) m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT (IORef s) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance MonadUnliftIO m => MonadUnliftIO (ReplT r s m) where
  withRunInIO :: forall b.
((forall a. ReplT r s m a -> IO a) -> IO b) -> ReplT r s m b
withRunInIO (forall a. ReplT r s m a -> IO a) -> IO b
run = do
    r
r <- ReplT r s m r
forall r (m :: * -> *). MonadReader r m => m r
ask
    IORef s
ref <- ReplT r s m (IORef s)
forall (m :: * -> *) r s. Applicative m => ReplT r s m (IORef s)
askRef
    (m b -> ReplT r s m b)
-> (forall a. ReplT r s m a -> m a)
-> ((forall a. ReplT r s m a -> IO a) -> IO b)
-> ReplT r s m b
forall (n :: * -> *) b (m :: * -> *).
MonadUnliftIO n =>
(n b -> m b)
-> (forall a. m a -> n a)
-> ((forall a. m a -> IO a) -> IO b)
-> m b
wrappedWithRunInIO m b -> ReplT r s m b
forall (m :: * -> *) a. Monad m => m a -> ReplT r s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (\ReplT r s m a
n -> ReplT r s m a -> r -> IORef s -> m a
forall r s (m :: * -> *) a. ReplT r s m a -> r -> IORef s -> m a
refReplT ReplT r s m a
n r
r IORef s
ref) (forall a. ReplT r s m a -> IO a) -> IO b
run

instance MonadIO m => MonadState s (ReplT r s m) where
  get :: ReplT r s m s
get = ReaderT r (ReaderT (IORef s) m) s -> ReplT r s m s
forall r s (m :: * -> *) a.
ReaderT r (ReaderT (IORef s) m) a -> ReplT r s m a
ReplT ((r -> ReaderT (IORef s) m s) -> ReaderT r (ReaderT (IORef s) m) s
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (ReaderT (IORef s) m s -> r -> ReaderT (IORef s) m s
forall a b. a -> b -> a
const ((IORef s -> m s) -> ReaderT (IORef s) m s
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (IO s -> m s
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO s -> m s) -> (IORef s -> IO s) -> IORef s -> m s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef s -> IO s
forall a. IORef a -> IO a
readIORef))))
  put :: s -> ReplT r s m ()
put s
s = ReaderT r (ReaderT (IORef s) m) () -> ReplT r s m ()
forall r s (m :: * -> *) a.
ReaderT r (ReaderT (IORef s) m) a -> ReplT r s m a
ReplT ((r -> ReaderT (IORef s) m ()) -> ReaderT r (ReaderT (IORef s) m) ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (ReaderT (IORef s) m () -> r -> ReaderT (IORef s) m ()
forall a b. a -> b -> a
const ((IORef s -> m ()) -> ReaderT (IORef s) m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (\IORef s
ref -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef s -> s -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef s
ref s
s)))))

-- | Run a ReplT.
runReplT :: MonadIO m => ReplT r s m a -> r -> s -> m (a, s)
runReplT :: forall (m :: * -> *) r s a.
MonadIO m =>
ReplT r s m a -> r -> s -> m (a, s)
runReplT ReplT r s m a
n r
r s
s = do
  IORef s
ref <- IO (IORef s) -> m (IORef s)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (s -> IO (IORef s)
forall a. a -> IO (IORef a)
newIORef s
s)
  a
res <- ReplT r s m a -> r -> IORef s -> m a
forall r s (m :: * -> *) a. ReplT r s m a -> r -> IORef s -> m a
refReplT ReplT r s m a
n r
r IORef s
ref
  s
final <- IO s -> m s
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef s -> IO s
forall a. IORef a -> IO a
readIORef IORef s
ref)
  (a, s) -> m (a, s)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
res, s
final)

-- | Directive to control voluntary REPL termination.
data ReplDirective
  = ReplQuit
  | ReplContinue
  deriving (ReplDirective -> ReplDirective -> Bool
(ReplDirective -> ReplDirective -> Bool)
-> (ReplDirective -> ReplDirective -> Bool) -> Eq ReplDirective
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReplDirective -> ReplDirective -> Bool
== :: ReplDirective -> ReplDirective -> Bool
$c/= :: ReplDirective -> ReplDirective -> Bool
/= :: ReplDirective -> ReplDirective -> Bool
Eq, Int -> ReplDirective -> ShowS
[ReplDirective] -> ShowS
ReplDirective -> String
(Int -> ReplDirective -> ShowS)
-> (ReplDirective -> String)
-> ([ReplDirective] -> ShowS)
-> Show ReplDirective
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReplDirective -> ShowS
showsPrec :: Int -> ReplDirective -> ShowS
$cshow :: ReplDirective -> String
show :: ReplDirective -> String
$cshowList :: [ReplDirective] -> ShowS
showList :: [ReplDirective] -> ShowS
Show)

-- | Run a simple REPL.
replM
  :: MonadUnliftIO m
  => ReplDirective
  -- ^ Directive on interrupt
  -> Text
  -- ^ Prompt
  -> (Text -> m ReplDirective)
  -- ^ Action
  -> (Text -> m [Text])
  -- ^ Completion
  -> m ()
replM :: forall (m :: * -> *).
MonadUnliftIO m =>
ReplDirective
-> Text -> (Text -> m ReplDirective) -> (Text -> m [Text]) -> m ()
replM ReplDirective
onInterrupt Text
prompt Text -> m ReplDirective
action Text -> m [Text]
comp = m ()
loop
 where
  loop :: m ()
loop = do
    (Text -> m [Text]) -> m ()
forall (m :: * -> *). MonadUnliftIO m => (Text -> m [Text]) -> m ()
Unlift.setCompletion Text -> m [Text]
comp
    InputResult Text
res <- Text -> m (InputResult Text)
forall (m :: * -> *). MonadIO m => Text -> m (InputResult Text)
Unlift.getInputLine Text
prompt
    ReplDirective
directive <- case InputResult Text
res of
      InputResult Text
InterruptResult -> ReplDirective -> m ReplDirective
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplDirective
onInterrupt
      InputResult Text
EofResult -> ReplDirective -> m ReplDirective
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplDirective
ReplQuit
      LineResult Text
line -> do
        ReplDirective
directive <- Text -> m ReplDirective
action Text
line
        Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
Unlift.addHistory Text
line
        ReplDirective -> m ReplDirective
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReplDirective
directive
    case ReplDirective
directive of
      ReplDirective
ReplContinue -> m ()
loop
      ReplDirective
ReplQuit -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()