{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}

-- | Terminal UI.
module Test.Mutagen.Test.Terminal
  ( -- * Generic TUI interface
    TUI
  , TerminalT
  , withTerminalT
  , MonadTerminal (..)

    -- * Basic stdout TUI
  , stdoutTUI

    -- * Brick-based
  , brickTUI

    -- * Helpers
  , renderGlobalStats
  , renderShortStats
  , renderBatch
  , prettyPrint
  , compactPrint
  )
where

import Brick (App (..), BrickEvent, EventM, str)
import qualified Brick
import qualified Brick.BChan as Brick
import qualified Brick.Widgets.Border as Brick
import qualified Brick.Widgets.Edit as Brick
import Control.Concurrent (forkIO)
import Control.Monad (void, (>=>))
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Reader (ReaderT (..), ask, lift)
import Control.Monad.State (StateT)
import Data.Sequence (Seq, (|>))
import qualified Data.Sequence as Seq
import qualified Data.Text.Zipper as TextZipper
import Data.Time.Clock.POSIX (getPOSIXTime)
import Graphics.Vty (Event (..), Key (..), Modifier (..))
import qualified Graphics.Vty as Vty
import Test.Mutagen.Fragment.Store (fragmentStoreSize)
import Test.Mutagen.Property (Args)
import Test.Mutagen.Test.Queue (MutationBatch (..), mutationQueueSize)
import Test.Mutagen.Test.State (MutagenState (..))
import Text.Pretty.Simple
  ( CheckColorTty (..)
  , OutputOptions (..)
  , defaultOutputOptionsDarkBg
  , pPrintOpt
  )

{-------------------------------------------------------------------------------
-- * Generic terminal interface
-------------------------------------------------------------------------------}

-- | Generic terminal UI interface.
data TUI m = TUI
  { forall (m :: * -> *). TUI m -> String -> m ()
tuiMessage :: String -> m ()
  -- ^ Print a message to the terminal
  , forall (m :: * -> *). TUI m -> forall a. Show a => a -> m ()
tuiPretty :: forall a. (Show a) => a -> m ()
  -- ^ Pretty-print a value to the terminal
  , forall (m :: * -> *). TUI m -> m ()
tuiCleanLog :: m ()
  -- ^ Clean the log output
  , forall (m :: * -> *). TUI m -> String -> m String
tuiReadLine :: String -> m String
  -- ^ Get input from the user (waits for a newline)
  , forall (m :: * -> *). TUI m -> Bool -> MutagenState -> m ()
tuiPrintStats :: Bool -> MutagenState -> m ()
  -- ^ Print global statistics about the testing session
  , forall (m :: * -> *). TUI m -> MutationBatch Args -> m ()
tuiPrintBatch :: MutationBatch Args -> m ()
  -- ^ Print the status of the current mutation batch
  }

-- | 'TerminalT' monad transformer.
newtype TerminalT m a = TerminalT {forall (m :: * -> *) a. TerminalT m a -> ReaderT (TUI m) m a
runTerminalT :: ReaderT (TUI m) m a}
  deriving (Functor (TerminalT m)
Functor (TerminalT m) =>
(forall a. a -> TerminalT m a)
-> (forall a b.
    TerminalT m (a -> b) -> TerminalT m a -> TerminalT m b)
-> (forall a b c.
    (a -> b -> c) -> TerminalT m a -> TerminalT m b -> TerminalT m c)
-> (forall a b. TerminalT m a -> TerminalT m b -> TerminalT m b)
-> (forall a b. TerminalT m a -> TerminalT m b -> TerminalT m a)
-> Applicative (TerminalT m)
forall a. a -> TerminalT m a
forall a b. TerminalT m a -> TerminalT m b -> TerminalT m a
forall a b. TerminalT m a -> TerminalT m b -> TerminalT m b
forall a b. TerminalT m (a -> b) -> TerminalT m a -> TerminalT m b
forall a b c.
(a -> b -> c) -> TerminalT m a -> TerminalT m b -> TerminalT 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 (m :: * -> *). Applicative m => Functor (TerminalT m)
forall (m :: * -> *) a. Applicative m => a -> TerminalT m a
forall (m :: * -> *) a b.
Applicative m =>
TerminalT m a -> TerminalT m b -> TerminalT m a
forall (m :: * -> *) a b.
Applicative m =>
TerminalT m a -> TerminalT m b -> TerminalT m b
forall (m :: * -> *) a b.
Applicative m =>
TerminalT m (a -> b) -> TerminalT m a -> TerminalT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> TerminalT m a -> TerminalT m b -> TerminalT m c
$cpure :: forall (m :: * -> *) a. Applicative m => a -> TerminalT m a
pure :: forall a. a -> TerminalT m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
TerminalT m (a -> b) -> TerminalT m a -> TerminalT m b
<*> :: forall a b. TerminalT m (a -> b) -> TerminalT m a -> TerminalT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> TerminalT m a -> TerminalT m b -> TerminalT m c
liftA2 :: forall a b c.
(a -> b -> c) -> TerminalT m a -> TerminalT m b -> TerminalT m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
TerminalT m a -> TerminalT m b -> TerminalT m b
*> :: forall a b. TerminalT m a -> TerminalT m b -> TerminalT m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
TerminalT m a -> TerminalT m b -> TerminalT m a
<* :: forall a b. TerminalT m a -> TerminalT m b -> TerminalT m a
Applicative, (forall a b. (a -> b) -> TerminalT m a -> TerminalT m b)
-> (forall a b. a -> TerminalT m b -> TerminalT m a)
-> Functor (TerminalT m)
forall a b. a -> TerminalT m b -> TerminalT m a
forall a b. (a -> b) -> TerminalT m a -> TerminalT m b
forall (m :: * -> *) a b.
Functor m =>
a -> TerminalT m b -> TerminalT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> TerminalT m a -> TerminalT 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 (m :: * -> *) a b.
Functor m =>
(a -> b) -> TerminalT m a -> TerminalT m b
fmap :: forall a b. (a -> b) -> TerminalT m a -> TerminalT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> TerminalT m b -> TerminalT m a
<$ :: forall a b. a -> TerminalT m b -> TerminalT m a
Functor, Applicative (TerminalT m)
Applicative (TerminalT m) =>
(forall a b.
 TerminalT m a -> (a -> TerminalT m b) -> TerminalT m b)
-> (forall a b. TerminalT m a -> TerminalT m b -> TerminalT m b)
-> (forall a. a -> TerminalT m a)
-> Monad (TerminalT m)
forall a. a -> TerminalT m a
forall a b. TerminalT m a -> TerminalT m b -> TerminalT m b
forall a b. TerminalT m a -> (a -> TerminalT m b) -> TerminalT m b
forall (m :: * -> *). Monad m => Applicative (TerminalT m)
forall (m :: * -> *) a. Monad m => a -> TerminalT m a
forall (m :: * -> *) a b.
Monad m =>
TerminalT m a -> TerminalT m b -> TerminalT m b
forall (m :: * -> *) a b.
Monad m =>
TerminalT m a -> (a -> TerminalT m b) -> TerminalT 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 (m :: * -> *) a b.
Monad m =>
TerminalT m a -> (a -> TerminalT m b) -> TerminalT m b
>>= :: forall a b. TerminalT m a -> (a -> TerminalT m b) -> TerminalT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
TerminalT m a -> TerminalT m b -> TerminalT m b
>> :: forall a b. TerminalT m a -> TerminalT m b -> TerminalT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> TerminalT m a
return :: forall a. a -> TerminalT m a
Monad, Monad (TerminalT m)
Monad (TerminalT m) =>
(forall a. IO a -> TerminalT m a) -> MonadIO (TerminalT m)
forall a. IO a -> TerminalT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (TerminalT m)
forall (m :: * -> *) a. MonadIO m => IO a -> TerminalT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> TerminalT m a
liftIO :: forall a. IO a -> TerminalT m a
MonadIO)

