{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, DefaultSignatures, GADTs, TypeOperators #-}
module QuickSpec.Internal.Terminal where

import Control.Monad.Trans.Class
import Control.Monad.IO.Class
import Control.Monad.Trans.State.Strict
import Control.Monad.Trans.Reader
import qualified Test.QuickCheck.Text as Text

class Monad m => MonadTerminal m where
  putText :: String -> m ()
  putLine :: String -> m ()
  putTemp :: String -> m ()

  default putText :: (MonadTrans t, MonadTerminal m', m ~ t m') => String -> m ()
  putText = 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 :: * -> *). MonadTerminal m => String -> m ()
putText

  default putLine :: (MonadTrans t, MonadTerminal m', m ~ t m') => String -> m ()
  putLine = 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 :: * -> *). MonadTerminal m => String -> m ()
putLine

  default putTemp :: (MonadTrans t, MonadTerminal m', m ~ t m') => String -> m ()
  putTemp = 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 :: * -> *). MonadTerminal m => String -> m ()
putTemp

instance MonadTerminal m => MonadTerminal (StateT s m)
instance MonadTerminal m => MonadTerminal (ReaderT r m)

putStatus :: MonadTerminal m => String -> m ()
putStatus :: forall (m :: * -> *). MonadTerminal m => String -> m ()
putStatus String
str = forall (m :: * -> *). MonadTerminal m => String -> m ()
putTemp (String
"[" forall a. [a] -> [a] -> [a]
++ String
str forall a. [a] -> [a] -> [a]
++ String
"...]")

clearStatus :: MonadTerminal m => m ()
clearStatus :: forall (m :: * -> *). MonadTerminal m => m ()
clearStatus = forall (m :: * -> *). MonadTerminal m => String -> m ()
putTemp String
""

withStatus :: MonadTerminal m => String -> m a -> m a
withStatus :: forall (m :: * -> *) a. MonadTerminal m => String -> m a -> m a
withStatus String
str m a
mx = forall (m :: * -> *). MonadTerminal m => String -> m ()
putStatus String
str forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a
mx forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). MonadTerminal m => m ()
clearStatus

newtype Terminal a = Terminal (ReaderT Text.Terminal IO a)
  deriving (forall a b. a -> Terminal b -> Terminal a
forall a b. (a -> b) -> Terminal a -> Terminal 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 -> Terminal b -> Terminal a
$c<$ :: forall a b. a -> Terminal b -> Terminal a
fmap :: forall a b. (a -> b) -> Terminal a -> Terminal b
$cfmap :: forall a b. (a -> b) -> Terminal a -> Terminal b
Functor, Functor Terminal
forall a. a -> Terminal a
forall a b. Terminal a -> Terminal b -> Terminal a
forall a b. Terminal a -> Terminal b -> Terminal b
forall a b. Terminal (a -> b) -> Terminal a -> Terminal b
forall a b c.
(a -> b -> c) -> Terminal a -> Terminal b -> Terminal 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. Terminal a -> Terminal b -> Terminal a
$c<* :: forall a b. Terminal a -> Terminal b -> Terminal a
*> :: forall a b. Terminal a -> Terminal b -> Terminal b
$c*> :: forall a b. Terminal a -> Terminal b -> Terminal b
liftA2 :: forall a b c.
(a -> b -> c) -> Terminal a -> Terminal b -> Terminal c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Terminal a -> Terminal b -> Terminal c
<*> :: forall a b. Terminal (a -> b) -> Terminal a -> Terminal b
$c<*> :: forall a b. Terminal (a -> b) -> Terminal a -> Terminal b
pure :: forall a. a -> Terminal a
$cpure :: forall a. a -> Terminal a
Applicative, Applicative Terminal
forall a. a -> Terminal a
forall a b. Terminal a -> Terminal b -> Terminal b
forall a b. Terminal a -> (a -> Terminal b) -> Terminal 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 -> Terminal a
$creturn :: forall a. a -> Terminal a
>> :: forall a b. Terminal a -> Terminal b -> Terminal b
$c>> :: forall a b. Terminal a -> Terminal b -> Terminal b
>>= :: forall a b. Terminal a -> (a -> Terminal b) -> Terminal b
$c>>= :: forall a b. Terminal a -> (a -> Terminal b) -> Terminal b
Monad, Monad Terminal
forall a. IO a -> Terminal a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Terminal a
$cliftIO :: forall a. IO a -> Terminal a
MonadIO)

instance MonadTerminal Terminal where
  putText :: String -> Terminal ()
putText String
str = forall a. ReaderT Terminal IO a -> Terminal a
Terminal forall a b. (a -> b) -> a -> b
$ do
    Terminal
term <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Terminal -> String -> IO ()
Text.putPart Terminal
term String
str

  putLine :: String -> Terminal ()
putLine String
str = forall a. ReaderT Terminal IO a -> Terminal a
Terminal forall a b. (a -> b) -> a -> b
$ do
    Terminal
term <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Terminal -> String -> IO ()
Text.putLine Terminal
term String
str

  putTemp :: String -> Terminal ()
putTemp String
str = forall a. ReaderT Terminal IO a -> Terminal a
Terminal forall a b. (a -> b) -> a -> b
$ do
    Terminal
term <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Terminal -> String -> IO ()
Text.putTemp Terminal
term String
str

withNullTerminal :: Terminal a -> IO a
withNullTerminal :: forall a. Terminal a -> IO a
withNullTerminal (Terminal ReaderT Terminal IO a
mx) =
  forall a. (Terminal -> IO a) -> IO a
Text.withNullTerminal (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Terminal IO a
mx)

withStdioTerminal :: Terminal a -> IO a
withStdioTerminal :: forall a. Terminal a -> IO a
withStdioTerminal (Terminal ReaderT Terminal IO a
mx) =
  forall a. (Terminal -> IO a) -> IO a
Text.withStdioTerminal (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Terminal IO a
mx)