{-# OPTIONS_HADDOCK hide #-}

-- |
--
-- Copyright:
--   This file is part of the package byline. It is subject to the
--   license terms in the LICENSE file found in the top-level
--   directory of this distribution and at:
--
--     https://github.com/pjones/byline
--
--   No part of this package, including this file, may be copied,
--   modified, propagated, or distributed except according to the
--   terms contained in the LICENSE file.
--
-- License: BSD-2-Clause
module Byline.Internal.Eval
  ( MonadByline (..),
    BylineT,
    runBylineT,
    Settings (..),
    defaultBylineSettings,
    runBylineT',
    defaultRenderMode,
  )
where

import Byline.Internal.Completion
import Byline.Internal.Prim (PrimF (..))
import Byline.Internal.Stylized
import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
import Control.Monad.Cont (ContT, MonadCont)
import Control.Monad.Except (MonadError)
import qualified Control.Monad.State.Lazy as LState
import qualified Control.Monad.Trans.Free.Church as Free
import qualified System.Console.ANSI as ANSI
import qualified System.Console.Haskeline as Haskeline
import qualified System.Environment as System
import qualified System.Terminfo as Terminfo
import qualified System.Terminfo.Caps as Terminfo

-- | A class of types that can lift Byline operations into a base
-- monad.
--
-- @since 1.0.0.0
class Monad m => MonadByline (m :: * -> *) where
  liftByline :: Free.F PrimF a -> m a
  default liftByline :: (MonadTrans t, MonadByline m1, m ~ t m1) => Free.F PrimF a -> m a
  liftByline = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadByline m => F PrimF a -> m a
liftByline

instance MonadByline m => MonadByline (ExceptT e m)

instance MonadByline m => MonadByline (StateT s m)

instance MonadByline m => MonadByline (LState.StateT s m)

instance MonadByline m => MonadByline (ReaderT r m)

instance MonadByline m => MonadByline (IdentityT m)

instance MonadByline m => MonadByline (ContT r m)

-- | A monad transformer that implements 'MonadByline'.
--
-- @since 1.0.0.0
newtype BylineT m a = BylineT
  {forall (m :: * -> *) a. BylineT m a -> FT PrimF m a
unBylineT :: Free.FT PrimF m a}
  deriving newtype
    ( forall a b. a -> BylineT m b -> BylineT m a
forall a b. (a -> b) -> BylineT m a -> BylineT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) a b. a -> BylineT m b -> BylineT m a
forall (m :: * -> *) a b. (a -> b) -> BylineT m a -> BylineT m b
<$ :: forall a b. a -> BylineT m b -> BylineT m a
$c<$ :: forall (m :: * -> *) a b. a -> BylineT m b -> BylineT m a
fmap :: forall a b. (a -> b) -> BylineT m a -> BylineT m b
$cfmap :: forall (m :: * -> *) a b. (a -> b) -> BylineT m a -> BylineT m b
Functor,
      forall a. a -> BylineT m a
forall a b. BylineT m a -> BylineT m b -> BylineT m a
forall a b. BylineT m a -> BylineT m b -> BylineT m b
forall a b. BylineT m (a -> b) -> BylineT m a -> BylineT m b
forall a b c.
(a -> b -> c) -> BylineT m a -> BylineT m b -> BylineT m c
forall (m :: * -> *). Functor (BylineT m)
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 :: * -> *) a. a -> BylineT m a
forall (m :: * -> *) a b. BylineT m a -> BylineT m b -> BylineT m a
forall (m :: * -> *) a b. BylineT m a -> BylineT m b -> BylineT m b
forall (m :: * -> *) a b.
BylineT m (a -> b) -> BylineT m a -> BylineT m b
forall (m :: * -> *) a b c.
(a -> b -> c) -> BylineT m a -> BylineT m b -> BylineT m c
<* :: forall a b. BylineT m a -> BylineT m b -> BylineT m a
$c<* :: forall (m :: * -> *) a b. BylineT m a -> BylineT m b -> BylineT m a
*> :: forall a b. BylineT m a -> BylineT m b -> BylineT m b
$c*> :: forall (m :: * -> *) a b. BylineT m a -> BylineT m b -> BylineT m b
liftA2 :: forall a b c.
(a -> b -> c) -> BylineT m a -> BylineT m b -> BylineT m c
$cliftA2 :: forall (m :: * -> *) a b c.
(a -> b -> c) -> BylineT m a -> BylineT m b -> BylineT m c
<*> :: forall a b. BylineT m (a -> b) -> BylineT m a -> BylineT m b
$c<*> :: forall (m :: * -> *) a b.
BylineT m (a -> b) -> BylineT m a -> BylineT m b
pure :: forall a. a -> BylineT m a
$cpure :: forall (m :: * -> *) a. a -> BylineT m a
Applicative,
      forall a. a -> BylineT m a