-- | Run a 'TerminalT' action with the given t'TUI'.
withTerminalT :: TUI m -> TerminalT m a -> m a
withTerminalT :: forall (m :: * -> *) a. TUI m -> TerminalT m a -> m a
withTerminalT TUI m
tui = (ReaderT (TUI m) m a -> TUI m -> m a)
-> TUI m -> ReaderT (TUI m) m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (TUI m) m a -> TUI m -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT TUI m
tui (ReaderT (TUI m) m a -> m a)
-> (TerminalT m a -> ReaderT (TUI m) m a) -> TerminalT m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TerminalT m a -> ReaderT (TUI m) m a
forall (m :: * -> *) a. TerminalT m a -> ReaderT (TUI m) m a
runTerminalT

-- | Monad class for terminal interactions.
class (Monad m) => MonadTerminal m where
  message :: String -> m ()
  pretty :: forall a. (Show a) => a -> m ()
  cleanLog :: m ()
  readLine :: String -> m String
  printStats :: Bool -> MutagenState -> m ()
  printBatch :: MutationBatch Args -> m ()

instance (Monad m) => MonadTerminal (TerminalT m) where
  message :: String -> TerminalT m ()
message String
msg = ReaderT (TUI m) m () -> TerminalT m ()
forall (m :: * -> *) a. ReaderT (TUI m) m a -> TerminalT m a
TerminalT (ReaderT (TUI m) m () -> TerminalT m ())
-> ReaderT (TUI m) m () -> TerminalT m ()
forall a b. (a -> b) -> a -> b
$ do
    tui <- ReaderT (TUI m) m (TUI m)
forall r (m :: * -> *). MonadReader r m => m r
ask
    lift $ tuiMessage tui msg
  pretty :: forall a. Show a => a -> TerminalT m ()
pretty a
val = ReaderT (TUI m) m () -> TerminalT m ()
forall (m :: * -> *) a. ReaderT (TUI m) m a -> TerminalT m a
TerminalT (ReaderT (TUI m) m () -> TerminalT m ())
-> ReaderT (TUI m) m () -> TerminalT m ()
forall a b. (a -> b) -> a -> b
$ do
    tui <- ReaderT (TUI m) m (TUI m)
forall r (m :: * -> *). MonadReader r m => m r
ask
    lift $ tuiPretty tui val
  cleanLog :: TerminalT m ()
cleanLog = ReaderT (TUI m) m () -> TerminalT m ()
forall (m :: * -> *) a. ReaderT (TUI m) m a -> TerminalT m a
TerminalT (ReaderT (TUI m) m () -> TerminalT m ())
-> ReaderT (TUI m) m () -> TerminalT m ()
forall a b. (a -> b) -> a -> b
$ do
    tui <- ReaderT (TUI m) m (TUI m)
