{-# LANGUAGE DeriveFunctor #-}
{-# 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

    -- * Derived printers
  , printGlobalStats
  , printShortStats
  , printBatchStatus

    -- * Helpers
  , prettyPrint
  , compactPrint
  )
where

import Brick (App (..), BrickEvent, EventM, str)
import qualified Brick
import qualified Brick.Widgets.Border as Brick
import Brick.Widgets.List (List)
import qualified Brick.Widgets.List as Brick
import Control.Monad (forM_, void)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Reader (ReaderT (..), ask, lift)
import Control.Monad.State (StateT)
import Data.Time.Clock.POSIX (getPOSIXTime)
import qualified Data.Vector as Vector
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
  }

-- | t'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 t'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 ()

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

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

{-------------------------------------------------------------------------------
-- * 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
      }

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

-- | A TUI implementation using the Brick library.
brickTUI :: IO (TUI IO)
brickTUI :: IO (TUI IO)
brickTUI = do
  IO ()
startTUI
  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 = IO () -> String -> IO ()
forall a b. a -> b -> a
const (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
      , tuiPretty :: forall a. Show a => a -> IO ()
tuiPretty = IO () -> a -> IO ()
forall a b. a -> b -> a
const (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
      }

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

-- | State of the TUI.
data TUIState = TUIState
  { TUIState -> List Name String
tuiTopLog :: List Name String
  , TUIState -> List Name String
tuiBottomLog :: List Name String
  }

-- | Start the Brick-based TUI.
startTUI :: IO ()
startTUI :: IO ()
startTUI =
  IO TUIState -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO TUIState -> IO ()) -> IO TUIState -> IO ()
forall a b. (a -> b) -> a -> b
$ App TUIState (ZonkAny 0) Name -> TUIState -> IO TUIState
forall n s e. Ord n => App s e n -> s -> IO s
Brick.defaultMain App TUIState (ZonkAny 0) Name
forall e. App TUIState e Name
theApp TUIState
initialState
  where
    theApp :: App TUIState e Name
    theApp :: forall e. App TUIState e Name
theApp =
      App
        { appDraw :: TUIState -> [Widget Name]
appDraw = TUIState -> [Widget Name]
drawUI
        , appChooseCursor :: TUIState -> [CursorLocation Name] -> Maybe (CursorLocation Name)
appChooseCursor = TUIState -> [CursorLocation Name] -> Maybe (CursorLocation Name)
forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
Brick.neverShowCursor
        , appHandleEvent :: BrickEvent Name e -> EventM Name TUIState ()
appHandleEvent = BrickEvent Name e -> EventM Name TUIState ()
forall e. BrickEvent Name e -> EventM Name TUIState ()
handleEvent
        , appStartEvent :: EventM Name TUIState ()
appStartEvent = () -> EventM Name TUIState ()
forall a. a -> EventM Name 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
theMap
        }

    initialState :: TUIState
    initialState :: TUIState
initialState =
      TUIState
        { tuiTopLog :: List Name String
tuiTopLog = Name -> Vector String -> Int -> List Name String
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
Brick.list Name
TopLog ([String] -> Vector String
forall a. [a] -> Vector a
Vector.fromList []) Int
1
        , tuiBottomLog :: List Name String
tuiBottomLog = Name -> Vector String -> Int -> List Name String
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
Brick.list Name
BottomLog ([String] -> Vector String
forall a. [a] -> Vector a
Vector.fromList []) Int
1
        }

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

    drawUI :: TUIState -> [Brick.Widget Name]
    drawUI :: TUIState -> [Widget Name]