forall a b. BylineT m a -> BylineT m b -> BylineT m b
forall a b. BylineT m a -> (a -> BylineT m b) -> BylineT m b
forall (m :: * -> *). Applicative (BylineT m)
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
forall (m :: * -> *) a. a -> BylineT m a
forall (m :: * -> *) a b. BylineT m a -> BylineT m b -> BylineT m b
forall (m :: * -> *) a b.
BylineT m a -> (a -> BylineT m b) -> BylineT m b
return :: forall a. a -> BylineT m a
$creturn :: forall (m :: * -> *) a. a -> BylineT m a
>> :: forall a b. BylineT m a -> BylineT m b -> BylineT m b
$c>> :: forall (m :: * -> *) a b. BylineT m a -> BylineT m b -> BylineT m b
>>= :: forall a b. BylineT m a -> (a -> BylineT m b) -> BylineT m b
$c>>= :: forall (m :: * -> *) a b.
BylineT m a -> (a -> BylineT m b) -> BylineT m b
Monad,
      forall a. IO a -> BylineT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (BylineT m)
forall (m :: * -> *) a. MonadIO m => IO a -> BylineT m a
liftIO :: forall a. IO a -> BylineT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> BylineT m a
MonadIO,
      MonadState s,
      MonadReader r,
      MonadError e,
      forall a b. ((a -> BylineT m b) -> BylineT m a) -> BylineT m a
