{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}

module Test.Sandwich.Formatters.TerminalUI.Draw where

import Brick
import Brick.Widgets.Border
import Brick.Widgets.Center
import qualified Brick.Widgets.List as L
import Control.Monad
import Control.Monad.Logger
import Control.Monad.Reader
import Data.Foldable
import qualified Data.List as L
import Data.Maybe
import qualified Data.Sequence as Seq
import Data.String.Interpolate
import qualified Data.Text.Encoding as E
import Data.Time.Clock
import GHC.Stack
import qualified Graphics.Vty as V
import Lens.Micro
import Safe
import Test.Sandwich.Formatters.Common.Count
import Test.Sandwich.Formatters.Common.Util
import Test.Sandwich.Formatters.TerminalUI.AttrMap
import Test.Sandwich.Formatters.TerminalUI.Draw.ColorProgressBar
import Test.Sandwich.Formatters.TerminalUI.Draw.ToBrickWidget
import Test.Sandwich.Formatters.TerminalUI.Draw.TopBox
import Test.Sandwich.Formatters.TerminalUI.Draw.Util
import Test.Sandwich.Formatters.TerminalUI.Types
import Test.Sandwich.Types.RunTree
import Test.Sandwich.Types.Spec


drawUI :: AppState -> [Widget ClickableName]
drawUI :: AppState -> [Widget ClickableName]
drawUI AppState
app = [Widget ClickableName
ui]
  where
    ui :: Widget ClickableName
ui = forall n. [Widget n] -> Widget n
vBox [
      forall {n}. AppState -> Widget n
topBox AppState
app
      , forall {n}. AppState -> Widget n
borderWithCounts AppState
app
      , AppState -> Widget ClickableName
mainList AppState
app
      , forall n. Ord n => n -> Widget n -> Widget n
clickable ClickableName
ColorBar forall a b. (a -> b) -> a -> b
$ forall {n}. AppState -> Widget n
bottomProgressBarColored AppState
app
      ]

mainList :: AppState -> Widget ClickableName
mainList AppState
app = forall n. Widget n -> Widget n
hCenter forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
padAll Int
1 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Int -> Bool -> e -> Widget n)
-> Bool -> GenericList n t e -> Widget n
L.renderListWithIndex Int -> Bool -> MainListElem -> Widget ClickableName
listDrawElement Bool
True (AppState
app forall s a. s -> Getting a s a -> a
^. Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList)
  where
    listDrawElement :: Int -> Bool -> MainListElem -> Widget ClickableName
listDrawElement Int
ix Bool
isSelected x :: MainListElem
x@(MainListElem {Bool
Int
String
Maybe String
Seq LogEntry
RunNodeCommon
Status
ident :: MainListElem -> Int
node :: MainListElem -> RunNodeCommon
folderPath :: MainListElem -> Maybe String
visibilityLevel :: MainListElem -> Int
logs :: MainListElem -> Seq LogEntry
status :: MainListElem -> Status
open :: MainListElem -> Bool
toggled :: MainListElem -> Bool
depth :: MainListElem -> Int
label :: MainListElem -> String
ident :: Int
node :: RunNodeCommon
folderPath :: Maybe String
visibilityLevel :: Int
logs :: Seq LogEntry
status :: Status
open :: Bool
toggled :: Bool
depth :: Int
label :: String
..}) = forall n. Ord n => n -> Widget n -> Widget n
clickable (Int -> ClickableName
ListRow Int
ix) forall a b. (a -> b) -> a -> b
$ forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad (Int
4 forall a. Num a => a -> a -> a
* Int
depth)) forall a b. (a -> b) -> a -> b
$ (if Bool
isSelected then forall n. Widget n -> Widget n
border else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
vBox forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [
      forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {p} {n}. p -> MainListElem -> Widget n
renderLine Bool
isSelected MainListElem
x
      , do
          forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
toggled
          let infoWidgets :: [Widget n]
infoWidgets = forall {n}. MainListElem -> [Widget n]
getInfoWidgets MainListElem
x
          forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null forall {n}. [Widget n]
infoWidgets)
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
4) forall a b. (a -> b) -> a -> b
$
            forall n. (Ord n, Show n) => n -> Int -> Widget n -> Widget n