drawUI TUIState
st =
      [ [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
Brick.vBox
          [ Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
Brick.borderWithLabel (String -> Widget Name
forall n. String -> Widget n
Brick.str String
"Top Log")
              (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ (Bool -> String -> Widget Name)
-> Bool -> List Name String -> Widget Name
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
Brick.renderList Bool -> String -> Widget Name
drawLine Bool
True (TUIState -> List Name String
tuiTopLog TUIState
st)
          , Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
Brick.borderWithLabel (String -> Widget Name
forall n. String -> Widget n
Brick.str String
"Bottom Log")
              (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ (Bool -> String -> Widget Name)
-> Bool -> List Name String -> Widget Name
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
Brick.renderList Bool -> String -> Widget Name
drawLine Bool
True (TUIState -> List Name String
tuiBottomLog TUIState
st)
          ]
      ]

    drawLine :: Bool -> String -> Brick.Widget Name
    drawLine :: Bool -> String -> Widget Name
drawLine Bool
_selected String
txt =
      String -> Widget Name
forall n. String -> Widget n
Brick.str String
txt

    handleEvent :: BrickEvent Name e -> EventM Name TUIState ()
    handleEvent :: forall e. BrickEvent Name e -> EventM Name TUIState ()
handleEvent = \case
      Brick.VtyEvent (EvKey (KChar Char
'c') [Modifier
MCtrl]) -> EventM Name TUIState ()
forall n s. EventM n s ()
Brick.halt
      BrickEvent Name e
_ -> () -> EventM Name TUIState ()
forall a. a -> EventM Name TUIState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

-- | Print the status of the current mutation batch.
printBatchStatus :: (MonadTerminal m) => MutationBatch Args -> m ()
printBatchStatus :: forall (m :: * -> *). MonadTerminal m => MutationBatch Args -> m ()
printBatchStatus MutationBatch Args
batch = do
  String -> m ()
forall (m :: * -> *). MonadTerminal m => String -> m ()
message (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Current mutation batch:"
  -- past positions
  [Pos] -> (Pos -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Pos] -> [Pos]
forall a. [a] -> [a]
reverse (MutationBatch Args -> [Pos]
forall args. MutationBatch args -> [Pos]
mbPastPositions MutationBatch Args
batch)) ((Pos -> m ()) -> m ()) -> (Pos -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Pos
pos ->
    Pos -> m ()
forall a. Show a => a -> m ()
forall (m :: * -> *) a. (MonadTerminal m, Show a) => a -> m ()
pretty Pos
pos
  case MutationBatch Args -> [Pos]
forall args. MutationBatch args -> [Pos]
mbNextPositions MutationBatch Args
batch of
    [] -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Pos
p : [Pos]
ps) -> do
      String -> m ()
forall (m :: * -> *). MonadTerminal m => String -> m ()
message String
"================"
      Pos -> m ()
forall a. Show a => a -> m ()
forall (m :: * -> *) a. (MonadTerminal m, Show a) => a -> m ()
pretty Pos
p
      String -> m ()
forall (m :: * -> *). MonadTerminal m => String -> m ()
message
        (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ 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 -> m ()
forall (m :: * -> *). MonadTerminal m => String -> m ()
message String
"================"
      [Pos] -> (Pos -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Pos]
ps ((Pos -> m ()) -> m ()) -> (Pos -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Pos
pos ->
        Pos -> m ()
forall a. Show a => a -> m ()
forall (m :: * -> *) a. (MonadTerminal m, Show a) => a -> m ()
pretty Pos
pos

-- | Print detailed statistics about the testing session.
printGlobalStats :: (MonadIO m, MonadTerminal m) => MutagenState -> m ()
printGlobalStats :: forall (m :: * -> *).
(MonadIO m, MonadTerminal m) =>
MutagenState -> m ()
printGlobalStats MutagenState
st = do
  String -> m ()
forall (m :: * -> *). MonadTerminal m => String -> m ()
message
    String
"=== Statistics ==="
  String -> m ()
forall (m :: * -> *). MonadTerminal m => String -> m ()
message
    (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"* Ran "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (MutagenState -> Int
stNumPassed MutagenState
st Int -> Int -> Int
forall a. Num a => a -> a -> a
+ MutagenState -> Int
stNumDiscarded MutagenState
st)
      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 (MutagenState -> Int
stNumInteresting MutagenState
st)
      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 (MutagenState -> Int
stNumBoring MutagenState
st)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" boring) (last interesting was "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (MutagenState -> Int
stNumTestsSinceLastInteresting MutagenState
st)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" tests ago)"
  String -> m ()
forall (m :: * -> *). MonadTerminal m => String -> m ()
message
    (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"* Passed "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (MutagenState -> Int
stNumPassed MutagenState
st)
      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 (MutagenState -> Int
stNumDiscarded MutagenState
st)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" discarded, "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (MutagenState -> Int
stNumFailed MutagenState
st)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" failed)"
  String -> m ()
forall (m :: * -> *). MonadTerminal m => String -> m ()
message
    (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"* Tests origin: "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (MutagenState -> Int
stNumGenerated MutagenState
st)
      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 (MutagenState -> Int
stNumMutatedFromPassed MutagenState
st)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" mutated from passed, "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (MutagenState -> Int
stNumMutatedFromDiscarded MutagenState
st)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" mutated from discarded"
  String -> m ()
forall (m :: * -> *). MonadTerminal m => String -> m ()
message
    (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"* Mutant kinds: "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (MutagenState -> Int
stNumPureMutants MutagenState
st)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" pure, "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (MutagenState -> Int
stNumRandMutants MutagenState
st)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" random, "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (MutagenState -> Int
stNumFragMutants MutagenState
st)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" fragments"
  String -> m ()
forall (m :: * -> *). MonadTerminal m => String -> m ()
message
    (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"* Enqueued tests for mutation: "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (MutationQueue -> Int
mutationQueueSize (MutagenState -> MutationQueue
stPassedQueue MutagenState
st))
      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 (MutationQueue -> Int
mutationQueueSize (MutagenState -> MutationQueue
stDiscardedQueue MutagenState
st))
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" discarded"
  String -> m ()
forall (m :: * -> *). MonadTerminal m => String -> m ()
message
    (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"* Auto-reset is "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> (Int -> String) -> Maybe Int -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"off" (String -> Int -> String
forall a b. a -> b -> a
const String
"on") (MutagenState -> Maybe Int
stAutoResetAfter MutagenState
st)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", using "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (MutagenState -> Int
stRandomMutations MutagenState
st)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" random mutations (after "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (MutagenState -> Int
stNumTraceStoreResets MutagenState
st)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" trace store resets)"
  String -> m ()
forall (m :: * -> *). MonadTerminal m => String -> m ()
message
    (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"* Current generation size: "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (MutagenState -> Int
stCurrentGenSize MutagenState
st)
  String -> m ()
forall (m :: * -> *). MonadTerminal m => String -> m ()
message
    (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"* Fragment store size: "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [(TypeRep, Int)] -> String
forall a. Show a => a -> String
show (FragmentStore -> [(TypeRep, Int)]
fragmentStoreSize (MutagenState -> FragmentStore
stFragmentStore MutagenState
st))
  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
  message
    $ "* Elapsed time: "
      <> show elapsed
      <> " seconds"
  message
    "=================="

-- | Print short statistics about the testing session.
printShortStats :: (MonadTerminal m) => MutagenState -> m ()
printShortStats :: forall (m :: * -> *). MonadTerminal m => MutagenState -> m ()
printShortStats 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 ()
forall (m :: * -> *). MonadTerminal m => String -> m ()
message
    (String -> m ()) -> String -> m ()
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
      }