forall (m :: * -> *).
Monad m -> (forall a b. ((a -> m b) -> m a) -> m a) -> MonadCont m
forall {m :: * -> *}. MonadCont m => Monad (BylineT m)
forall (m :: * -> *) a b.
MonadCont m =>
((a -> BylineT m b) -> BylineT m a) -> BylineT m a
callCC :: forall a b. ((a -> BylineT m b) -> BylineT m a) -> BylineT m a
$ccallCC :: forall (m :: * -> *) a b.
MonadCont m =>
((a -> BylineT m b) -> BylineT m a) -> BylineT m a
MonadCont,
      forall e a. Exception e => e -> BylineT m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall {m :: * -> *}. MonadThrow m => Monad (BylineT m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> BylineT m a
throwM :: forall e a. Exception e => e -> BylineT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> BylineT m a
MonadThrow,
      forall e a.
Exception e =>
BylineT m a -> (e -> BylineT m a) -> BylineT 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 (BylineT m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
BylineT m a -> (e -> BylineT m a) -> BylineT m a
catch :: forall e a.
Exception e =>
BylineT m a -> (e -> BylineT m a) -> BylineT m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
BylineT m a -> (e -> BylineT m a) -> BylineT m a
MonadCatch
    )

instance MonadTrans BylineT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> BylineT m a
lift = forall (m :: * -> *) a. FT PrimF m a -> BylineT m a
BylineT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance MonadByline (BylineT m) where
  liftByline :: forall a. F PrimF a -> BylineT m a
liftByline = forall (m :: * -> *) a. FT PrimF m a -> BylineT m a
BylineT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (m :: * -> *) a.
(Functor f, MonadFree f m) =>
F f a -> m a
Free.fromF

-- | Mutable list of completion functions.
--
-- @since 1.0.0.0
type CompRef m = IORef [CompletionFunc m]

-- | Discharge the 'MonadByline' effect by running all operations and
-- returning the result in the base monad.
--
-- The result is wrapped in a 'Maybe' where a 'Nothing' value
-- indicates that an end-of-file (EOF) signal was received while
-- reading user input.
--
-- @since 1.0.0.0
runBylineT ::
  (MonadIO m, MonadMask m) =>
  BylineT m a ->
  m (Maybe a)
runBylineT :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
BylineT m a -> m (Maybe a)
runBylineT = forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Settings -> BylineT m a -> m (Maybe a)
runBylineT' Settings
defaultBylineSettings

-- | Settings that control Byline at run time.
--
-- @since 1.0.0.0
data Settings = Settings
  { -- | The output handle to write to.  If 'Nothing' use standard
    -- output.
    --
    -- NOTE: This only affects Byline (i.e. functions that use
    -- @say@).  Functions like @ask@ that invoke Haskeline will always
    -- use standard output since that's the hard-coded default.
    Settings -> Maybe Handle
bylineOutput :: Maybe Handle,
    -- | The input handle to read from.  If 'Nothing' use standard
    -- input.
    Settings -> Maybe Handle
bylineInput :: Maybe Handle,
    -- | Override the detected render mode.
    --
    -- If 'Nothing' use the render mode that is calculated based on
    -- the type of handle Byline writes to.
    Settings -> Maybe RenderMode
bylineMode :: Maybe RenderMode
  }

-- | The default Byline settings.
--
-- @since 1.0.0.0
defaultBylineSettings :: Settings
defaultBylineSettings :: Settings
defaultBylineSettings = Maybe Handle -> Maybe Handle -> Maybe RenderMode -> Settings
Settings forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

-- | Like 'runBylineT' except you can override the settings.
--
-- @since 1.0.0.0
runBylineT' ::
  forall m a.
  (MonadIO m, MonadMask m) =>
  Settings ->
  BylineT m a ->
  m (Maybe a)
runBylineT' :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Settings -> BylineT m a -> m (Maybe a)
runBylineT' Settings {Maybe Handle
Maybe RenderMode
bylineMode :: Maybe RenderMode
bylineInput :: Maybe Handle
bylineOutput :: Maybe Handle
bylineMode :: Settings -> Maybe RenderMode
bylineInput :: Settings -> Maybe Handle
bylineOutput :: Settings -> Maybe Handle
..} BylineT m a
m = do
  IORef [CompletionFunc IO]
compRef <- forall (m :: * -> *) a. MonadIO m => a -> m (IORef a)
newIORef []
  let settings :: Settings m
settings =
        forall (m :: * -> *). CompletionFunc m -> Settings m -> Settings m
Haskeline.setComplete
          (IORef [CompletionFunc IO] -> CompletionFunc m
compFunc IORef [CompletionFunc IO]
compRef)
          forall (m :: * -> *). MonadIO m => Settings m
Haskeline.defaultSettings
  let behavior :: Behavior
behavior =
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          Behavior
Haskeline.defaultBehavior
          Handle -> Behavior
Haskeline.useFileHandle
          Maybe Handle
bylineInput
  let hOut :: Handle
hOut = forall a. a -> Maybe a -> a
fromMaybe Handle
stdout Maybe Handle
bylineOutput
  forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Behavior -> Settings m -> InputT m a -> m a
Haskeline.runInputTBehavior Behavior
behavior Settings m
settings (IORef [CompletionFunc IO] -> Handle -> InputT m (Maybe a)
go IORef [CompletionFunc IO]
compRef Handle
hOut)
  where
    compFunc :: CompRef IO -> Haskeline.CompletionFunc m
    compFunc :: IORef [CompletionFunc IO] -> CompletionFunc m