forall r (m :: * -> *). MonadReader r m => m r
ask
    lift $ tuiCleanLog tui
  readLine :: String -> TerminalT m String
readLine String
prompt = ReaderT (TUI m) m String -> TerminalT m String
forall (m :: * -> *) a. ReaderT (TUI m) m a -> TerminalT m a
TerminalT (ReaderT (TUI m) m String -> TerminalT m String)
-> ReaderT (TUI m) m String -> TerminalT m String
forall a b. (a -> b) -> a -> b
$ do
    tui <- ReaderT (TUI m) m (TUI m)
forall r (m :: * -> *). MonadReader r m => m r
ask
    lift $ tuiReadLine tui prompt
  printStats :: Bool -> MutagenState -> TerminalT m ()
printStats Bool
full MutagenState
st = ReaderT (TUI m) m () -> TerminalT m ()
forall (m :: * -> *) a. ReaderT (TUI m) m a -> TerminalT m a
TerminalT (ReaderT (TUI m) m () -> TerminalT m ())
-> ReaderT (TUI m) m () -> TerminalT m ()
forall a b. (a -> b) -> a -> b
$ do
    tui <- ReaderT (TUI m) m (TUI m)
forall r (m :: * -> *). MonadReader r m => m r
ask
    lift $ tuiPrintStats tui full st
  printBatch :: MutationBatch Args -> TerminalT m ()
printBatch MutationBatch Args
batch = ReaderT (TUI m) m () -> TerminalT m ()
forall (m :: * -> *) a. ReaderT (TUI m) m a -> TerminalT m a
TerminalT (ReaderT (TUI m) m () -> TerminalT m ())
-> ReaderT (TUI m) m () -> TerminalT m ()
forall a b. (a -> b) -> a -> b
$ do
    tui <- ReaderT (TUI m) m (TUI m)
forall r (m :: * -> *). MonadReader r m => m r
ask
    lift $ tuiPrintBatch tui batch

instance (MonadIO m, MonadTerminal m) => MonadTerminal (StateT s m) where
  message :: String -> StateT s m ()
message String
msg = m () -> StateT s m ()
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ()) -> m () -> StateT s m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *). MonadTerminal m => String -> m ()
message String
msg
  pretty :: forall a. Show a => a -> StateT s m ()
pretty a
val = m () -> StateT s m ()
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ()) -> m () -> StateT s m ()
forall a b. (a -> b) -> a -> b
$ a -> m ()
forall a. Show a => a -> m ()
forall (m :: * -> *) a. (MonadTerminal m, Show a) => a -> m ()
pretty a
val
  cleanLog :: StateT s m ()
cleanLog = m () -> StateT s m ()
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ()) -> m () -> StateT s m ()
forall a b. (a -> b) -> a -> b
$ m ()
forall (m :: * -> *). MonadTerminal m => m ()
cleanLog
  readLine :: String -> StateT s m String
readLine String
prompt = m String -> StateT s m String
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m String -> StateT s m String) -> m String -> StateT s m String
forall a b. (a -> b) -> a -> b
$ String -> m String
forall (m :: * -> *). MonadTerminal m => String -> m String
readLine String
prompt
  printStats :: Bool -> MutagenState -> StateT s m ()
printStats Bool
full MutagenState
st = m () -> StateT s m ()
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ()) -> m () -> StateT s m ()
forall a b. (a -> b) -> a -> b
$ Bool -> MutagenState -> m ()
forall (m :: * -> *).
MonadTerminal m =>
Bool -> MutagenState -> m ()
printStats Bool
full MutagenState
st
  printBatch :: MutationBatch Args -> StateT s m ()
printBatch MutationBatch Args
batch = m () -> StateT s m ()
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StateT s m ()) -> m () -> StateT s m ()
forall a b. (a -> b) -> a -> b
$ MutationBatch Args -> m ()
forall (m :: * -> *). MonadTerminal m => MutationBatch Args -> m ()
printBatch MutationBatch Args
batch

{-------------------------------------------------------------------------------
-- * Basic stdout terminal interface
-------------------------------------------------------------------------------}

-- | A basic TUI that prints to stdout.
stdoutTUI :: IO (TUI IO)
stdoutTUI :: IO (TUI IO)
stdoutTUI =
  TUI IO -> IO (TUI IO)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    (TUI IO -> IO (TUI IO)) -> TUI IO -> IO (TUI IO)
forall a b. (a -> b) -> a -> b
$ TUI
      { tuiMessage :: String -> IO ()
tuiMessage = String -> IO ()
putStrLn
      , tuiPretty :: forall a. Show a => a -> IO ()
tuiPretty = a -> IO ()
forall a. Show a => a -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
compactPrint
      , tuiCleanLog :: IO ()
tuiCleanLog = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      , tuiReadLine :: String -> IO String
tuiReadLine = \String
prompt -> do
          String -> IO ()
putStr String
prompt
          IO String
getLine
      , tuiPrintStats :: Bool -> MutagenState -> IO ()
tuiPrintStats = \Bool
full MutagenState
st -> do
          let renderStats :: MutagenState -> IO String
renderStats
                | Bool
full = MutagenState -> IO String
forall (m :: * -> *). MonadIO m => MutagenState -> m String
renderGlobalStats
                | Bool
otherwise = MutagenState -> IO String
forall (m :: * -> *). MonadIO m => MutagenState -> m String
renderShortStats
          stats <- MutagenState -> IO String
renderStats MutagenState
st
          putStrLn stats
      , tuiPrintBatch :: MutationBatch Args -> IO ()
tuiPrintBatch = MutationBatch Args -> IO String
forall (m :: * -> *). MonadIO m => MutationBatch Args -> m String
renderBatch (MutationBatch Args -> IO String)
-> (String -> IO ()) -> MutationBatch Args -> IO ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> IO ()
putStrLn
      }