fixedHeightOrViewportPercent (Text -> ClickableName
InnerViewport [i|viewport_#{ident}|]) Int
33 forall a b. (a -> b) -> a -> b
$
              forall n. [Widget n] -> Widget n
vBox forall {n}. [Widget n]
infoWidgets
      ]

    renderLine :: p -> MainListElem -> Widget n
renderLine p
_isSelected (MainListElem {Bool
Int
String
Maybe String
Seq LogEntry
RunNodeCommon
Status
ident :: Int
node :: RunNodeCommon
folderPath :: Maybe String
visibilityLevel :: Int
logs :: Seq LogEntry
status :: Status
open :: Bool
toggled :: Bool
depth :: Int
label :: String
ident :: MainListElem -> Int
node :: MainListElem -> RunNodeCommon
folderPath :: MainListElem -> Maybe String
visibilityLevel :: MainListElem -> Int
logs :: MainListElem -> Seq LogEntry
status :: MainListElem -> Status
open :: MainListElem -> Bool
toggled :: MainListElem -> Bool
depth :: MainListElem -> Int
label :: MainListElem -> String
..}) = forall n. [Widget n] -> Widget n
hBox forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [
      forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
openMarkerAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str (if Bool
open then String
"[-] " else String
"[+] ")
      , forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withAttr (Status -> AttrName
chooseAttr Status
status) (forall n. String -> Widget n
str String
label)
      , if Bool -> Bool
not (AppState
app forall s a. s -> Getting a s a -> a
^. Lens' AppState Bool
appShowFileLocations) then forall a. Maybe a
Nothing else
          case forall s l t. RunNodeCommonWithStatus s l t -> Maybe SrcLoc
runTreeLoc RunNodeCommon
node of
            Maybe SrcLoc
Nothing -> forall a. Maybe a
Nothing
            Just SrcLoc
loc ->
              forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
hBox [forall n. String -> Widget n
str String
" ["
                          , forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
logFilenameAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ SrcLoc -> String
srcLocFile SrcLoc
loc
                          , forall n. String -> Widget n
str String
":"
                          , forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
logLineAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ SrcLoc -> Int
srcLocStartLine SrcLoc
loc
                          , forall n. String -> Widget n
str String
"]"]
      , if Bool -> Bool
not (AppState
app forall s a. s -> Getting a s a -> a
^. Lens' AppState Bool
appShowVisibilityThresholds) then forall a. Maybe a
Nothing else
          forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
hBox [forall n. String -> Widget n
str String
" ["
                      , forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
visibilityThresholdIndicatorMutedAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"V="
                      , forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
visibilityThresholdIndicatorAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
visibilityLevel
                      , forall n. String -> Widget n
str String
"]"]
      , forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. Padding -> Widget n -> Widget n
padRight Padding
Max forall a b. (a -> b) -> a -> b
$ forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
toggleMarkerAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str (if Bool
toggled then String
" [-]" else String
" [+]")
      , if Bool -> Bool
not (AppState
app forall s a. s -> Getting a s a -> a
^. Lens' AppState Bool
appShowRunTimes) then forall a. Maybe a
Nothing else case Status
status of
          Running {UTCTime
Async Result
statusAsync :: Status -> Async Result
statusStartTime :: Status -> UTCTime
statusAsync :: Async Result
statusStartTime :: UTCTime
..} -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show UTCTime
statusStartTime
          Done {UTCTime
Result
statusResult :: Status -> Result
statusEndTime :: Status -> UTCTime
statusResult :: Result
statusEndTime :: UTCTime
statusStartTime :: UTCTime
statusStartTime :: Status -> UTCTime
..} -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall n. Image -> Widget n
raw forall a b. (a -> b) -> a -> b
$ Attr -> String -> Image
V.string Attr
attr forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> String
formatNominalDiffTime (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
statusEndTime UTCTime
statusStartTime)
            where totalElapsed :: Double
totalElapsed = forall a b. (Real a, Fractional b) => a -> b
realToFrac (forall a. Ord a => a -> a -> a
max (AppState
app forall s a. s -> Getting a s a -> a
^. Lens' AppState NominalDiffTime
appTimeSinceStart) (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
statusEndTime (AppState
app forall s a. s -> Getting a s a -> a
^. Lens' AppState UTCTime
appStartTime)))
                  duration :: Double
duration = forall a b. (Real a, Fractional b) => a -> b
realToFrac (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
statusEndTime UTCTime
statusStartTime)
                  Double
intensity :: Double = forall a. Floating a => a -> a -> a
logBase (Double
totalElapsed forall a. Num a => a -> a -> a
+ Double
1) (Double
duration forall a. Num a => a -> a -> a
+ Double
1)
                  Int
minGray :: Int = Int
50
                  Int
maxGray :: Int = Int
255
                  Int
level :: Int = forall a. Ord a => a -> a -> a
min Int
maxGray forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Int
minGray forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
round (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minGray forall a. Num a => a -> a -> a
+ (Double
intensity forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
maxGray forall a. Num a => a -> a -> a
- Int
minGray))))
                  attr :: Attr