compFunc IORef [CompletionFunc IO]
compRef (String, String)
input = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a. MonadIO m => IORef a -> m a
readIORef IORef [CompletionFunc IO]
compRef forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        [] -> forall (m :: * -> *). MonadIO m => CompletionFunc m
Haskeline.completeFilename (String, String)
input
        [CompletionFunc IO]
fs -> forall (m :: * -> *).
Monad m =>
[CompletionFunc m] -> CompletionFunc m
runCompletionFunctions [CompletionFunc IO]
fs (String, String)
input
    go ::
      CompRef IO ->
      Handle ->
      Haskeline.InputT m (Maybe a)
    go :: IORef [CompletionFunc IO] -> Handle -> InputT m (Maybe a)
go IORef [CompletionFunc IO]
compRef Handle
hOut = do
      RenderMode
mode <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> IO RenderMode
defaultRenderMode Handle
hOut)) forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe RenderMode
bylineMode
      forall (m :: * -> *) a. BylineT m a -> FT PrimF m a
unBylineT BylineT m a
m
        forall a b. a -> (a -> b) -> b
& forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RenderMode
-> Handle -> IORef [CompletionFunc IO] -> FT PrimF m a -> EvalT m a
evalPrimF RenderMode
mode Handle
hOut IORef [CompletionFunc IO]
compRef
        forall a b. a -> (a -> b) -> b
& forall (m :: * -> *) a. EvalT m a -> MaybeT (InputT m) a
unEvalT
        forall a b. a -> (a -> b) -> b
& forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT

-- | Internal transformer for evaluating primitive operations in the
-- 'Haskeline.InputT' transformer with EOF handling.
--
-- @since 1.0.0.0
newtype EvalT m a = EvalT
  {forall (m :: * -> *) a. EvalT m a -> MaybeT (InputT m) a
unEvalT :: MaybeT (Haskeline.InputT m) a}
  deriving newtype (forall a b. a -> EvalT m b -> EvalT m a
forall a b. (a -> b) -> EvalT m a -> EvalT m b
forall (m :: * -> *) a b. Functor m => a -> EvalT m b -> EvalT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> EvalT m a -> EvalT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> EvalT m b -> EvalT m a
$c<$ :: forall (m :: * -> *) a b. Functor m => a -> EvalT m b -> EvalT m a
fmap :: forall a b. (a -> b) -> EvalT m a -> EvalT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> EvalT m a -> EvalT m b
Functor, forall a. a -> EvalT m a
forall a b. EvalT m a -> EvalT m b -> EvalT m a
forall a b. EvalT m a -> EvalT m b -> EvalT m b
forall a b. EvalT m (a -> b) -> EvalT m a -> EvalT m b
forall a b c. (a -> b -> c) -> EvalT m a -> EvalT m b -> EvalT m c
forall {m :: * -> *}. Monad m => Functor (EvalT m)
forall (m :: * -> *) a. Monad m => a -> EvalT m a
forall (m :: * -> *) a b.
Monad m =>
EvalT m a -> EvalT m b -> EvalT m a
forall (m :: * -> *) a b.
Monad m =>
EvalT m a -> EvalT m b -> EvalT m b
forall (m :: * -> *) a b.
Monad m =>
EvalT m (a -> b) -> EvalT m a -> EvalT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> EvalT m a -> EvalT m b -> EvalT 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 a b. EvalT m a -> EvalT m b -> EvalT m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
EvalT m a -> EvalT m b -> EvalT m a
*> :: forall a b. EvalT m a -> EvalT m b -> EvalT m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
EvalT m a -> EvalT m b -> EvalT m b
liftA2 :: forall a b c. (a -> b -> c) -> EvalT m a -> EvalT m b -> EvalT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> EvalT m a -> EvalT m b -> EvalT m c
<*> :: forall a b. EvalT m (a -> b) -> EvalT m a -> EvalT m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
EvalT m (a -> b) -> EvalT m a -> EvalT m b
pure :: forall a. a -> EvalT m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> EvalT m a
Applicative, forall a. a -> EvalT m a
forall a b. EvalT m a -> EvalT m b -> EvalT m b
forall a b. EvalT m a -> (a -> EvalT m b) -> EvalT m b
forall (m :: * -> *). Monad m => Applicative (EvalT m)
forall (m :: * -> *) a. Monad m => a -> EvalT m a
forall (m :: * -> *) a b.
Monad m =>
EvalT m a -> EvalT m b -> EvalT m b
forall (m :: * -> *) a b.
Monad m =>
EvalT m a -> (a -> EvalT m b) -> EvalT 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 :: forall a. a -> EvalT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> EvalT m a
>> :: forall a b. EvalT m a -> EvalT m b -> EvalT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
EvalT m a -> EvalT m b -> EvalT m b
>>= :: forall a b. EvalT m a -> (a -> EvalT m b) -> EvalT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
EvalT m a -> (a -> EvalT m b) -> EvalT m b
Monad, forall a. IO a -> EvalT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall {m :: * -> *}. MonadIO m => Monad (EvalT m)
forall (m :: * -> *) a. MonadIO m => IO a -> EvalT m a
liftIO :: forall a. IO a -> EvalT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> EvalT m a
MonadIO)