{-------------------------------------------------------------------------------
-- * Brick-based TUI implementation
-------------------------------------------------------------------------------}

-- | A TUI implementation using the Brick library.
brickTUI :: IO (TUI IO)
brickTUI :: IO (TUI IO)
brickTUI = do
  (inChan, outChan) <- IO (BChan TUIEvent, BChan String)
startTUI
  return
    $ TUI
      { tuiMessage = \String
msg -> do
          BChan TUIEvent -> TUIEvent -> IO ()
forall a. BChan a -> a -> IO ()
Brick.writeBChan BChan TUIEvent
inChan (String -> TUIEvent
TUIMessage String
msg)
      , tuiPretty = \a
obj ->
          BChan TUIEvent -> TUIEvent -> IO ()
forall a. BChan a -> a -> IO ()
Brick.writeBChan BChan TUIEvent
inChan (a -> TUIEvent
forall a. Show a => a -> TUIEvent
TUIPretty a
obj)
      , tuiCleanLog = do
          Brick.writeBChan inChan TUICleanLog
      , tuiReadLine = \String
prompt -> do
          BChan TUIEvent -> TUIEvent -> IO ()
forall a. BChan a -> a -> IO ()
Brick.writeBChan BChan TUIEvent
inChan (String -> TUIEvent
TUIReadLine String
prompt)
          BChan String -> IO String
forall a. BChan a -> IO a
Brick.readBChan BChan String
outChan
      , tuiPrintStats = \Bool
_ MutagenState
st -> do
          BChan TUIEvent -> TUIEvent -> IO ()
forall a. BChan a -> a -> IO ()
Brick.writeBChan BChan TUIEvent
inChan (MutagenState -> TUIEvent
TUIStats MutagenState
st)
      , tuiPrintBatch = \MutationBatch Args
batch -> do
          BChan TUIEvent -> TUIEvent -> IO ()
forall a. BChan a -> a -> IO ()
Brick.writeBChan BChan TUIEvent
inChan (MutationBatch Args -> TUIEvent
TUIBatch MutationBatch Args
batch)
      }

-- | Names for Brick widgets.
data TUIName = Stats | CurrentBatch | Log | StatusLine
  deriving (TUIName -> TUIName -> Bool
(TUIName -> TUIName -> Bool)
-> (TUIName -> TUIName -> Bool) -> Eq TUIName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TUIName -> TUIName -> Bool
== :: TUIName -> TUIName -> Bool
$c/= :: TUIName -> TUIName -> Bool
/= :: TUIName -> TUIName -> Bool
Eq, Eq TUIName
Eq TUIName =>
(TUIName -> TUIName -> Ordering)
-> (TUIName -> TUIName -> Bool)
-> (TUIName -> TUIName -> Bool)
-> (TUIName -> TUIName -> Bool)
-> (TUIName -> TUIName -> Bool)
-> (TUIName -> TUIName -> TUIName)
-> (TUIName -> TUIName -> TUIName)
-> Ord TUIName
TUIName -> TUIName -> Bool
TUIName -> TUIName -> Ordering
TUIName -> TUIName -> TUIName
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
$ccompare :: TUIName -> TUIName -> Ordering
compare :: TUIName -> TUIName -> Ordering
$c< :: TUIName -> TUIName -> Bool
< :: TUIName -> TUIName -> Bool
$c<= :: TUIName -> TUIName -> Bool
<= :: TUIName -> TUIName -> Bool
$c> :: TUIName -> TUIName -> Bool
> :: TUIName -> TUIName -> Bool
$c>= :: TUIName -> TUIName -> Bool
>= :: TUIName -> TUIName -> Bool
$cmax :: TUIName -> TUIName -> TUIName
max :: TUIName -> TUIName -> TUIName
$cmin :: TUIName -> TUIName -> TUIName
min :: TUIName -> TUIName -> TUIName
Ord, Int -> TUIName -> ShowS
[TUIName] -> ShowS
TUIName -> String
(Int -> TUIName -> ShowS)
-> (TUIName -> String) -> ([TUIName] -> ShowS) -> Show TUIName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TUIName -> ShowS
showsPrec :: Int -> TUIName -> ShowS
$cshow :: TUIName -> String
show :: TUIName -> String
$cshowList :: [TUIName] -> ShowS
showList :: [TUIName] -> ShowS
Show)