attr = V.Attr {
                    attrStyle :: MaybeDefault Style
V.attrStyle = forall v. MaybeDefault v
V.Default
                    , attrForeColor :: MaybeDefault Color
V.attrForeColor = forall v. v -> MaybeDefault v
V.SetTo (forall {i}. Integral i => i -> Color
grayAt Int
level)
                    , attrBackColor :: MaybeDefault Color
V.attrBackColor = forall v. MaybeDefault v
V.Default
                    , attrURL :: MaybeDefault Text
V.attrURL = forall v. MaybeDefault v
V.Default
                    }
          Status
_ -> forall a. Maybe a
Nothing
      ]

    getInfoWidgets :: MainListElem -> [Widget n]
getInfoWidgets mle :: MainListElem
mle@(MainListElem {Bool
Int
String
Maybe String
Seq LogEntry
RunNodeCommon
Status
ident :: Int
node :: RunNodeCommon
folderPath :: Maybe String
visibilityLevel :: Int
logs :: Seq LogEntry
status :: Status
open :: Bool
toggled :: Bool
depth :: Int
label :: String
ident :: MainListElem -> Int
node :: MainListElem -> RunNodeCommon
folderPath :: MainListElem -> Maybe String
visibilityLevel :: MainListElem -> Int
logs :: MainListElem -> Seq LogEntry
status :: MainListElem -> Status
open :: MainListElem -> Bool
toggled :: MainListElem -> Bool
depth :: MainListElem -> Int
label :: MainListElem -> String
..}) = forall a. [Maybe a] -> [a]
catMaybes [forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall r a. Reader r a -> r -> a
runReader (forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget Status
status) (AppState
app forall s a. s -> Getting a s a -> a
^. Lens' AppState CustomExceptionFormatters
appCustomExceptionFormatters), forall {n}. MainListElem -> Maybe (Widget n)
callStackWidget MainListElem
mle, forall {m :: * -> *} {n}.
(Monad m, Alternative m) =>
MainListElem -> m (Widget n)
logWidget MainListElem
mle]

    callStackWidget :: MainListElem -> Maybe (Widget n)