instance MonadTrans EvalT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> EvalT m a
lift = forall (m :: * -> *) a. MaybeT (InputT m) a -> EvalT m a
EvalT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | Evaluate 'PrimF' values.
--
-- @since 1.0.0.0
evalPrimF ::
  forall m a.
  (MonadIO m, MonadMask m) =>
  RenderMode ->
  Handle ->
  CompRef IO ->
  Free.FT PrimF m a ->
  EvalT m a
evalPrimF :: forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RenderMode
-> Handle -> IORef [CompletionFunc IO] -> FT PrimF m a -> EvalT m a
evalPrimF RenderMode
renderMode Handle
outputHandle IORef [CompletionFunc IO]
compRef = forall (f :: * -> *) (m :: * -> *) (t :: (* -> *) -> * -> *) a.
(Functor f, Monad m, MonadTrans t, Monad (t m)) =>
(f (t m a) -> t m a) -> FT f m a -> t m a
Free.iterTM PrimF (EvalT m a) -> EvalT m a
go
  where
    go ::
      PrimF (EvalT m a) ->
      EvalT m a
    go :: PrimF (EvalT m a) -> EvalT m a
go = \case
      Say Stylized Text
s EvalT m a
k ->
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (RenderMode -> Handle -> Stylized Text -> IO ()
render RenderMode
renderMode Handle
outputHandle Stylized Text
s) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EvalT m a
k
      AskLn Stylized Text
s Maybe Text
d Text -> EvalT m a
k -> do
        let prompt :: Text
prompt =
              RenderMode -> Stylized Text -> Text
renderText RenderMode
renderMode forall a b. (a -> b) -> a -> b
$
                forall b a. b -> (a -> b) -> Maybe a -> b
maybe Stylized Text
s (\Text
d' -> Stylized Text
s forall a. Semigroup a => a -> a -> a
<> Text -> Stylized Text
text Text
"[" forall a. Semigroup a => a -> a -> a
<> Text -> Stylized Text
text Text
d' forall a. Semigroup a => a -> a -> a
<> Text -> Stylized Text
text Text
"] ") Maybe Text
d
        forall b. InputT m b -> EvalT m b