-- | State mode of the TUI.
data TUIMode = TUINormal | TUIInsert
  deriving (TUIMode -> TUIMode -> Bool
(TUIMode -> TUIMode -> Bool)
-> (TUIMode -> TUIMode -> Bool) -> Eq TUIMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TUIMode -> TUIMode -> Bool
== :: TUIMode -> TUIMode -> Bool
$c/= :: TUIMode -> TUIMode -> Bool
/= :: TUIMode -> TUIMode -> Bool
Eq, Eq TUIMode
Eq TUIMode =>
(TUIMode -> TUIMode -> Ordering)
-> (TUIMode -> TUIMode -> Bool)
-> (TUIMode -> TUIMode -> Bool)
-> (TUIMode -> TUIMode -> Bool)
-> (TUIMode -> TUIMode -> Bool)
-> (TUIMode -> TUIMode -> TUIMode)
-> (TUIMode -> TUIMode -> TUIMode)
-> Ord TUIMode
TUIMode -> TUIMode -> Bool
TUIMode -> TUIMode -> Ordering
TUIMode -> TUIMode -> TUIMode
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
$ccompare :: TUIMode -> TUIMode -> Ordering
compare :: TUIMode -> TUIMode -> Ordering
$c< :: TUIMode -> TUIMode -> Bool
< :: TUIMode -> TUIMode -> Bool
$c<= :: TUIMode -> TUIMode -> Bool
<= :: TUIMode -> TUIMode -> Bool
$c> :: TUIMode -> TUIMode -> Bool
> :: TUIMode -> TUIMode -> Bool
$c>= :: TUIMode -> TUIMode -> Bool
>= :: TUIMode -> TUIMode -> Bool
$cmax :: TUIMode -> TUIMode -> TUIMode
max :: TUIMode -> TUIMode -> TUIMode
$cmin :: TUIMode -> TUIMode -> TUIMode
min :: TUIMode -> TUIMode -> TUIMode
Ord, Int -> TUIMode -> ShowS
[TUIMode] -> ShowS
TUIMode -> String
(Int -> TUIMode -> ShowS)
-> (TUIMode -> String) -> ([TUIMode] -> ShowS) -> Show TUIMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TUIMode -> ShowS
showsPrec :: Int -> TUIMode -> ShowS
$cshow :: TUIMode -> String
show :: TUIMode -> String
$cshowList :: [TUIMode] -> ShowS
showList :: [TUIMode] -> ShowS
Show)

-- | TUI event type.
data TUIEvent where
  TUIMessage :: String -> TUIEvent
  TUIPretty :: (Show a) => a -> TUIEvent
  TUICleanLog :: TUIEvent
  TUIReadLine :: String -> TUIEvent
  TUIStats :: MutagenState -> TUIEvent
  TUIBatch :: MutationBatch Args -> TUIEvent

-- | State of the TUI.
data TUIState = TUIState
  { TUIState -> Widget TUIName
tuiStatsWidget :: Brick.Widget TUIName
  , TUIState -> Widget TUIName
tuiBatchWidget :: Brick.Widget TUIName
  , TUIState -> Widget TUIName
tuiLogWidget :: Brick.Widget TUIName
  , TUIState -> Editor String TUIName
tuiStatusLineWidget :: Brick.Editor String TUIName
  , TUIState -> TUIMode
tuiMode :: TUIMode
  , TUIState -> Seq String
tuiLogLines :: Seq String
  , TUIState -> String
tuiInputBuffer :: String
  }

