{-# OPTIONS_HADDOCK hide #-}
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
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)
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
type CompRef m = IORef [CompletionFunc m]
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
data Settings = Settings
{
Settings -> Maybe Handle
bylineOutput :: Maybe Handle,
Settings -> Maybe Handle
bylineInput :: Maybe Handle,
Settings -> Maybe RenderMode
bylineMode :: Maybe RenderMode
}
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
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
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
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
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