{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Provides a static effect for haskeline.
--
-- @since 0.1
module Effectful.Haskeline.Static
  ( -- * Effect
    Haskeline,
    haveTerminalUI,
    getInputLine,
    getInputLineWithInitial,
    getInputChar,
    getPassword,
    waitForAnyKey,
    outputStr,
    outputStrLn,
    getHistory,
    putHistory,
    modifyHistory,
    withInterrupt,
    handleInterrupt,

    -- ** Handlers
    runHaskeline,

    -- * Reader
    -- $reader
    runEffInputTEnv,
    runInputTEnv,
    runInputTEnvWith,

    -- * Haskeline Re-exports

    -- ** Types
    InputT,
    InputTEnv,

    -- ** IO Runners
    H.runInputT,
    H.runInputTBehavior,
    H.runInputTBehaviorWithPrefs,

    -- ** Config
    H.defaultSettings,
    H.defaultBehavior,
    H.defaultPrefs,
  )
where

import Control.Monad.Catch (MonadMask)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Trans.Reader (ReaderT (ReaderT, runReaderT))
import Effectful
  ( Dispatch (Static),
    DispatchOf,
    Eff,
    Effect,
    IOE,
    runEff,
    type (:>),
  )
import Effectful.Dispatch.Static
  ( HasCallStack,
    SideEffects (WithSideEffects),
    StaticRep,
    evalStaticRep,
    seqUnliftIO,
    unsafeEff,
    unsafeEff_,
  )
import Effectful.Reader.Static (Reader, ask, runReader)
import System.Console.Haskeline (InputT)
import System.Console.Haskeline qualified as H
import System.Console.Haskeline.History (History)
import System.Console.Haskeline.ReaderT (InputTEnv)
import System.Console.Haskeline.ReaderT qualified as HR

-- | Static haskeline effect.
--
-- @since 0.1
data Haskeline :: Effect

type instance DispatchOf Haskeline = Static WithSideEffects

data instance StaticRep Haskeline = MkHaskeline

-- $reader
--
-- These functions allow eliminating the 'Haskeline' effect in terms of
-- 'Control.Monad.Trans.Reader.ReaderT'.
--
-- __Examples:__
--
-- @
--  app :: (Haskeline :> es, Reader (InputTEnv IO) :> es) => Eff es String
--  app = do
--    mLine <- getInputLine "Enter your name: "
--    let name = fromMaybe "\<blank\>" mLine
--    outputStrLn $ "Hello: " ++ name
--    pure name
--
--  appIO :: IO String
--  appIO = do
--    runInputTEnv
--      $ \env -> runEffInputTEnv env
--      $ runHaskeline app
-- @

-- | Runs 'Haskeline' in 'IO'.
--
-- @since 0.1
runHaskeline :: (HasCallStack, IOE :> es) => Eff (Haskeline : es) a -> Eff es a
runHaskeline :: forall (es :: [Effect]) a.
(HasCallStack, IOE :> es) =>
Eff (Haskeline : es) a -> Eff es a
runHaskeline = StaticRep Haskeline -> Eff (Haskeline : es) a -> Eff es a
forall (e :: Effect) (sideEffects :: SideEffects) (es :: [Effect])
       a.
(HasCallStack, DispatchOf e ~ 'Static sideEffects,
 MaybeIOE sideEffects es) =>
StaticRep e -> Eff (e : es) a -> Eff es a
evalStaticRep StaticRep Haskeline
MkHaskeline

-- | Runner for 'Eff' with 'InputTEnv'. Intended for usage with 'runInputTEnv'
-- or 'runInputTEnvWith'.
--
-- @since 0.1
runEffInputTEnv ::
  (HasCallStack) =>
  -- | The 'InputT' environment.
  InputTEnv m ->
  -- | Eff action that requires the 'InputTEnv' environment.
  Eff [Reader (InputTEnv m), IOE] a ->
  -- | IO result.
  IO a
runEffInputTEnv :: forall (m :: * -> *) a.
HasCallStack =>
InputTEnv m -> Eff '[Reader (InputTEnv m), IOE] a -> IO a
runEffInputTEnv InputTEnv m
env = Eff '[IOE] a -> IO a
forall a. HasCallStack => Eff '[IOE] a -> IO a
runEff (Eff '[IOE] a -> IO a)
-> (Eff '[Reader (InputTEnv m), IOE] a -> Eff '[IOE] a)
-> Eff '[Reader (InputTEnv m), IOE] a
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputTEnv m -> Eff '[Reader (InputTEnv m), IOE] a -> Eff '[IOE] a
forall r (es :: [Effect]) a.
HasCallStack =>
r -> Eff (Reader r : es) a -> Eff es a
runReader InputTEnv m
env
{-# INLINEABLE runEffInputTEnv #-}

-- | 'runInputTEnvWith' with default haskeline settings.
--
-- __Examples:__
--
-- @
-- -- eff :: Eff [Reader (InputTEnv m), IOE] a
-- runInputTEnv $ \env -> runEffInputTEnv env eff
-- @
--
-- @since 0.1
runInputTEnv ::
  ( HasCallStack,
    MonadIO m,
    MonadMask m
  ) =>
  -- | Action.
  (InputTEnv m -> m a) ->
  -- | IO result.
  m a
runInputTEnv :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, MonadMask m) =>
(InputTEnv m -> m a) -> m a
runInputTEnv = (InputT m a -> m a) -> (InputTEnv m -> m a) -> m a
forall (m :: * -> *) a.
HasCallStack =>
(InputT m a -> m a) -> (InputTEnv m -> m a) -> m a
runInputTEnvWith (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
forall (m :: * -> *). MonadIO m => Settings m
H.defaultSettings)
{-# INLINEABLE runInputTEnv #-}

-- | Runs 'Control.Monad.Reader.ReaderT' 'InputTEnv' in 'IO' with 'InputT'
-- runner.
--
-- __Examples:__
--
-- @
-- -- eff :: Eff [Reader (InputTEnv m), IOE] a
-- runInputTEnvWith runInput $ \env -> runEffInputTEnv env eff
-- @
--
-- @since 0.1
runInputTEnvWith ::
  (HasCallStack) =>
  -- | 'InputT' runner.
  (InputT m a -> m a) ->
  -- | Action.
  (InputTEnv m -> m a) ->
  -- | IO result.
  m a
runInputTEnvWith :: forall (m :: * -> *) a.
HasCallStack =>
(InputT m a -> m a) -> (InputTEnv m -> m a) -> m a
runInputTEnvWith InputT m a -> m a
runInput = InputT m a -> m a
runInput (InputT m a -> m a)
-> ((InputTEnv m -> m a) -> InputT m a)
-> (InputTEnv m -> m a)
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT (InputTEnv m) m a -> InputT m a
forall (m :: * -> *) a. ReaderT (InputTEnv m) m a -> InputT m a
HR.fromReaderT (ReaderT (InputTEnv m) m a -> InputT m a)
-> ((InputTEnv m -> m a) -> ReaderT (InputTEnv m) m a)
-> (InputTEnv m -> m a)
-> InputT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InputTEnv m -> m a) -> ReaderT (InputTEnv m) m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT
{-# INLINEABLE runInputTEnvWith #-}

-- | Lifted 'H.haveTerminalUI'.
--
-- @since 0.1
haveTerminalUI ::
  ( HasCallStack,
    Haskeline :> es,
    Reader (InputTEnv IO) :> es
  ) =>
  Eff es Bool
haveTerminalUI :: forall (es :: [Effect]).
(HasCallStack, Haskeline :> es, Reader (InputTEnv IO) :> es) =>
Eff es Bool
haveTerminalUI = InputT IO Bool -> Eff es Bool
forall (es :: [Effect]) a.
(Reader (InputTEnv IO) :> es) =>
InputT IO a -> Eff es a
liftInputT InputT IO Bool
forall (m :: * -> *). Monad m => InputT m Bool
H.haveTerminalUI

-- | Lifted 'H.getInputLine'.
--
-- @since 0.1
getInputLine ::
  ( HasCallStack,
    Haskeline :> es,
    Reader (InputTEnv IO) :> es
  ) =>
  String ->
  Eff es (Maybe String)
getInputLine :: forall (es :: [Effect]).
(HasCallStack, Haskeline :> es, Reader (InputTEnv IO) :> es) =>
String -> Eff es (Maybe String)
getInputLine = InputT IO (Maybe String) -> Eff es (Maybe String)
forall (es :: [Effect]) a.
(Reader (InputTEnv IO) :> es) =>
InputT IO a -> Eff es a
liftInputT (InputT IO (Maybe String) -> Eff es (Maybe String))
-> (String -> InputT IO (Maybe String))
-> String
-> Eff es (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> InputT IO (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
H.getInputLine

-- | Lifted 'H.getInputLineWithInitial'.
--
-- @since 0.1
getInputLineWithInitial ::
  ( HasCallStack,
    Haskeline :> es,
    Reader (InputTEnv IO) :> es
  ) =>
  String ->
  (String, String) ->
  Eff es (Maybe String)
getInputLineWithInitial :: forall (es :: [Effect]).
(HasCallStack, Haskeline :> es, Reader (InputTEnv IO) :> es) =>
String -> (String, String) -> Eff es (Maybe String)
getInputLineWithInitial String
s = InputT IO (Maybe String) -> Eff es (Maybe String)
forall (es :: [Effect]) a.
(Reader (InputTEnv IO) :> es) =>
InputT IO a -> Eff es a
liftInputT (InputT IO (Maybe String) -> Eff es (Maybe String))
-> ((String, String) -> InputT IO (Maybe String))
-> (String, String)
-> Eff es (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, String) -> InputT IO (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> (String, String) -> InputT m (Maybe String)
H.getInputLineWithInitial String
s

-- | Lifted 'H.getInputChar'.
--
-- @since 0.1
getInputChar ::
  ( HasCallStack,
    Haskeline :> es,
    Reader (InputTEnv IO) :> es
  ) =>
  String ->
  Eff es (Maybe Char)
getInputChar :: forall (es :: [Effect]).
(HasCallStack, Haskeline :> es, Reader (InputTEnv IO) :> es) =>
String -> Eff es (Maybe Char)
getInputChar = InputT IO (Maybe Char) -> Eff es (Maybe Char)
forall (es :: [Effect]) a.
(Reader (InputTEnv IO) :> es) =>
InputT IO a -> Eff es a
liftInputT (InputT IO (Maybe Char) -> Eff es (Maybe Char))
-> (String -> InputT IO (Maybe Char))
-> String
-> Eff es (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> InputT IO (Maybe Char)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe Char)
H.getInputChar

-- | Lifted 'H.getPassword'.
--
-- @since 0.1
getPassword ::
  ( HasCallStack,
    Haskeline :> es,
    Reader (InputTEnv IO) :> es
  ) =>
  Maybe Char ->
  String ->
  Eff es (Maybe String)
getPassword :: forall (es :: [Effect]).
(HasCallStack, Haskeline :> es, Reader (InputTEnv IO) :> es) =>
Maybe Char -> String -> Eff es (Maybe String)
getPassword Maybe Char
c = InputT IO (Maybe String) -> Eff es (Maybe String)
forall (es :: [Effect]) a.
(Reader (InputTEnv IO) :> es) =>
InputT IO a -> Eff es a
liftInputT (InputT IO (Maybe String) -> Eff es (Maybe String))
-> (String -> InputT IO (Maybe String))
-> String
-> Eff es (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Char -> String -> InputT IO (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
Maybe Char -> String -> InputT m (Maybe String)
H.getPassword Maybe Char
c

-- | Lifted 'H.waitForAnyKey'.
--
-- @since 0.1
waitForAnyKey ::
  ( HasCallStack,
    Haskeline :> es,
    Reader (InputTEnv IO) :> es
  ) =>
  String ->
  Eff es Bool
waitForAnyKey :: forall (es :: [Effect]).
(HasCallStack, Haskeline :> es, Reader (InputTEnv IO) :> es) =>
String -> Eff es Bool
waitForAnyKey = InputT IO Bool -> Eff es Bool
forall (es :: [Effect]) a.
(Reader (InputTEnv IO) :> es) =>
InputT IO a -> Eff es a
liftInputT (InputT IO Bool -> Eff es Bool)
-> (String -> InputT IO Bool) -> String -> Eff es Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> InputT IO Bool
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m Bool
H.waitForAnyKey

-- | Lifted 'H.outputStr'.
--
-- @since 0.1
outputStr ::
  ( HasCallStack,
    Haskeline :> es,
    Reader (InputTEnv IO) :> es
  ) =>
  String ->
  Eff es ()
outputStr :: forall (es :: [Effect]).
(HasCallStack, Haskeline :> es, Reader (InputTEnv IO) :> es) =>
String -> Eff es ()
outputStr = InputT IO () -> Eff es ()
forall (es :: [Effect]) a.
(Reader (InputTEnv IO) :> es) =>
InputT IO a -> Eff es a
liftInputT (InputT IO () -> Eff es ())
-> (String -> InputT IO ()) -> String -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> InputT IO ()
forall (m :: * -> *). MonadIO m => String -> InputT m ()
H.outputStr

-- | Lifted 'H.outputStrLn'.
--
-- @since 0.1
outputStrLn ::
  ( HasCallStack,
    Haskeline :> es,
    Reader (InputTEnv IO) :> es
  ) =>
  String ->
  Eff es ()
outputStrLn :: forall (es :: [Effect]).
(HasCallStack, Haskeline :> es, Reader (InputTEnv IO) :> es) =>
String -> Eff es ()
outputStrLn = InputT IO () -> Eff es ()
forall (es :: [Effect]) a.
(Reader (InputTEnv IO) :> es) =>
InputT IO a -> Eff es a
liftInputT (InputT IO () -> Eff es ())
-> (String -> InputT IO ()) -> String -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> InputT IO ()
forall (m :: * -> *). MonadIO m => String -> InputT m ()
H.outputStrLn

-- | Lifted 'H.getHistory'.
--
-- @since 0.1
getHistory ::
  ( HasCallStack,
    Haskeline :> es,
    Reader (InputTEnv IO) :> es
  ) =>
  Eff es History
getHistory :: forall (es :: [Effect]).
(HasCallStack, Haskeline :> es, Reader (InputTEnv IO) :> es) =>
Eff es History
getHistory = InputT IO History -> Eff es History
forall (es :: [Effect]) a.
(Reader (InputTEnv IO) :> es) =>
InputT IO a -> Eff es a
liftInputT InputT IO History
forall (m :: * -> *). MonadIO m => InputT m History
H.getHistory

-- | Lifted 'H.putHistory'.
--
-- @since 0.1
putHistory ::
  ( HasCallStack,
    Haskeline :> es,
    Reader (InputTEnv IO) :> es
  ) =>
  History ->
  Eff es ()
putHistory :: forall (es :: [Effect]).
(HasCallStack, Haskeline :> es, Reader (InputTEnv IO) :> es) =>
History -> Eff es ()
putHistory = InputT IO () -> Eff es ()
forall (es :: [Effect]) a.
(Reader (InputTEnv IO) :> es) =>
InputT IO a -> Eff es a
liftInputT (InputT IO () -> Eff es ())
-> (History -> InputT IO ()) -> History -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. History -> InputT IO ()
forall (m :: * -> *). MonadIO m => History -> InputT m ()
H.putHistory

-- | Lifted 'H.modifyHistory'.
--
-- @since 0.1
modifyHistory ::
  ( HasCallStack,
    Haskeline :> es,
    Reader (InputTEnv IO) :> es
  ) =>
  (History -> History) ->
  Eff es ()
modifyHistory :: forall (es :: [Effect]).
(HasCallStack, Haskeline :> es, Reader (InputTEnv IO) :> es) =>
(History -> History) -> Eff es ()
modifyHistory = InputT IO () -> Eff es ()
forall (es :: [Effect]) a.
(Reader (InputTEnv IO) :> es) =>
InputT IO a -> Eff es a
liftInputT (InputT IO () -> Eff es ())
-> ((History -> History) -> InputT IO ())
-> (History -> History)
-> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (History -> History) -> InputT IO ()
forall (m :: * -> *).
MonadIO m =>
(History -> History) -> InputT m ()
H.modifyHistory

-- | Lifted 'H.withInterrupt'.
--
-- @since 0.1
withInterrupt ::
  ( HasCallStack,
    Haskeline :> es,
    Reader (InputTEnv IO) :> es
  ) =>
  Eff es a ->
  Eff es a
withInterrupt :: forall (es :: [Effect]) a.
(HasCallStack, Haskeline :> es, Reader (InputTEnv IO) :> es) =>
Eff es a -> Eff es a
withInterrupt Eff es a
action =
  (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
env -> Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall (es :: [Effect]) a.
HasCallStack =>
Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
seqUnliftIO Env es
env (((forall r. Eff es r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$
    \forall r. Eff es r -> IO r
runInIO ->
      Eff es a -> IO a
forall r. Eff es r -> IO r
runInIO (Eff es a -> IO a) -> Eff es a -> IO a
forall a b. (a -> b) -> a -> b
$
        InputT IO a -> Eff es a
forall (es :: [Effect]) a.
(Reader (InputTEnv IO) :> es) =>
InputT IO a -> Eff es a
liftInputT (InputT IO a -> Eff es a) -> InputT IO a -> Eff es a
forall a b. (a -> b) -> a -> b
$
          InputT IO a -> InputT IO a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
InputT m a -> InputT m a
H.withInterrupt (InputT IO a -> InputT IO a) -> InputT IO a -> InputT IO a
forall a b. (a -> b) -> a -> b
$
            IO a -> InputT IO a
forall a. IO a -> InputT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> InputT IO a) -> IO a -> InputT IO a
forall a b. (a -> b) -> a -> b
$
              Eff es a -> IO a
forall r. Eff es r -> IO r
runInIO Eff es a
action

-- | Lifted 'H.handleInterrupt'.
--
-- @since 0.1
handleInterrupt ::
  ( HasCallStack,
    Haskeline :> es,
    Reader (InputTEnv IO) :> es
  ) =>
  Eff es a ->
  Eff es a ->
  Eff es a
handleInterrupt :: forall (es :: [Effect]) a.
(HasCallStack, Haskeline :> es, Reader (InputTEnv IO) :> es) =>
Eff es a -> Eff es a -> Eff es a
handleInterrupt Eff es a
m1 Eff es a
m2 =
  (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
env -> Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall (es :: [Effect]) a.
HasCallStack =>
Env es -> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
seqUnliftIO Env es
env (((forall r. Eff es r -> IO r) -> IO a) -> IO a)
-> ((forall r. Eff es r -> IO r) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$
    \forall r. Eff es r -> IO r
runInIO ->
      Eff es a -> IO a
forall r. Eff es r -> IO r
runInIO (Eff es a -> IO a) -> Eff es a -> IO a
forall a b. (a -> b) -> a -> b
$
        InputT IO a -> Eff es a
forall (es :: [Effect]) a.
(Reader (InputTEnv IO) :> es) =>
InputT IO a -> Eff es a
liftInputT (InputT IO a -> Eff es a) -> InputT IO a -> Eff es a
forall a b. (a -> b) -> a -> b
$
          InputT IO a -> InputT IO a -> InputT IO a
forall (m :: * -> *) a. MonadMask m => m a -> m a -> m a
H.handleInterrupt (IO a -> InputT IO a
forall a. IO a -> InputT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> InputT IO a) -> IO a -> InputT IO a
forall a b. (a -> b) -> a -> b
$ Eff es a -> IO a
forall r. Eff es r -> IO r
runInIO Eff es a
m1) (IO a -> InputT IO a
forall a. IO a -> InputT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> InputT IO a) -> IO a -> InputT IO a
forall a b. (a -> b) -> a -> b
$ Eff es a -> IO a
forall r. Eff es r -> IO r
runInIO Eff es a
m2)

liftInputT :: (Reader (InputTEnv IO) :> es) => InputT IO a -> Eff es a
liftInputT :: forall (es :: [Effect]) a.
(Reader (InputTEnv IO) :> es) =>
InputT IO a -> Eff es a
liftInputT InputT IO a
f = Eff es (InputTEnv IO)
forall r (es :: [Effect]).
(HasCallStack, Reader r :> es) =>
Eff es r
ask Eff es (InputTEnv IO) -> (InputTEnv IO -> Eff es a) -> Eff es a
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO a -> Eff es a
forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ (IO a -> Eff es a)
-> (InputTEnv IO -> IO a) -> InputTEnv IO -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT (InputTEnv IO) IO a -> InputTEnv IO -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (InputT IO a -> ReaderT (InputTEnv IO) IO a
forall (m :: * -> *) a. InputT m a -> ReaderT (InputTEnv m) m a
HR.toReaderT InputT IO a
f)