initialTUIState :: TUIState
initialTUIState :: TUIState
initialTUIState =
  TUIState
    { tuiStatsWidget :: Widget TUIName
tuiStatsWidget =
        String -> Widget TUIName
forall n. String -> Widget n
Brick.str
          (String -> Widget TUIName) -> String -> Widget TUIName
forall a b. (a -> b) -> a -> b
$ String
"Mutagen stats"
    , tuiBatchWidget :: Widget TUIName
tuiBatchWidget =
        String -> Widget TUIName
forall n. String -> Widget n
Brick.str
          (String -> Widget TUIName) -> String -> Widget TUIName
forall a b. (a -> b) -> a -> b
$ String
"Current mutation batch"
    , tuiLogWidget :: Widget TUIName
tuiLogWidget =
        String -> Widget TUIName
forall n. String -> Widget n
Brick.str
          (String -> Widget TUIName) -> String -> Widget TUIName
forall a b. (a -> b) -> a -> b
$ String
"Log messages"
    , tuiStatusLineWidget :: Editor String TUIName
tuiStatusLineWidget =
        TUIName -> Maybe Int -> String -> Editor String TUIName
forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
Brick.editor
          TUIName
StatusLine
          (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
          String
""
    , tuiMode :: TUIMode
tuiMode = TUIMode
TUINormal
    , tuiLogLines :: Seq String
tuiLogLines = Seq String
forall a. Seq a
Seq.empty
    , tuiInputBuffer :: String
tuiInputBuffer = String
""
    }

-- | Start the Brick-based TUI.
startTUI :: IO (Brick.BChan TUIEvent, Brick.BChan String)
startTUI :: IO (BChan TUIEvent, BChan String)
startTUI = do
  inChan <- Int -> IO (BChan TUIEvent)
forall a. Int -> IO (BChan a)
Brick.newBChan Int
10
  outChan <- Brick.newBChan 10
  void $ forkIO $ void $ tuiMain inChan outChan
  return (inChan, outChan)
  where
    tuiMain
      :: Brick.BChan TUIEvent
      -> Brick.BChan String
      -> IO (TUIState, Vty.Vty)
    tuiMain :: BChan TUIEvent -> BChan String -> IO (TUIState, Vty)
tuiMain BChan TUIEvent
inChan BChan String
outChan =
      Maybe (BChan TUIEvent)
-> App TUIState TUIEvent TUIName -> TUIState -> IO (TUIState, Vty)
forall n e s.
Ord n =>
Maybe (BChan e) -> App s e n -> s -> IO (s, Vty)
Brick.customMainWithDefaultVty
        (BChan TUIEvent -> Maybe (BChan TUIEvent)
forall a. a -> Maybe a
Just BChan TUIEvent
inChan)
        (BChan String -> App TUIState TUIEvent TUIName
mutagenApp BChan String
outChan)
        TUIState
initialTUIState

    mutagenApp
      :: Brick.BChan String
      -> App TUIState TUIEvent TUIName
    mutagenApp :: BChan String -> App TUIState TUIEvent TUIName
mutagenApp BChan String
outChan =
      App
        { appDraw :: TUIState -> [Widget TUIName]
appDraw = TUIState -> [Widget TUIName]
drawUI
        , appChooseCursor :: TUIState
-> [CursorLocation TUIName] -> Maybe (CursorLocation TUIName)
appChooseCursor = TUIState
-> [CursorLocation TUIName] -> Maybe (CursorLocation TUIName)
forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
Brick.neverShowCursor
        , appHandleEvent :: BrickEvent TUIName TUIEvent -> EventM TUIName TUIState ()
appHandleEvent = BChan String
-> BrickEvent TUIName TUIEvent -> EventM TUIName TUIState ()
handleEvent BChan String
outChan
        , appStartEvent :: EventM TUIName TUIState ()
appStartEvent = () -> EventM TUIName TUIState ()
forall a. a -> EventM TUIName TUIState a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        , appAttrMap :: TUIState -> AttrMap
appAttrMap = AttrMap -> TUIState -> AttrMap
forall a b. a -> b -> a
const AttrMap
attrMap
        }

    attrMap :: Brick.AttrMap
    attrMap :: AttrMap
attrMap =
      Attr -> [(AttrName, Attr)] -> AttrMap
Brick.attrMap
        Attr
Vty.defAttr
        []

    drawUI
      :: TUIState
      -> [Brick.Widget TUIName]
    drawUI :: TUIState -> [Widget TUIName]
drawUI TUIState
st =
      [ [Widget TUIName] -> Widget TUIName
forall n. [Widget n] -> Widget n
Brick.vBox
          [ Widget TUIName -> Widget TUIName -> Widget TUIName
forall n. Widget n -> Widget n -> Widget n
Brick.borderWithLabel (String -> Widget TUIName
forall n. String -> Widget n
Brick.str String
" Stats ")
              (Widget TUIName -> Widget TUIName)
-> Widget TUIName -> Widget TUIName
forall a b. (a -> b) -> a -> b
$ TUIState -> Widget TUIName
tuiStatsWidget TUIState
st
          , Widget TUIName -> Widget TUIName -> Widget TUIName
forall n. Widget n -> Widget n -> Widget n
Brick.borderWithLabel (String -> Widget TUIName
forall n. String -> Widget n
Brick.str String
" CurrentBatch ")
              (Widget TUIName -> Widget TUIName)
-> Widget TUIName -> Widget TUIName
forall a b. (a -> b) -> a -> b
$ TUIState -> Widget TUIName
tuiBatchWidget TUIState
st
          , Widget TUIName -> Widget TUIName -> Widget TUIName
forall n. Widget n -> Widget n -> Widget n
Brick.borderWithLabel (String -> Widget TUIName
forall n. String -> Widget n
Brick.str String
" Log ")
              (Widget TUIName -> Widget TUIName)
-> Widget TUIName -> Widget TUIName
forall a b. (a -> b) -> a -> b
$ [Widget TUIName] -> Widget TUIName
forall n. [Widget n] -> Widget n
Brick.vBox
                [ TUIState -> Widget TUIName
tuiLogWidget TUIState
st
                , Char -> Widget TUIName
forall n. Char -> Widget n
Brick.fill Char
' '
                ]
          , Widget TUIName -> Widget TUIName -> Widget TUIName
forall n. Widget n -> Widget n -> Widget n
Brick.borderWithLabel (String -> Widget TUIName
forall n. String -> Widget n
Brick.str String
" StatusLine ")
              (Widget TUIName -> Widget TUIName)
-> Widget TUIName -> Widget TUIName
forall a b. (a -> b) -> a -> b
$ ([String] -> Widget TUIName)
-> Bool -> Editor String TUIName -> Widget TUIName
forall n t.
(Ord n, Show n, Monoid t, TextWidth t, GenericTextZipper t) =>
([t] -> Widget n) -> Bool -> Editor t n -> Widget n
Brick.renderEditor (String -> Widget TUIName
forall n. String -> Widget n
Brick.str (String -> Widget TUIName)
-> ([String] -> String) -> [String] -> Widget TUIName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) Bool
True
              (Editor String TUIName -> Widget TUIName)
-> Editor String TUIName -> Widget TUIName
forall a b. (a -> b) -> a -> b
$ TUIState -> Editor String TUIName
tuiStatusLineWidget TUIState
st
          ]
      ]

    handleEvent
      :: Brick.BChan String
      -> BrickEvent TUIName TUIEvent
      -> EventM TUIName TUIState ()
    handleEvent :: BChan String
-> BrickEvent TUIName TUIEvent -> EventM TUIName TUIState ()
handleEvent BChan String
outChan = \case
      Brick.VtyEvent Event
ev ->
        case Event
ev of
          EvKey (KChar Char
'c') [Modifier
MCtrl] -> do
            Brick.halt
          EvKey Key
KEnter [] -> do
            st <- EventM TUIName TUIState TUIState
forall s (m :: * -> *). MonadState s m => m s
Brick.get
            case tuiMode st of
              TUIMode
TUIInsert -> do
                let input :: String
input = ShowS
forall a. [a] -> [a]
reverse (TUIState -> String
tuiInputBuffer TUIState
st)
                TUIState -> EventM TUIName TUIState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
Brick.put
                  TUIState
st
                    { tuiInputBuffer =
                        ""
                    , tuiMode =
                        TUINormal
                    }
                -- Send the input back through the output channel
                IO () -> EventM TUIName TUIState ()
forall a. IO a -> EventM TUIName TUIState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM TUIName TUIState ())
-> IO () -> EventM TUIName TUIState ()
forall a b. (a -> b) -> a -> b
$ BChan String -> String -> IO ()
forall a. BChan a -> a -> IO ()
Brick.writeBChan BChan String
outChan String
input
              TUIMode