callStackWidget (MainListElem {Bool
Int
String
Maybe String
Seq LogEntry
RunNodeCommon
Status
ident :: Int
node :: RunNodeCommon
folderPath :: Maybe String
visibilityLevel :: Int
logs :: Seq LogEntry
status :: Status
open :: Bool
toggled :: Bool
depth :: Int
label :: String
ident :: MainListElem -> Int
node :: MainListElem -> RunNodeCommon
folderPath :: MainListElem -> Maybe String
visibilityLevel :: MainListElem -> Int
logs :: MainListElem -> Seq LogEntry
status :: MainListElem -> Status
open :: MainListElem -> Bool
toggled :: MainListElem -> Bool
depth :: MainListElem -> Int
label :: MainListElem -> String
..}) = do
      CallStack
cs <- CustomExceptionFormatters -> Status -> Maybe CallStack
getCallStackFromStatus (AppState
app forall s a. s -> Getting a s a -> a
^. Lens' AppState CustomExceptionFormatters
appCustomExceptionFormatters) Status
status
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> Widget n -> Widget n
borderWithLabel (forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"Callstack") forall a b. (a -> b) -> a -> b
$ forall r a. Reader r a -> r -> a
runReader (forall a n.
ToBrickWidget a =>
a -> Reader CustomExceptionFormatters (Widget n)
toBrickWidget CallStack
cs) (AppState
app forall s a. s -> Getting a s a -> a
^. Lens' AppState CustomExceptionFormatters
appCustomExceptionFormatters)

    logWidget :: MainListElem -> m (Widget n)
logWidget (MainListElem {Bool
Int
String
Maybe String
Seq LogEntry
RunNodeCommon
Status
ident :: Int
node :: RunNodeCommon
folderPath :: Maybe String
visibilityLevel :: Int
logs :: Seq LogEntry
status :: Status
open :: Bool
toggled :: Bool
depth :: Int
label :: String
ident :: MainListElem -> Int
node :: MainListElem -> RunNodeCommon
folderPath :: MainListElem -> Maybe String
visibilityLevel :: MainListElem -> Int
logs :: MainListElem -> Seq LogEntry
status :: MainListElem -> Status
open :: MainListElem -> Bool
toggled :: MainListElem -> Bool
depth :: MainListElem -> Int
label :: MainListElem -> String
..}) = do
      let filteredLogs :: Seq LogEntry
filteredLogs = case AppState
app forall s a. s -> Getting a s a -> a
^. Lens' AppState (Maybe LogLevel)
appLogLevel of
            Maybe LogLevel
Nothing -> forall a. Monoid a => a
mempty
            Just LogLevel
logLevel -> forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (\LogEntry
x -> LogEntry -> LogLevel
logEntryLevel LogEntry
x forall a. Ord a => a -> a -> Bool
>= LogLevel
logLevel) Seq LogEntry
logs
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Seq a -> Bool
Seq.null Seq LogEntry
filteredLogs)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n. Widget n -> Widget n -> Widget n
borderWithLabel (forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"Logs") forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
vBox forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {n}. LogEntry -> Widget n
logEntryWidget Seq LogEntry
filteredLogs

    logEntryWidget :: LogEntry -> Widget n
logEntryWidget (LogEntry {UTCTime
Text
LogStr
LogLevel
Loc
logEntryStr :: LogEntry -> LogStr
logEntrySource :: LogEntry -> Text
logEntryLoc :: LogEntry -> Loc
logEntryTime :: LogEntry -> UTCTime
logEntryStr :: LogStr
logEntryLevel :: LogLevel
logEntrySource :: Text
logEntryLoc :: Loc
logEntryTime :: UTCTime
logEntryLevel :: LogEntry -> LogLevel
..}) = forall n. [Widget n] -> Widget n
hBox [
      forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
logTimestampAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str (forall a. Show a => a -> String
show UTCTime
logEntryTime)
      , forall n. String -> Widget n
str String
" "
      , forall {n}. LogLevel -> Widget n
logLevelWidget LogLevel
logEntryLevel
      , forall n. String -> Widget n
str String
" "
      , forall {n}. Loc -> Widget n
logLocWidget Loc
logEntryLoc
      , forall n. String -> Widget n
str String
" "
      , forall n. Text -> Widget n
txtWrap (ByteString -> Text
E.decodeUtf8 forall a b. (a -> b) -> a -> b
$ LogStr -> ByteString
fromLogStr LogStr
logEntryStr)
      ]

    logLocWidget :: Loc -> Widget n
