{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Polysemy.Readline
(
Readline (..),
getInputLine,
getInputLineWithInitial,
getInputChar,
getPassword,
waitForAnyKey,
outputStr,
outputStrLn,
runReadline,
runReadlineFinal,
interpretReadlineAsInputT,
H.Settings (..),
H.defaultSettings,
H.runInputT,
)
where
import Control.Monad.Catch
import Control.Monad.IO.Class
import Polysemy
import Polysemy.Embed
import qualified System.Console.Haskeline as H
data Readline (m :: * -> *) a where
GetInputLine :: String -> Readline m (Maybe String)
GetInputLineWithInitial :: String -> (String, String) -> Readline m (Maybe String)
GetInputChar :: String -> Readline m (Maybe Char)
GetPassword :: Maybe Char -> String -> Readline m (Maybe String)
WaitForAnyKey :: String -> Readline m Bool
OutputStr :: String -> Readline m ()
makeSem ''Readline
outputStrLn :: Member Readline r => String -> Sem r ()
outputStrLn :: String -> Sem r ()
outputStrLn String
str = String -> Sem r ()
forall (r :: [Effect]).
MemberWithError Readline r =>
String -> Sem r ()
outputStr (String
str String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n")
runReadline ::
forall m r a.
(MonadIO m, MonadMask m, Member (Embed m) r) =>
H.Settings m ->
Sem (Readline : r) a ->
Sem r a
runReadline :: Settings m -> Sem (Readline : r) a -> Sem r a
runReadline Settings m
settings =
(forall x. InputT m x -> m x)
-> Sem (Embed (InputT m) : r) a -> Sem r a
forall (m1 :: * -> *) (m2 :: * -> *) (r :: [Effect]) a.
Member (Embed m2) r =>
(forall x. m1 x -> m2 x) -> Sem (Embed m1 : r) a -> Sem r a
runEmbedded (Settings m -> InputT m x -> m x
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Settings m -> InputT m a -> m a
H.runInputT Settings m
settings)
(Sem (Embed (InputT m) : r) a -> Sem r a)
-> (Sem (Readline : r) a -> Sem (Embed (InputT m) : r) a)
-> Sem (Readline : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Readline : Embed (InputT m) : r) a
-> Sem (Embed (InputT m) : r) a
forall (m :: * -> *) (r :: [Effect]) a.
(MonadIO m, MonadMask m, Member (Embed (InputT m)) r) =>
Sem (Readline : r) a -> Sem r a
interpretReadlineAsInputT
(Sem (Readline : Embed (InputT m) : r) a
-> Sem (Embed (InputT m) : r) a)
-> (Sem (Readline : r) a
-> Sem (Readline : Embed (InputT m) : r) a)
-> Sem (Readline : r) a
-> Sem (Embed (InputT m) : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e1 :: Effect) (r :: [Effect]) a.
Sem (e1 : r) a -> Sem (e1 : Embed (InputT m) : r) a
forall (e2 :: Effect) (e1 :: Effect) (r :: [Effect]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder @(Embed (H.InputT m))
runReadlineFinal ::
forall m r a.
(MonadIO m, MonadMask m, Member (Final (H.InputT m)) r) =>
Sem (Readline : r) a ->
Sem r a
runReadlineFinal :: Sem (Readline : r) a -> Sem r a
runReadlineFinal =
Sem (Embed (InputT m) : r) a -> Sem r a
forall (m :: * -> *) (r :: [Effect]) a.
(Member (Final m) r, Functor m) =>
Sem (Embed m : r) a -> Sem r a
embedToFinal
(Sem (Embed (InputT m) : r) a -> Sem r a)
-> (Sem (Readline : r) a -> Sem (Embed (InputT m) : r) a)
-> Sem (Readline : r) a
-> Sem r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sem (Readline : Embed (InputT m) : r) a
-> Sem (Embed (InputT m) : r) a
forall (m :: * -> *) (r :: [Effect]) a.
(MonadIO m, MonadMask m, Member (Embed (InputT m)) r) =>
Sem (Readline : r) a -> Sem r a
interpretReadlineAsInputT
(Sem (Readline : Embed (InputT m) : r) a
-> Sem (Embed (InputT m) : r) a)
-> (Sem (Readline : r) a
-> Sem (Readline : Embed (InputT m) : r) a)
-> Sem (Readline : r) a
-> Sem (Embed (InputT m) : r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e1 :: Effect) (r :: [Effect]) a.
Sem (e1 : r) a -> Sem (e1 : Embed (InputT m) : r) a
forall (e2 :: Effect) (e1 :: Effect) (r :: [Effect]) a.
Sem (e1 : r) a -> Sem (e1 : e2 : r) a
raiseUnder @(Embed (H.InputT m))
interpretReadlineAsInputT ::
forall m r a.
(MonadIO m, MonadMask m, Member (Embed (H.InputT m)) r) =>
Sem (Readline : r) a ->
Sem r a
interpretReadlineAsInputT :: Sem (Readline : r) a -> Sem r a
interpretReadlineAsInputT = (forall x (rInitial :: [Effect]).
Readline (Sem rInitial) x -> Sem r x)
-> Sem (Readline : r) a -> Sem r a
forall (e :: Effect) (r :: [Effect]) a.
FirstOrder e "interpret" =>
(forall x (rInitial :: [Effect]). e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall x (rInitial :: [Effect]).
Readline (Sem rInitial) x -> Sem r x)
-> Sem (Readline : r) a -> Sem r a)
-> (forall x (rInitial :: [Effect]).
Readline (Sem rInitial) x -> Sem r x)
-> Sem (Readline : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
GetInputLine prompt -> InputT m (Maybe String) -> Sem r (Maybe String)
forall (m :: * -> *) (r :: [Effect]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (InputT m (Maybe String) -> Sem r (Maybe String))
-> InputT m (Maybe String) -> Sem r (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> InputT m (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
H.getInputLine String
prompt
GetInputLineWithInitial prompt initial ->
InputT m (Maybe String) -> Sem r (Maybe String)
forall (m :: * -> *) (r :: [Effect]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (InputT m (Maybe String) -> Sem r (Maybe String))
-> InputT m (Maybe String) -> Sem r (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> (String, String) -> InputT m (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> (String, String) -> InputT m (Maybe String)
H.getInputLineWithInitial String
prompt (String, String)
initial
GetInputChar prompt -> InputT m (Maybe Char) -> Sem r (Maybe Char)
forall (m :: * -> *) (r :: [Effect]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (InputT m (Maybe Char) -> Sem r (Maybe Char))
-> InputT m (Maybe Char) -> Sem r (Maybe Char)
forall a b. (a -> b) -> a -> b
$ String -> InputT m (Maybe Char)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe Char)
H.getInputChar String
prompt
GetPassword maskChar prompt -> InputT m (Maybe String) -> Sem r (Maybe String)
forall (m :: * -> *) (r :: [Effect]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (InputT m (Maybe String) -> Sem r (Maybe String))
-> InputT m (Maybe String) -> Sem r (Maybe String)
forall a b. (a -> b) -> a -> b
$ Maybe Char -> String -> InputT m (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
Maybe Char -> String -> InputT m (Maybe String)
H.getPassword Maybe Char
maskChar String
prompt
WaitForAnyKey prompt -> InputT m Bool -> Sem r Bool
forall (m :: * -> *) (r :: [Effect]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (InputT m Bool -> Sem r Bool) -> InputT m Bool -> Sem r Bool
forall a b. (a -> b) -> a -> b
$ String -> InputT m Bool
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m Bool
H.waitForAnyKey String
prompt
OutputStr str -> InputT m () -> Sem r ()
forall (m :: * -> *) (r :: [Effect]) a.
Member (Embed m) r =>
m a -> Sem r a
embed (InputT m () -> Sem r ()) -> InputT m () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ String -> InputT m ()
forall (m :: * -> *). MonadIO m => String -> InputT m ()
H.outputStr String
str