TUINormal -> () -> EventM TUIName TUIState ()
forall a. a -> EventM TUIName TUIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          EvKey (KChar Char
c) [] -> do
            st <- EventM TUIName TUIState TUIState
forall s (m :: * -> *). MonadState s m => m s
Brick.get
            case tuiMode st of
              TUIMode
TUIInsert -> do
                TUIState -> EventM TUIName TUIState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
Brick.put
                  TUIState
st
                    { tuiInputBuffer =
                        c : tuiInputBuffer st
                    , tuiStatusLineWidget =
                        Brick.applyEdit
                          (TextZipper.insertChar c)
                          $ tuiStatusLineWidget st
                    }
              TUIMode
TUINormal -> () -> EventM TUIName TUIState ()
forall a. a -> EventM TUIName TUIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Event
_ -> () -> EventM TUIName TUIState ()
forall a. a -> EventM TUIName TUIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Brick.AppEvent TUIEvent
ev ->
        case TUIEvent
ev of
          TUIMessage String
msg -> do
            st <- EventM TUIName TUIState TUIState
forall s (m :: * -> *). MonadState s m => m s
Brick.get
            let logLines = TUIState -> Seq String
tuiLogLines TUIState
st Seq String -> String -> Seq String
forall a. Seq a -> a -> Seq a
|> String
msg
            Brick.put
              st
                { tuiLogLines =
                    logLines
                , tuiLogWidget =
                    Brick.str
                      $ foldr (\String
line String
acc -> String
line String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
acc) ""
                      $ logLines
                }
          TUIPretty a
obj -> do
            st <- EventM TUIName TUIState TUIState
forall s (m :: * -> *). MonadState s m => m s
Brick.get
            let logLines = TUIState -> Seq String
tuiLogLines TUIState
st Seq String -> String -> Seq String
forall a. Seq a -> a -> Seq a
|> a -> String
forall a. Show a => a -> String
show a
obj
            Brick.put
              st
                { tuiLogLines =
                    logLines
                , tuiLogWidget =
                    Brick.str
                      $ foldr (\String
line String
acc -> String
line String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
acc) ""
                      $ logLines
                }
          TUIEvent
TUICleanLog -> do
            st <- EventM TUIName TUIState TUIState
forall s (m :: * -> *). MonadState s m => m s
Brick.get
            Brick.put
              st
                { tuiLogLines =
                    Seq.empty
                , tuiLogWidget =
                    Brick.str ""
                }
          TUIReadLine String
prompt -> do
            st <- EventM TUIName TUIState TUIState
forall s (m :: * -> *). MonadState s m => m s
Brick.get
            Brick.put
              st
                { tuiStatusLineWidget =
                    Brick.applyEdit
                      (TextZipper.insertMany prompt . TextZipper.clearZipper)
                      $ tuiStatusLineWidget st
                , tuiMode =
                    TUIInsert
                }
          TUIStats MutagenState
mutSt -> do
            statsStr <- MutagenState -> EventM TUIName TUIState String
forall (m :: * -> *). MonadIO m => MutagenState -> m String
renderGlobalStats MutagenState
mutSt
            st <- Brick.get
            Brick.put
              st
                { tuiStatsWidget =
                    Brick.str statsStr
                }
          TUIBatch MutationBatch Args
batch -> do
            batchStr <- MutationBatch Args -> EventM TUIName TUIState String
forall (m :: * -> *). MonadIO m => MutationBatch Args -> m String
renderBatch MutationBatch Args
batch
            st <- Brick.get
            Brick.put
              st
                { tuiBatchWidget =
                    Brick.str batchStr
                }
      BrickEvent TUIName TUIEvent
_ ->
        () -> EventM TUIName TUIState ()
forall a. a -> EventM TUIName TUIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

{-------------------------------------------------------------------------------
-- * Derived printers
-------------------------------------------------------------------------------}