logLocWidget (Loc {loc_start :: Loc -> CharPos
loc_start=(Int
line, Int
ch), String
CharPos
loc_package :: Loc -> String
loc_module :: Loc -> String
loc_filename :: Loc -> String
loc_end :: Loc -> CharPos
loc_end :: CharPos
loc_module :: String
loc_package :: String
loc_filename :: String
..}) = forall n. [Widget n] -> Widget n
hBox [
      forall n. String -> Widget n
str String
"["
      , forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
logFilenameAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
loc_filename
      , forall n. String -> Widget n
str String
":"
      , forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
logLineAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str (forall a. Show a => a -> String
show Int
line)
      , forall n. String -> Widget n
str String
":"
      , forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
logChAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str (forall a. Show a => a -> String
show Int
ch)
      , forall n. String -> Widget n
str String
"]"
      ]

    logLevelWidget :: LogLevel -> Widget n
logLevelWidget LogLevel
LevelDebug = forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
debugAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"(DEBUG)"
    logLevelWidget LogLevel
LevelInfo = forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
infoAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"(INFO)"
    logLevelWidget LogLevel
LevelWarn = forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
infoAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"(WARN)"
    logLevelWidget LogLevel
LevelError = forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
infoAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str String
"(ERROR)"
    logLevelWidget (LevelOther Text
x) = forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
infoAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str [i|#{x}|]


borderWithCounts :: AppState -> Widget n
borderWithCounts AppState
app = forall n. Widget n -> Widget n
hBorderWithLabel forall a b. (a -> b) -> a -> b
$ forall n. Int -> Widget n -> Widget n
padLeftRight Int
1 forall a b. (a -> b) -> a -> b
$ forall n. [Widget n] -> Widget n
hBox (forall a. [a] -> [[a]] -> [a]
L.intercalate [forall n. String -> Widget n
str String
", "] forall {n}. [[Widget n]]
countWidgets forall a. Semigroup a => a -> a -> a
<> [forall n. String -> Widget n
str [i| of |]
                                                                                                          , forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
totalAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
totalNumTests
                                                                                                          , forall n. String -> Widget n
str [i| in |]
                                                                                                          , forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
timeAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> String
formatNominalDiffTime (AppState
app forall s a. s -> Getting a s a -> a
^. Lens' AppState NominalDiffTime
appTimeSinceStart)])
  where
    countWidgets :: [[Widget n]]
countWidgets =
      (if Int
totalSucceededTests forall a. Ord a => a -> a -> Bool
> Int
0 then [[forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
successAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
totalSucceededTests, forall n. String -> Widget n
str String
" succeeded"]] else forall a. Monoid a => a
mempty)
      forall a. Semigroup a => a -> a -> a
<> (if Int
totalFailedTests forall a. Ord a => a -> a -> Bool
> Int
0 then [[forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
failureAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
totalFailedTests, forall n. String -> Widget n
str String
" failed"]] else forall a. Monoid a => a
mempty)
      forall a. Semigroup a => a -> a -> a
<> (if Int
totalPendingTests forall a. Ord a => a -> a -> Bool
> Int
0 then [[forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
pendingAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
totalPendingTests, forall n. String -> Widget n
str String
" pending"]] else forall a. Monoid a => a
mempty)
      forall a. Semigroup a => a -> a -> a
<> (if Int
totalRunningTests forall a. Ord a => a -> a -> Bool
> Int
0 then [[forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
runningAttr forall a b. (a -> b) -> a -> b
$ forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
totalRunningTests, forall n. String -> Widget n
str String
" running"]] else forall a. Monoid a => a
mempty)
      forall a. Semigroup a => a -> a -> a
<> (if Int
totalNotStartedTests forall a. Ord a => a -> a -> Bool
> Int
0 then [[forall n. String -> Widget n
str forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Int
totalNotStartedTests, forall n. String -> Widget n
str String
" not started"]] else forall a. Monoid a => a
mempty)

    totalNumTests :: Int
totalNumTests = forall s l t context.
(forall context1. RunNodeWithStatus context1 s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere forall {context} {s} {l} {t}.
RunNodeWithStatus context s l t -> Bool
isItBlock (AppState
app forall s a. s -> Getting a s a -> a
^. Lens'
  AppState [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
appRunTree)
    totalSucceededTests :: Int
totalSucceededTests = forall s l t context.
(forall context1. RunNodeWithStatus context1 s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere forall {context} {l} {t}.
RunNodeWithStatus context Status l t -> Bool
isSuccessItBlock (AppState
app forall s a. s -> Getting a s a -> a
^. Lens'
  AppState [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
appRunTree)
    totalPendingTests :: Int
totalPendingTests = forall s l t context.
(forall context1. RunNodeWithStatus context1 s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere forall {context} {l} {t}.
RunNodeWithStatus context Status l t -> Bool
isPendingItBlock (AppState
app forall s a. s -> Getting a s a -> a
^. Lens'
  AppState [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
appRunTree)
    totalFailedTests :: Int
totalFailedTests = forall s l t context.
(forall context1. RunNodeWithStatus context1 s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere forall {context} {l} {t}.
RunNodeWithStatus context Status l t -> Bool
isFailedItBlock (AppState
app forall s a. s -> Getting a s a -> a
^. Lens'
  AppState [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
appRunTree)
    totalRunningTests :: Int
totalRunningTests = forall s l t context.
(forall context1. RunNodeWithStatus context1 s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere forall {context} {l} {t}.
RunNodeWithStatus context Status l t -> Bool
isRunningItBlock (AppState
app forall s a. s -> Getting a s a -> a
^. Lens'
  AppState [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
appRunTree)
    totalNotStartedTests :: Int
totalNotStartedTests = forall s l t context.
(forall context1. RunNodeWithStatus context1 s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere forall {context} {l} {t}.
RunNodeWithStatus context Status l t -> Bool
isNotStartedItBlock (AppState
app forall s a. s -> Getting a s a -> a
^. Lens'
  AppState [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
appRunTree)

getCallStackFromStatus :: CustomExceptionFormatters -> Status -> Maybe CallStack
getCallStackFromStatus :: CustomExceptionFormatters -> Status -> Maybe CallStack
getCallStackFromStatus CustomExceptionFormatters
cef (Done {statusResult :: Status -> Result
statusResult=(Failure reason :: FailureReason
reason@(GotException Maybe CallStack
_ Maybe String
_ (SomeExceptionWithEq SomeException
baseException)))}) =
  case forall a. [a] -> Maybe a
headMay forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [SomeException -> Maybe CustomTUIException
x SomeException
baseException | SomeException -> Maybe CustomTUIException
x <- CustomExceptionFormatters
cef] of
    Just (CustomTUIExceptionMessageAndCallStack Text
_ Maybe CallStack
maybeCs) -> Maybe CallStack
maybeCs
    Maybe CustomTUIException
_ -> FailureReason -> Maybe CallStack
failureCallStack FailureReason
reason
getCallStackFromStatus CustomExceptionFormatters
_ (Done {statusResult :: Status -> Result
statusResult=(Failure FailureReason
reason)}) = FailureReason -> Maybe CallStack
failureCallStack FailureReason
reason
getCallStackFromStatus CustomExceptionFormatters
_ Status
_ = forall a. Maybe a
Nothing