liftHaskeline (forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
Haskeline.getInputLine (forall a. ToString a => a -> String
toString Text
prompt)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe String
Nothing -> forall (m :: * -> *) a. MaybeT (InputT m) a -> EvalT m a
EvalT forall (f :: * -> *) a. Alternative f => f a
empty
          Just String
answer
            | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
answer -> Text -> EvalT m a
k (forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty Maybe Text
d)
            | Bool
otherwise -> Text -> EvalT m a
k (forall a. ToText a => a -> Text
toText String
answer)
      AskChar Stylized Text
s Char -> EvalT m a
k -> do
        let prompt :: String
prompt = forall a. ToString a => a -> String
toString (RenderMode -> Stylized Text -> Text
renderText RenderMode
renderMode Stylized Text
s)
        forall b. InputT m b -> EvalT m b
liftHaskeline (forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe Char)
Haskeline.getInputChar String
prompt) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe Char
Nothing -> forall (m :: * -> *) a. MaybeT (InputT m) a -> EvalT m a
EvalT forall (f :: * -> *) a. Alternative f => f a
empty
          Just Char
c -> Char -> EvalT m a
k Char
c
      AskPassword Stylized Text
s Maybe Char
m Text -> EvalT m a
k -> do
        let prompt :: String
prompt = forall a. ToString a => a -> String
toString (RenderMode -> Stylized Text -> Text
renderText RenderMode
renderMode Stylized Text
s)
        forall b. InputT m b -> EvalT m b
liftHaskeline (forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
Maybe Char -> String -> InputT m (Maybe String)
Haskeline.getPassword Maybe Char
m String
prompt) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe String
Nothing -> forall (m :: * -> *) a. MaybeT (InputT m) a -> EvalT m a
EvalT forall (f :: * -> *) a. Alternative f => f a
empty
          Just String
str -> Text -> EvalT m a
k (forall a. ToText a => a -> Text
toText String
str)
      PushCompFunc CompletionFunc IO
f EvalT m a
k ->
        forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef' IORef [CompletionFunc IO]
compRef (CompletionFunc IO
f forall a. a -> [a] -> [a]
:) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EvalT m a
k
      PopCompFunc EvalT m a
k ->
        forall (m :: * -> *) a. MonadIO m => IORef a -> (a -> a) -> m ()
modifyIORef'
          IORef [CompletionFunc IO]
compRef
          ( \case
              [] -> []
              (CompletionFunc IO
_ : [CompletionFunc IO]
fs) -> [CompletionFunc IO]
fs
          )
          forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EvalT m a
k
    liftHaskeline :: Haskeline.InputT m b -> EvalT m b
    liftHaskeline :: forall b. InputT m b -> EvalT m b
liftHaskeline = forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
InputT m a -> InputT m a
Haskeline.withInterrupt forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (m :: * -> *) a. MaybeT (InputT m) a -> EvalT m a
EvalT

-- | Calculate the default rendering mode based on the terminal type.
defaultRenderMode :: Handle -> IO RenderMode
defaultRenderMode :: Handle -> IO RenderMode
defaultRenderMode Handle
hOut = do
  Bool
isTerm <- Handle -> IO Bool
ANSI.hSupportsANSI Handle
hOut
  if Bool
isTerm
    then forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT IO Int
getMaxColors forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe Int
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure RenderMode
Simple
      Just Int
n
        | Int
n forall a. Ord a => a -> a -> Bool
< Int
256 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure RenderMode
Simple
        | Int
n forall a. Ord a => a -> a -> Bool
> Int
256 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure RenderMode
TermRGB
        | Bool
otherwise -> forall (f :: * -> *) a. Applicative f => a -> f a
pure RenderMode
Term256
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure RenderMode
Plain
  where
    getMaxColors :: MaybeT IO Int
    getMaxColors :: MaybeT IO Int
getMaxColors = do
      String
term <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (String -> IO (Maybe String)
System.lookupEnv String
"TERM")
      forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (String -> IO (Either String TIDatabase)
Terminfo.acquireDatabase String
term) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left String
_ -> forall (f :: * -> *) a. Alternative f => f a
empty
        Right TIDatabase
db ->
          forall (m :: * -> *) a. Applicative m => Maybe a -> MaybeT m a
hoistMaybe forall a b. (a -> b) -> a -> b
$
            TIDatabase -> NumTermCap -> Maybe Int
Terminfo.queryNumTermCap TIDatabase
db NumTermCap
Terminfo.MaxColors