-- | Print the status of the current mutation batch.
renderBatch :: (MonadIO m) => MutationBatch Args -> m String
renderBatch :: forall (m :: * -> *). MonadIO m => MutationBatch Args -> m String
renderBatch MutationBatch Args
batch = do
  String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
    ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [ String
"Current mutation batch:"
      , String
"* Past positions: "
      ]
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [ Pos -> String
forall a. Show a => a -> String
show Pos
pos
         | Pos
pos <- [Pos] -> [Pos]
forall a. [a] -> [a]
reverse (MutationBatch Args -> [Pos]
forall args. MutationBatch args -> [Pos]
mbPastPositions MutationBatch Args
batch)
         ]
      [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> ( case MutationBatch Args -> [Pos]
forall args. MutationBatch args -> [Pos]
mbNextPositions MutationBatch Args
batch of
             [] -> []
             (Pos
p : [Pos]
ps) ->
               [ String
"================"
               , Pos -> String
forall a. Show a => a -> String
show Pos
p
               , String
"("
                   String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show ([Concretized Args] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (MutationBatch Args -> [Concretized Args]
forall args. MutationBatch args -> [Concretized args]
mbCurrBatch MutationBatch Args
batch))
                   String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" mutants left)"
               , String
"================"
               ]
                 [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [ Pos -> String
forall a. Show a => a -> String
show Pos
pos
                    | Pos
pos <- [Pos]
ps
                    ]
         )

-- | Render detailed statistics about the testing session.
renderGlobalStats :: (MonadIO m) => MutagenState -> m String
renderGlobalStats :: forall (m :: * -> *). MonadIO m => MutagenState -> m String
renderGlobalStats MutagenState
st = do
  now <- IO POSIXTime -> m POSIXTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
  let elapsed = POSIXTime
now POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
- MutagenState -> POSIXTime
stStartTime MutagenState
st
  return
    $ unlines
    $ [ "* Ran "
          <> show (stNumPassed st + stNumDiscarded st)
          <> " tests ("
          <> show (stNumInteresting st)
          <> " interesting, "
          <> show (stNumBoring st)
          <> " boring) (last interesting was "
          <> show (stNumTestsSinceLastInteresting st)
          <> " tests ago)"
      , "* Passed "
          <> show (stNumPassed st)
          <> " tests ("
          <> show (stNumDiscarded st)
          <> " discarded, "
          <> show (stNumFailed st)
          <> " failed)"
      , "* Tests origin: "
          <> show (stNumGenerated st)
          <> " generated, "
          <> show (stNumMutatedFromPassed st)
          <> " mutated from passed, "
          <> show (stNumMutatedFromDiscarded st)
          <> " mutated from discarded"
      , "* Mutant kinds: "
          <> show (stNumPureMutants st)
          <> " pure, "
          <> show (stNumRandMutants st)
          <> " random, "
          <> show (stNumFragMutants st)
          <> " fragments"
      , "* Enqueued tests for mutation: "
          <> show (mutationQueueSize (stPassedQueue st))
          <> " passed, "
          <> show (mutationQueueSize (stDiscardedQueue st))
          <> " discarded"
      , "* Auto-reset is "
          <> maybe "off" (const "on") (stAutoResetAfter st)
          <> ", using "
          <> show (stRandomMutations st)
          <> " random mutations (after "
          <> show (stNumTraceStoreResets st)
          <> " trace store resets)"
      , "* Current generation size: "
          <> show (stCurrentGenSize st)
      , "* Fragment store size: "
          <> show (fragmentStoreSize (stFragmentStore st))
      , "* Elapsed time: "
          <> show elapsed
          <> " seconds"
      ]

-- | Render short statistics about the testing session.
renderShortStats :: (MonadIO m) => MutagenState -> m String
renderShortStats :: forall (m :: * -> *). MonadIO m => MutagenState -> m String
renderShortStats MutagenState
st = do
  let total :: Int
total = MutagenState -> Int
stNumPassed MutagenState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MutagenState -> Int
stNumDiscarded MutagenState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MutagenState -> Int
stNumFailed MutagenState
st
  let mutated :: Int
mutated = MutagenState -> Int
stNumMutatedFromPassed MutagenState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MutagenState -> Int
stNumMutatedFromDiscarded MutagenState
st
  String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
"Executed "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
total
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" tests ("
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Int -> Int -> Int
percentage (MutagenState -> Int
stNumPassed MutagenState
st) Int
total)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"% passed, "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Int -> Int -> Int
percentage (MutagenState -> Int
stNumInteresting MutagenState
st) Int
total)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"% interesting, "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Int -> Int -> Int
percentage (MutagenState -> Int
stNumGenerated MutagenState
st) Int
total)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"% generated, "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Int -> Int -> Int
percentage Int
mutated Int
total)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"% mutated)"
  where
    percentage :: Int -> Int -> Int
    percentage :: Int -> Int -> Int
percentage Int
n Int
m = forall a b. (RealFrac a, Integral b) => a -> b
round @Double ((Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100)

{-------------------------------------------------------------------------------
-- * Helpers
-------------------------------------------------------------------------------}

-- | Pretty-print a value to stdout.
prettyPrint :: (MonadIO m, Show a) => a -> m ()
prettyPrint :: forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
prettyPrint =
  CheckColorTty -> OutputOptions -> a -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
CheckColorTty -> OutputOptions -> a -> m ()
pPrintOpt
    CheckColorTty
CheckColorTty
    OutputOptions
defaultOutputOptionsDarkBg
      { outputOptionsIndentAmount = 2
      , outputOptionsPageWidth = 100
      , outputOptionsCompact = False
      , outputOptionsCompactParens = False
      }

-- | Pretty-print a value to stdout in compact form.
compactPrint :: (MonadIO m, Show a) => a -> m ()
compactPrint :: forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
compactPrint =
  CheckColorTty -> OutputOptions -> a -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
CheckColorTty -> OutputOptions -> a -> m ()
pPrintOpt
    CheckColorTty
CheckColorTty
    OutputOptions
defaultOutputOptionsDarkBg
      { outputOptionsIndentAmount = 2
      , outputOptionsPageWidth = 100
      , outputOptionsCompact = True
      , outputOptionsCompactParens = True
      }