{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}
module System.Terminal.TerminalT
  ( TerminalT ()
  , runTerminalT
  )
where

import           Control.Monad.Catch
import           Control.Monad.IO.Class
import           Control.Monad.STM
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Reader
import           Data.Foldable                      (forM_)
import qualified Data.Text                       as Text
import           Prelude                     hiding (putChar)

import           System.Terminal.MonadInput
import           System.Terminal.MonadPrinter
import           System.Terminal.MonadScreen
import           System.Terminal.MonadTerminal
import qualified System.Terminal.Terminal        as T

-- | This monad transformer represents terminal applications.
--
-- It implements all classes in this module and should serve as a good
-- foundation for most use cases.
--
-- Note that it is not necessary nor recommended to have this type in
-- every signature. Keep your application abstract and mention `TerminalT`
-- only once at the top level.
--
-- Example:
--
-- @
-- main :: IO ()
-- main = `withTerminal` (`runTerminalT` myApplication)
--
-- myApplication :: (`MonadPrinter` m) => m ()
-- myApplication = do
--     `putTextLn` "Hello world!"
--     `flush`
-- @
newtype TerminalT t m a
    = TerminalT (ReaderT t m a)
    deriving ((forall a b. (a -> b) -> TerminalT t m a -> TerminalT t m b)
-> (forall a b. a -> TerminalT t m b -> TerminalT t m a)
-> Functor (TerminalT t m)
forall a b. a -> TerminalT t m b -> TerminalT t m a
forall a b. (a -> b) -> TerminalT t m a -> TerminalT t m b
forall t (m :: * -> *) a b.
Functor m =>
a -> TerminalT t m b -> TerminalT t m a
forall t (m :: * -> *) a b.
Functor m =>
(a -> b) -> TerminalT t m a -> TerminalT t 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 t (m :: * -> *) a b.
Functor m =>
(a -> b) -> TerminalT t m a -> TerminalT t m b
fmap :: forall a b. (a -> b) -> TerminalT t m a -> TerminalT t m b
$c<$ :: forall t (m :: * -> *) a b.
Functor m =>
a -> TerminalT t m b -> TerminalT t m a
<$ :: forall a b. a -> TerminalT t m b -> TerminalT t m a
Functor, Functor (TerminalT t m)
Functor (TerminalT t m) =>
(forall a. a -> TerminalT t m a)
-> (forall a b.
    TerminalT t m (a -> b) -> TerminalT t m a -> TerminalT t m b)
-> (forall a b c.
    (a -> b -> c)
    -> TerminalT t m a -> TerminalT t m b -> TerminalT t m c)
-> (forall a b.
    TerminalT t m a -> TerminalT t m b -> TerminalT t m b)
-> (forall a b.
    TerminalT t m a -> TerminalT t m b -> TerminalT t m a)
-> Applicative (TerminalT t m)
forall a. a -> TerminalT t m a
forall a b. TerminalT t m a -> TerminalT t m b -> TerminalT t m a
forall a b. TerminalT t m a -> TerminalT t m b -> TerminalT t m b
forall a b.
TerminalT t m (a -> b) -> TerminalT t m a -> TerminalT t m b
forall a b c.
(a -> b -> c)
-> TerminalT t m a -> TerminalT t m b -> TerminalT t m c
forall t (m :: * -> *). Applicative m => Functor (TerminalT t m)
forall t (m :: * -> *) a. Applicative m => a -> TerminalT t m a
forall t (m :: * -> *) a b.
Applicative m =>
TerminalT t m a -> TerminalT t m b -> TerminalT t m a
forall t (m :: * -> *) a b.
Applicative m =>
TerminalT t m a -> TerminalT t m b -> TerminalT t m b
forall t (m :: * -> *) a b.
Applicative m =>
TerminalT t m (a -> b) -> TerminalT t m a -> TerminalT t m b
forall t (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> TerminalT t m a -> TerminalT t m b -> TerminalT t 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 t (m :: * -> *) a. Applicative m => a -> TerminalT t m a
pure :: forall a. a -> TerminalT t m a
$c<*> :: forall t (m :: * -> *) a b.
Applicative m =>
TerminalT t m (a -> b) -> TerminalT t m a -> TerminalT t m b
<*> :: forall a b.
TerminalT t m (a -> b) -> TerminalT t m a -> TerminalT t m b
$cliftA2 :: forall t (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> TerminalT t m a -> TerminalT t m b -> TerminalT t m c
liftA2 :: forall a b c.
(a -> b -> c)
-> TerminalT t m a -> TerminalT t m b -> TerminalT t m c
$c*> :: forall t (m :: * -> *) a b.
Applicative m =>
TerminalT t m a -> TerminalT t m b -> TerminalT t m b
*> :: forall a b. TerminalT t m a -> TerminalT t m b -> TerminalT t m b
$c<* :: forall t (m :: * -> *) a b.
Applicative m =>
TerminalT t m a -> TerminalT t m b -> TerminalT t m a
<* :: forall a b. TerminalT t m a -> TerminalT t m b -> TerminalT t m a
Applicative, Applicative (TerminalT t m)
Applicative (TerminalT t m) =>
(forall a b.
 TerminalT t m a -> (a -> TerminalT t m b) -> TerminalT t m b)
-> (forall a b.
    TerminalT t m a -> TerminalT t m b -> TerminalT t m b)
-> (forall a. a -> TerminalT t m a)
-> Monad (TerminalT t m)
forall a. a -> TerminalT t m a
forall a b. TerminalT t m a -> TerminalT t m b -> TerminalT t m b
forall a b.
TerminalT t m a -> (a -> TerminalT t m b) -> TerminalT t m b
forall t (m :: * -> *). Monad m => Applicative (TerminalT t m)
forall t (m :: * -> *) a. Monad m => a -> TerminalT t m a
forall t (m :: * -> *) a b.
Monad m =>
TerminalT t m a -> TerminalT t m b -> TerminalT t m b
forall t (m :: * -> *) a b.
Monad m =>
TerminalT t m a -> (a -> TerminalT t m b) -> TerminalT t 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 t (m :: * -> *) a b.
Monad m =>
TerminalT t m a -> (a -> TerminalT t m b) -> TerminalT t m b
>>= :: forall a b.
TerminalT t m a -> (a -> TerminalT t m b) -> TerminalT t m b
$c>> :: forall t (m :: * -> *) a b.
Monad m =>
TerminalT t m a -> TerminalT t m b -> TerminalT t m b
>> :: forall a b. TerminalT t m a -> TerminalT t m b -> TerminalT t m b
$creturn :: forall t (m :: * -> *) a. Monad m => a -> TerminalT t m a
return :: forall a. a -> TerminalT t m a
Monad, Monad (TerminalT t m)
Monad (TerminalT t m) =>
(forall a. IO a -> TerminalT t m a) -> MonadIO (TerminalT t m)
forall a. IO a -> TerminalT t m a
forall t (m :: * -> *). MonadIO m => Monad (TerminalT t m)
forall t (m :: * -> *) a. MonadIO m => IO a -> TerminalT t m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall t (m :: * -> *) a. MonadIO m => IO a -> TerminalT t m a
liftIO :: forall a. IO a -> TerminalT t m a
MonadIO, Monad (TerminalT t m)
Monad (TerminalT t m) =>
(forall e a. (HasCallStack, Exception e) => e -> TerminalT t m a)
-> MonadThrow (TerminalT t m)
forall e a. (HasCallStack, Exception e) => e -> TerminalT t m a
forall t (m :: * -> *). MonadThrow m => Monad (TerminalT t m)
forall t (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> TerminalT t m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall t (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> TerminalT t m a
throwM :: forall e a. (HasCallStack, Exception e) => e -> TerminalT t m a
MonadThrow, MonadThrow (TerminalT t m)
MonadThrow (TerminalT t m) =>
(forall e a.
 (HasCallStack, Exception e) =>
 TerminalT t m a -> (e -> TerminalT t m a) -> TerminalT t m a)
-> MonadCatch (TerminalT t m)
forall e a.
(HasCallStack, Exception e) =>
TerminalT t m a -> (e -> TerminalT t m a) -> TerminalT t m a
forall t (m :: * -> *). MonadCatch m => MonadThrow (TerminalT t m)
forall t (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
TerminalT t m a -> (e -> TerminalT t m a) -> TerminalT t m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall t (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
TerminalT t m a -> (e -> TerminalT t m a) -> TerminalT t m a
catch :: forall e a.
(HasCallStack, Exception e) =>
TerminalT t m a -> (e -> TerminalT t m a) -> TerminalT t m a
MonadCatch, MonadCatch (TerminalT t m)
MonadCatch (TerminalT t m) =>
(forall b.
 HasCallStack =>
 ((forall a. TerminalT t m a -> TerminalT t m a) -> TerminalT t m b)
 -> TerminalT t m b)
-> (forall b.
    HasCallStack =>
    ((forall a. TerminalT t m a -> TerminalT t m a) -> TerminalT t m b)
    -> TerminalT t m b)
-> (forall a b c.
    HasCallStack =>
    TerminalT t m a
    -> (a -> ExitCase b -> TerminalT t m c)
    -> (a -> TerminalT t m b)
    -> TerminalT t m (b, c))
-> MonadMask (TerminalT t m)
forall b.
HasCallStack =>
((forall a. TerminalT t m a -> TerminalT t m a) -> TerminalT t m b)
-> TerminalT t m b
forall a b c.
HasCallStack =>
TerminalT t m a
-> (a -> ExitCase b -> TerminalT t m c)
-> (a -> TerminalT t m b)
-> TerminalT t m (b, c)
forall t (m :: * -> *). MonadMask m => MonadCatch (TerminalT t m)
forall t (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. TerminalT t m a -> TerminalT t m a) -> TerminalT t m b)
-> TerminalT t m b
forall t (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
TerminalT t m a
-> (a -> ExitCase b -> TerminalT t m c)
-> (a -> TerminalT t m b)
-> TerminalT t m (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall t (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. TerminalT t m a -> TerminalT t m a) -> TerminalT t m b)
-> TerminalT t m b
mask :: forall b.
HasCallStack =>
((forall a. TerminalT t m a -> TerminalT t m a) -> TerminalT t m b)
-> TerminalT t m b
$cuninterruptibleMask :: forall t (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. TerminalT t m a -> TerminalT t m a) -> TerminalT t m b)
-> TerminalT t m b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. TerminalT t m a -> TerminalT t m a) -> TerminalT t m b)
-> TerminalT t m b
$cgeneralBracket :: forall t (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
TerminalT t m a
-> (a -> ExitCase b -> TerminalT t m c)
-> (a -> TerminalT t m b)
-> TerminalT t m (b, c)
generalBracket :: forall a b c.
HasCallStack =>
TerminalT t m a
-> (a -> ExitCase b -> TerminalT t m c)
-> (a -> TerminalT t m b)
-> TerminalT t m (b, c)
MonadMask)

-- | Run a `TerminalT` application on the given terminal.
runTerminalT :: (MonadIO m, MonadMask m, T.Terminal t) => TerminalT t m a -> t -> m a
runTerminalT :: forall (m :: * -> *) t a.
(MonadIO m, MonadMask m, Terminal t) =>
TerminalT t m a -> t -> m a
runTerminalT TerminalT t m a
tma t
t = ReaderT t m a -> t -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT t m a
ma t
t
    where
        TerminalT ReaderT t m a
ma = TerminalT t m a
tma

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

instance (MonadIO m, T.Terminal t) => MonadInput (TerminalT t m) where
    awaitWith :: forall a. (STM Interrupt -> STM Event -> STM a) -> TerminalT t m a
awaitWith STM Interrupt -> STM Event -> STM a
f = ReaderT t m a -> TerminalT t m a
forall t (m :: * -> *) a. ReaderT t m a -> TerminalT t m a
TerminalT do
        t <- ReaderT t m t
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
        liftIO $ atomically $ f (T.termInterrupt t) (T.termEvent t)

instance (MonadIO m, MonadThrow m, T.Terminal t) => MonadPrinter (TerminalT t m) where
    putLn :: TerminalT t m ()
putLn =
        Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command Command
T.PutLn
    putChar :: Char -> TerminalT t m ()
putChar Char
c =
        Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command (Text -> Command
T.PutText (Text -> Command) -> Text -> Command
forall a b. (a -> b) -> a -> b
$ Char -> Text
Text.singleton Char
c)
    putString :: String -> TerminalT t m ()
putString String
cs =
        String -> (Char -> TerminalT t m ()) -> TerminalT t m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ String
cs (Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command (Command -> TerminalT t m ())
-> (Char -> Command) -> Char -> TerminalT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Command
T.PutText (Text -> Command) -> (Char -> Text) -> Char -> Command
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
Text.singleton)
    putText :: Text -> TerminalT t m ()
putText Text
t = 
        Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command (Text -> Command
T.PutText Text
t)
    flush :: TerminalT t m ()
flush = ReaderT t m () -> TerminalT t m ()
forall t (m :: * -> *) a. ReaderT t m a -> TerminalT t m a
TerminalT do
        t <- ReaderT t m t
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
        liftIO $ T.termFlush t
    getLineWidth :: TerminalT t m Int
getLineWidth = ReaderT t m Int -> TerminalT t m Int
forall t (m :: * -> *) a. ReaderT t m a -> TerminalT t m a
TerminalT do
        t <- ReaderT t m t
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
        liftIO (width <$> T.termGetWindowSize t)

instance (MonadIO m, MonadThrow m, T.Terminal t) => MonadMarkupPrinter (TerminalT t m) where
    data Attribute (TerminalT t m) = AttributeT T.Attribute deriving (Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool
(Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool)
-> (Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool)
-> Eq (Attribute (TerminalT t m))
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall t (m :: * -> *).
Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool
$c== :: forall t (m :: * -> *).
Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool
== :: Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool
$c/= :: forall t (m :: * -> *).
Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool
/= :: Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool
Eq, Eq (Attribute (TerminalT t m))
Eq (Attribute (TerminalT t m)) =>
(Attribute (TerminalT t m)
 -> Attribute (TerminalT t m) -> Ordering)
-> (Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool)
-> (Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool)
-> (Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool)
-> (Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool)
-> (Attribute (TerminalT t m)
    -> Attribute (TerminalT t m) -> Attribute (TerminalT t m))
-> (Attribute (TerminalT t m)
    -> Attribute (TerminalT t m) -> Attribute (TerminalT t m))
-> Ord (Attribute (TerminalT t m))
Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool
Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Ordering
Attribute (TerminalT t m)
-> Attribute (TerminalT t m) -> Attribute (TerminalT t m)
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall t (m :: * -> *). Eq (Attribute (TerminalT t m))
forall t (m :: * -> *).
Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool
forall t (m :: * -> *).
Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Ordering
forall t (m :: * -> *).
Attribute (TerminalT t m)
-> Attribute (TerminalT t m) -> Attribute (TerminalT t m)
$ccompare :: forall t (m :: * -> *).
Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Ordering
compare :: Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Ordering
$c< :: forall t (m :: * -> *).
Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool
< :: Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool
$c<= :: forall t (m :: * -> *).
Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool
<= :: Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool
$c> :: forall t (m :: * -> *).
Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool
> :: Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool
$c>= :: forall t (m :: * -> *).
Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool
>= :: Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool
$cmax :: forall t (m :: * -> *).
Attribute (TerminalT t m)
-> Attribute (TerminalT t m) -> Attribute (TerminalT t m)
max :: Attribute (TerminalT t m)
-> Attribute (TerminalT t m) -> Attribute (TerminalT t m)
$cmin :: forall t (m :: * -> *).
Attribute (TerminalT t m)
-> Attribute (TerminalT t m) -> Attribute (TerminalT t m)
min :: Attribute (TerminalT t m)
-> Attribute (TerminalT t m) -> Attribute (TerminalT t m)
Ord, Int -> Attribute (TerminalT t m) -> ShowS
[Attribute (TerminalT t m)] -> ShowS
Attribute (TerminalT t m) -> String
(Int -> Attribute (TerminalT t m) -> ShowS)
-> (Attribute (TerminalT t m) -> String)
-> ([Attribute (TerminalT t m)] -> ShowS)
-> Show (Attribute (TerminalT t m))
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t (m :: * -> *). Int -> Attribute (TerminalT t m) -> ShowS
forall t (m :: * -> *). [Attribute (TerminalT t m)] -> ShowS
forall t (m :: * -> *). Attribute (TerminalT t m) -> String
$cshowsPrec :: forall t (m :: * -> *). Int -> Attribute (TerminalT t m) -> ShowS
showsPrec :: Int -> Attribute (TerminalT t m) -> ShowS
$cshow :: forall t (m :: * -> *). Attribute (TerminalT t m) -> String
show :: Attribute (TerminalT t m) -> String
$cshowList :: forall t (m :: * -> *). [Attribute (TerminalT t m)] -> ShowS
showList :: [Attribute (TerminalT t m)] -> ShowS
Show)
    setAttribute :: Attribute (TerminalT t m) -> TerminalT t m ()
setAttribute   (AttributeT Attribute
a)  = Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command (Attribute -> Command
T.SetAttribute   Attribute
a)
    resetAttribute :: Attribute (TerminalT t m) -> TerminalT t m ()
resetAttribute (AttributeT Attribute
a)  = Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command (Attribute -> Command
T.ResetAttribute Attribute
a)
    resetAttributes :: TerminalT t m ()
resetAttributes                = Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command Command
T.ResetAttributes
    resetsAttribute :: Attribute (TerminalT t m) -> Attribute (TerminalT t m) -> Bool
resetsAttribute (AttributeT T.Bold       {}) (AttributeT T.Bold       {}) = Bool
True
    resetsAttribute (AttributeT T.Italic     {}) (AttributeT T.Italic     {}) = Bool
True
    resetsAttribute (AttributeT T.Underlined {}) (AttributeT T.Underlined {}) = Bool
True
    resetsAttribute (AttributeT T.Inverted   {}) (AttributeT T.Inverted   {}) = Bool
True
    resetsAttribute (AttributeT T.Foreground {}) (AttributeT T.Foreground {}) = Bool
True
    resetsAttribute (AttributeT T.Foreground {}) (AttributeT T.Background {}) = Bool
True
    resetsAttribute Attribute (TerminalT t m)
_                            Attribute (TerminalT t m)
_                            = Bool
False 

instance (MonadIO m, MonadThrow m, T.Terminal t) => MonadFormattingPrinter (TerminalT t m) where
    bold :: Attribute (TerminalT t m)
bold       = Attribute -> Attribute (TerminalT t m)
forall t (m :: * -> *). Attribute -> Attribute (TerminalT t m)
AttributeT Attribute
T.Bold
    italic :: Attribute (TerminalT t m)
italic     = Attribute -> Attribute (TerminalT t m)
forall t (m :: * -> *). Attribute -> Attribute (TerminalT t m)
AttributeT Attribute
T.Italic
    underlined :: Attribute (TerminalT t m)
underlined = Attribute -> Attribute (TerminalT t m)
forall t (m :: * -> *). Attribute -> Attribute (TerminalT t m)
AttributeT Attribute
T.Underlined
    inverted :: Attribute (TerminalT t m)
inverted   = Attribute -> Attribute (TerminalT t m)
forall t (m :: * -> *). Attribute -> Attribute (TerminalT t m)
AttributeT Attribute
T.Inverted

instance (MonadIO m, MonadThrow m, T.Terminal t) => MonadColorPrinter (TerminalT t m) where
    data Color (TerminalT t m) = ColorT T.Color deriving (Color (TerminalT t m) -> Color (TerminalT t m) -> Bool
(Color (TerminalT t m) -> Color (TerminalT t m) -> Bool)
-> (Color (TerminalT t m) -> Color (TerminalT t m) -> Bool)
-> Eq (Color (TerminalT t m))
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall t (m :: * -> *).
Color (TerminalT t m) -> Color (TerminalT t m) -> Bool
$c== :: forall t (m :: * -> *).
Color (TerminalT t m) -> Color (TerminalT t m) -> Bool
== :: Color (TerminalT t m) -> Color (TerminalT t m) -> Bool
$c/= :: forall t (m :: * -> *).
Color (TerminalT t m) -> Color (TerminalT t m) -> Bool
/= :: Color (TerminalT t m) -> Color (TerminalT t m) -> Bool
Eq, Eq (Color (TerminalT t m))
Eq (Color (TerminalT t m)) =>
(Color (TerminalT t m) -> Color (TerminalT t m) -> Ordering)
-> (Color (TerminalT t m) -> Color (TerminalT t m) -> Bool)
-> (Color (TerminalT t m) -> Color (TerminalT t m) -> Bool)
-> (Color (TerminalT t m) -> Color (TerminalT t m) -> Bool)
-> (Color (TerminalT t m) -> Color (TerminalT t m) -> Bool)
-> (Color (TerminalT t m)
    -> Color (TerminalT t m) -> Color (TerminalT t m))
-> (Color (TerminalT t m)
    -> Color (TerminalT t m) -> Color (TerminalT t m))
-> Ord (Color (TerminalT t m))
Color (TerminalT t m) -> Color (TerminalT t m) -> Bool
Color (TerminalT t m) -> Color (TerminalT t m) -> Ordering
Color (TerminalT t m)
-> Color (TerminalT t m) -> Color (TerminalT t m)
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall t (m :: * -> *). Eq (Color (TerminalT t m))
forall t (m :: * -> *).
Color (TerminalT t m) -> Color (TerminalT t m) -> Bool
forall t (m :: * -> *).
Color (TerminalT t m) -> Color (TerminalT t m) -> Ordering
forall t (m :: * -> *).
Color (TerminalT t m)
-> Color (TerminalT t m) -> Color (TerminalT t m)
$ccompare :: forall t (m :: * -> *).
Color (TerminalT t m) -> Color (TerminalT t m) -> Ordering
compare :: Color (TerminalT t m) -> Color (TerminalT t m) -> Ordering
$c< :: forall t (m :: * -> *).
Color (TerminalT t m) -> Color (TerminalT t m) -> Bool
< :: Color (TerminalT t m) -> Color (TerminalT t m) -> Bool
$c<= :: forall t (m :: * -> *).
Color (TerminalT t m) -> Color (TerminalT t m) -> Bool
<= :: Color (TerminalT t m) -> Color (TerminalT t m) -> Bool
$c> :: forall t (m :: * -> *).
Color (TerminalT t m) -> Color (TerminalT t m) -> Bool
> :: Color (TerminalT t m) -> Color (TerminalT t m) -> Bool
$c>= :: forall t (m :: * -> *).
Color (TerminalT t m) -> Color (TerminalT t m) -> Bool
>= :: Color (TerminalT t m) -> Color (TerminalT t m) -> Bool
$cmax :: forall t (m :: * -> *).
Color (TerminalT t m)
-> Color (TerminalT t m) -> Color (TerminalT t m)
max :: Color (TerminalT t m)
-> Color (TerminalT t m) -> Color (TerminalT t m)
$cmin :: forall t (m :: * -> *).
Color (TerminalT t m)
-> Color (TerminalT t m) -> Color (TerminalT t m)
min :: Color (TerminalT t m)
-> Color (TerminalT t m) -> Color (TerminalT t m)
Ord, Int -> Color (TerminalT t m) -> ShowS
[Color (TerminalT t m)] -> ShowS
Color (TerminalT t m) -> String
(Int -> Color (TerminalT t m) -> ShowS)
-> (Color (TerminalT t m) -> String)
-> ([Color (TerminalT t m)] -> ShowS)
-> Show (Color (TerminalT t m))
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t (m :: * -> *). Int -> Color (TerminalT t m) -> ShowS
forall t (m :: * -> *). [Color (TerminalT t m)] -> ShowS
forall t (m :: * -> *). Color (TerminalT t m) -> String
$cshowsPrec :: forall t (m :: * -> *). Int -> Color (TerminalT t m) -> ShowS
showsPrec :: Int -> Color (TerminalT t m) -> ShowS
$cshow :: forall t (m :: * -> *). Color (TerminalT t m) -> String
show :: Color (TerminalT t m) -> String
$cshowList :: forall t (m :: * -> *). [Color (TerminalT t m)] -> ShowS
showList :: [Color (TerminalT t m)] -> ShowS
Show)
    black :: Color (TerminalT t m)
black                      = Color -> Color (TerminalT t m)
forall t (m :: * -> *). Color -> Color (TerminalT t m)
ColorT Color
T.Black
    red :: Color (TerminalT t m)
red                        = Color -> Color (TerminalT t m)
forall t (m :: * -> *). Color -> Color (TerminalT t m)
ColorT Color
T.Red
    green :: Color (TerminalT t m)
green                      = Color -> Color (TerminalT t m)
forall t (m :: * -> *). Color -> Color (TerminalT t m)
ColorT Color
T.Green
    yellow :: Color (TerminalT t m)
yellow                     = Color -> Color (TerminalT t m)
forall t (m :: * -> *). Color -> Color (TerminalT t m)
ColorT Color
T.Yellow
    blue :: Color (TerminalT t m)
blue                       = Color -> Color (TerminalT t m)
forall t (m :: * -> *). Color -> Color (TerminalT t m)
ColorT Color
T.Blue
    magenta :: Color (TerminalT t m)
magenta                    = Color -> Color (TerminalT t m)
forall t (m :: * -> *). Color -> Color (TerminalT t m)
ColorT Color
T.Magenta
    cyan :: Color (TerminalT t m)
cyan                       = Color -> Color (TerminalT t m)
forall t (m :: * -> *). Color -> Color (TerminalT t m)
ColorT Color
T.Cyan
    white :: Color (TerminalT t m)
white                      = Color -> Color (TerminalT t m)
forall t (m :: * -> *). Color -> Color (TerminalT t m)
ColorT Color
T.White
    bright :: Color (TerminalT t m) -> Color (TerminalT t m)
bright (ColorT Color
T.Black  )  = Color -> Color (TerminalT t m)
forall t (m :: * -> *). Color -> Color (TerminalT t m)
ColorT Color
T.BrightBlack
    bright (ColorT Color
T.Red    )  = Color -> Color (TerminalT t m)
forall t (m :: * -> *). Color -> Color (TerminalT t m)
ColorT Color
T.BrightRed
    bright (ColorT Color
T.Green  )  = Color -> Color (TerminalT t m)
forall t (m :: * -> *). Color -> Color (TerminalT t m)
ColorT Color
T.BrightGreen
    bright (ColorT Color
T.Yellow )  = Color -> Color (TerminalT t m)
forall t (m :: * -> *). Color -> Color (TerminalT t m)
ColorT Color
T.BrightYellow
    bright (ColorT Color
T.Blue   )  = Color -> Color (TerminalT t m)
forall t (m :: * -> *). Color -> Color (TerminalT t m)
ColorT Color
T.BrightBlue
    bright (ColorT Color
T.Magenta)  = Color -> Color (TerminalT t m)
forall t (m :: * -> *). Color -> Color (TerminalT t m)
ColorT Color
T.BrightMagenta
    bright (ColorT Color
T.Cyan   )  = Color -> Color (TerminalT t m)
forall t (m :: * -> *). Color -> Color (TerminalT t m)
ColorT Color
T.BrightCyan
    bright (ColorT Color
T.White  )  = Color -> Color (TerminalT t m)
forall t (m :: * -> *). Color -> Color (TerminalT t m)
ColorT Color
T.BrightWhite
    bright (ColorT Color
c        )  = Color -> Color (TerminalT t m)
forall t (m :: * -> *). Color -> Color (TerminalT t m)
ColorT Color
c
    foreground :: Color (TerminalT t m) -> Attribute (TerminalT t m)
foreground (ColorT Color
c)      = Attribute -> Attribute (TerminalT t m)
forall t (m :: * -> *). Attribute -> Attribute (TerminalT t m)
AttributeT (Color -> Attribute
T.Foreground Color
c)
    background :: Color (TerminalT t m) -> Attribute (TerminalT t m)
background (ColorT Color
c)      = Attribute -> Attribute (TerminalT t m)
forall t (m :: * -> *). Attribute -> Attribute (TerminalT t m)
AttributeT (Color -> Attribute
T.Background Color
c)

instance (MonadIO m, MonadThrow m, T.Terminal t) => MonadScreen (TerminalT t m) where
    getWindowSize :: TerminalT t m Size
getWindowSize =
        ReaderT t m Size -> TerminalT t m Size
forall t (m :: * -> *) a. ReaderT t m a -> TerminalT t m a
TerminalT (IO Size -> ReaderT t m Size
forall a. IO a -> ReaderT t m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Size -> ReaderT t m Size)
-> (t -> IO Size) -> t -> ReaderT t m Size
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> IO Size
forall t. Terminal t => t -> IO Size
T.termGetWindowSize (t -> ReaderT t m Size) -> ReaderT t m t -> ReaderT t m Size
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT t m t
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask)

    moveCursorUp :: Int -> TerminalT t m ()
moveCursorUp Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0     = Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command (Int -> Command
T.MoveCursorUp Int
i)
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = Int -> TerminalT t m ()
forall (m :: * -> *). MonadScreen m => Int -> m ()
moveCursorDown Int
i
        | Bool
otherwise = () -> TerminalT t m ()
forall a. a -> TerminalT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    moveCursorDown :: Int -> TerminalT t m ()
moveCursorDown Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0     = Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command (Int -> Command
T.MoveCursorDown Int
i)
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = Int -> TerminalT t m ()
forall (m :: * -> *). MonadScreen m => Int -> m ()
moveCursorUp Int
i
        | Bool
otherwise = () -> TerminalT t m ()
forall a. a -> TerminalT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    moveCursorForward :: Int -> TerminalT t m ()
moveCursorForward Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0     = Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command (Int -> Command
T.MoveCursorForward Int
i)
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = Int -> TerminalT t m ()
forall (m :: * -> *). MonadScreen m => Int -> m ()
moveCursorBackward Int
i
        | Bool
otherwise = () -> TerminalT t m ()
forall a. a -> TerminalT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    moveCursorBackward :: Int -> TerminalT t m ()
moveCursorBackward Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0     = Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command (Int -> Command
T.MoveCursorBackward Int
i)
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = Int -> TerminalT t m ()
forall (m :: * -> *). MonadScreen m => Int -> m ()
moveCursorForward Int
i
        | Bool
otherwise = () -> TerminalT t m ()
forall a. a -> TerminalT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    getCursorPosition :: TerminalT t m Position
getCursorPosition =
        ReaderT t m Position -> TerminalT t m Position
forall t (m :: * -> *) a. ReaderT t m a -> TerminalT t m a
TerminalT (IO Position -> ReaderT t m Position
forall a. IO a -> ReaderT t m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Position -> ReaderT t m Position)
-> (t -> IO Position) -> t -> ReaderT t m Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> IO Position
forall t. Terminal t => t -> IO Position
T.termGetCursorPosition (t -> ReaderT t m Position)
-> ReaderT t m t -> ReaderT t m Position
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT t m t
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask)
    setCursorPosition :: Position -> TerminalT t m ()
setCursorPosition Position
pos =
        Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command (Position -> Command
T.SetCursorPosition Position
pos)
    setCursorRow :: Int -> TerminalT t m ()
setCursorRow Int
i =
        Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command (Int -> Command
T.SetCursorRow Int
i)
    setCursorColumn :: Int -> TerminalT t m ()
setCursorColumn Int
i =
        Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command (Int -> Command
T.SetCursorColumn Int
i)

    saveCursor :: TerminalT t m ()
saveCursor =
        Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command Command
T.SaveCursor
    restoreCursor :: TerminalT t m ()
restoreCursor =
        Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command Command
T.RestoreCursor

    insertChars :: Int -> TerminalT t m ()
insertChars Int
i = do
        Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command (Int -> Command
T.InsertChars Int
i)
    deleteChars :: Int -> TerminalT t m ()
deleteChars Int
i = do
        Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command (Int -> Command
T.DeleteChars Int
i)
    eraseChars :: Int -> TerminalT t m ()
eraseChars  Int
i = do
        Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command (Int -> Command
T.EraseChars  Int
i)
    insertLines :: Int -> TerminalT t m ()
insertLines Int
i = do
        Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command (Int -> Command
T.InsertLines Int
i)
    deleteLines :: Int -> TerminalT t m ()
deleteLines Int
i = do
        Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command (Int -> Command
T.DeleteLines Int
i)

    eraseInLine :: EraseMode -> TerminalT t m ()
eraseInLine =
        Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command (Command -> TerminalT t m ())
-> (EraseMode -> Command) -> EraseMode -> TerminalT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EraseMode -> Command
T.EraseInLine
    eraseInDisplay :: EraseMode -> TerminalT t m ()
eraseInDisplay =
        Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command (Command -> TerminalT t m ())
-> (EraseMode -> Command) -> EraseMode -> TerminalT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EraseMode -> Command
T.EraseInDisplay

    showCursor :: TerminalT t m ()
showCursor =
        Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command Command
T.ShowCursor
    hideCursor :: TerminalT t m ()
hideCursor =
        Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command Command
T.HideCursor

    setAutoWrap :: Bool -> TerminalT t m ()
setAutoWrap Bool
x =
        Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command (Bool -> Command
T.SetAutoWrap Bool
x)
    setAlternateScreenBuffer :: Bool -> TerminalT t m ()
setAlternateScreenBuffer Bool
x =
        Command -> TerminalT t m ()
forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command (Bool -> Command
T.SetAlternateScreenBuffer Bool
x)

instance (MonadIO m, MonadThrow m, T.Terminal t) => MonadTerminal (TerminalT t m) where

command :: (MonadIO m, MonadThrow m, T.Terminal t) => T.Command -> TerminalT t m ()
command :: forall (m :: * -> *) t.
(MonadIO m, MonadThrow m, Terminal t) =>
Command -> TerminalT t m ()
command Command
c = ReaderT t m () -> TerminalT t m ()
forall t (m :: * -> *) a. ReaderT t m a -> TerminalT t m a
TerminalT do
  t <- ReaderT t m t
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  liftIO $ T.termCommand t c