{-# 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 Lens.Micro hiding (ix)
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.RunTimes
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 = [Widget ClickableName] -> Widget ClickableName
forall n. [Widget n] -> Widget n
vBox [
      AppState -> Widget ClickableName
forall {n}. AppState -> Widget n
topBox AppState
app
      , AppState -> Widget ClickableName
forall {n}. AppState -> Widget n
borderWithCounts AppState
app
      , AppState -> Widget ClickableName
mainList AppState
app
      , ClickableName -> Widget ClickableName -> Widget ClickableName
forall n. Ord n => n -> Widget n -> Widget n
clickable ClickableName
ColorBar (Widget ClickableName -> Widget ClickableName)
-> Widget ClickableName -> Widget ClickableName
forall a b. (a -> b) -> a -> b
$ AppState -> Widget ClickableName
forall {n}. AppState -> Widget n
bottomProgressBarColored AppState
app
      ]

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

    renderLine :: p -> MainListElem -> Widget n
renderLine p
_isSelected (MainListElem {Bool
Int
String
Maybe String
Seq LogEntry
RunNodeCommon
Status
label :: MainListElem -> String
depth :: MainListElem -> Int
toggled :: MainListElem -> Bool
open :: MainListElem -> Bool
status :: MainListElem -> Status
logs :: MainListElem -> Seq LogEntry
visibilityLevel :: MainListElem -> Int
folderPath :: MainListElem -> Maybe String
node :: MainListElem -> RunNodeCommon
ident :: MainListElem -> Int
label :: String
depth :: Int
toggled :: Bool
open :: Bool
status :: Status
logs :: Seq LogEntry
visibilityLevel :: Int
folderPath :: Maybe String
node :: RunNodeCommon
ident :: Int
..}) = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ [Maybe (Widget n)] -> [Widget n]
forall a. [Maybe a] -> [a]
catMaybes [
      Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
openMarkerAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str (if Bool
open then String
"[-] " else String
"[+] ")
      , Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr (Status -> AttrName
chooseAttr Status
status) (String -> Widget n
forall n. String -> Widget n
str String
label)
      , if Bool -> Bool
not (AppState
app AppState -> Getting Bool AppState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool AppState Bool
Lens' AppState Bool
appShowFileLocations) then Maybe (Widget n)
forall a. Maybe a
Nothing else
          case RunNodeCommon -> Maybe SrcLoc
forall s l t. RunNodeCommonWithStatus s l t -> Maybe SrcLoc
runTreeLoc RunNodeCommon
node of
            Maybe SrcLoc
Nothing -> Maybe (Widget n)
forall a. Maybe a
Nothing
            Just SrcLoc
loc ->
              Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [String -> Widget n
forall n. String -> Widget n
str String
" ["
                          , AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
logFilenameAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ SrcLoc -> String
srcLocFile SrcLoc
loc
                          , String -> Widget n
forall n. String -> Widget n
str String
":"
                          , AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
logLineAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Int
srcLocStartLine SrcLoc
loc
                          , String -> Widget n
forall n. String -> Widget n
str String
"]"]
      , if Bool -> Bool
not (AppState
app AppState -> Getting Bool AppState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool AppState Bool
Lens' AppState Bool
appShowVisibilityThresholds) then Maybe (Widget n)
forall a. Maybe a
Nothing else
          Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [String -> Widget n
forall n. String -> Widget n
str String
" ["
                      , AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
visibilityThresholdIndicatorMutedAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
"V="
                      , AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
visibilityThresholdIndicatorAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
visibilityLevel
                      , String -> Widget n
forall n. String -> Widget n
str String
"]"]
      , Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ Padding -> Widget n -> Widget n
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
toggleMarkerAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str (if Bool
toggled then String
" [-]" else String
" [+]")
      , if Bool -> Bool
not (AppState
app AppState -> Getting Bool AppState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool AppState Bool
Lens' AppState Bool
appShowRunTimes) then Maybe (Widget n)
forall a. Maybe a
Nothing else case Status
status of
          Running {Maybe UTCTime
UTCTime
Async Result
statusStartTime :: UTCTime
statusSetupFinishTime :: Maybe UTCTime
statusTeardownStartTime :: Maybe UTCTime
statusAsync :: Async Result
statusStartTime :: Status -> UTCTime
statusSetupFinishTime :: Status -> Maybe UTCTime
statusTeardownStartTime :: Status -> Maybe UTCTime
statusAsync :: Status -> Async Result
..} -> Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ AppState
-> UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> UTCTime
-> Bool
-> Widget n
forall n.
AppState
-> UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> UTCTime
-> Bool
-> Widget n
getRunTimes AppState
app UTCTime
statusStartTime Maybe UTCTime
statusSetupFinishTime Maybe UTCTime
statusTeardownStartTime (AppState
app AppState -> Getting UTCTime AppState UTCTime -> UTCTime
forall s a. s -> Getting a s a -> a
^. Getting UTCTime AppState UTCTime
Lens' AppState UTCTime
appCurrentTime) Bool
True
          Done {Maybe UTCTime
UTCTime
Result
statusStartTime :: Status -> UTCTime
statusSetupFinishTime :: Status -> Maybe UTCTime
statusTeardownStartTime :: Status -> Maybe UTCTime
statusStartTime :: UTCTime
statusSetupFinishTime :: Maybe UTCTime
statusTeardownStartTime :: Maybe UTCTime
statusEndTime :: UTCTime
statusResult :: Result
statusEndTime :: Status -> UTCTime
statusResult :: Status -> Result
..} -> Widget n -> Maybe (Widget n)
forall a. a -> Maybe a
Just (Widget n -> Maybe (Widget n)) -> Widget n -> Maybe (Widget n)
forall a b. (a -> b) -> a -> b
$ AppState
-> UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> UTCTime
-> Bool
-> Widget n
forall n.
AppState
-> UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> UTCTime
-> Bool
-> Widget n
getRunTimes AppState
app UTCTime
statusStartTime Maybe UTCTime
statusSetupFinishTime Maybe UTCTime
statusTeardownStartTime UTCTime
statusEndTime Bool
False
          Status
_ -> Maybe (Widget n)
forall a. Maybe a
Nothing
      ]

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

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

    logEntryWidget :: LogEntry -> Widget n
logEntryWidget (LogEntry {Text
UTCTime
LogStr
Loc
LogLevel
logEntryLevel :: LogEntry -> LogLevel
logEntryTime :: UTCTime
logEntryLoc :: Loc
logEntrySource :: Text
logEntryLevel :: LogLevel
logEntryStr :: LogStr
logEntryTime :: LogEntry -> UTCTime
logEntryLoc :: LogEntry -> Loc
logEntrySource :: LogEntry -> Text
logEntryStr :: LogEntry -> LogStr
..}) = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [
      AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
logTimestampAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str (UTCTime -> String
forall a. Show a => a -> String
show UTCTime
logEntryTime)
      , String -> Widget n
forall n. String -> Widget n
str String
" "
      , LogLevel -> Widget n
forall {n}. LogLevel -> Widget n
logLevelWidget LogLevel
logEntryLevel
      , String -> Widget n
forall n. String -> Widget n
str String
" "
      , Loc -> Widget n
forall {n}. Loc -> Widget n
logLocWidget Loc
logEntryLoc
      , String -> Widget n
forall n. String -> Widget n
str String
" "
      , Text -> Widget n
forall n. Text -> Widget n
txtWrap (ByteString -> Text
E.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
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_filename :: String
loc_package :: String
loc_module :: String
loc_end :: CharPos
loc_filename :: Loc -> String
loc_package :: Loc -> String
loc_module :: Loc -> String
loc_end :: Loc -> CharPos
..}) = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [
      String -> Widget n
forall n. String -> Widget n
str String
"["
      , AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
logFilenameAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str String
loc_filename
      , String -> Widget n
forall n. String -> Widget n
str String
":"
      , AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
logLineAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str (Int -> String
forall a. Show a => a -> String
show Int
line)
      , String -> Widget n
forall n. String -> Widget n
str String
":"
      , AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
logChAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ String -> Widget n
forall n. String -> Widget n
str (Int -> String
forall a. Show a => a -> String
show Int
ch)
      , String -> Widget n
forall n. String -> Widget n
str String
"]"
      ]

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


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

    totalNumTests :: Int
totalNumTests = (forall ctx.
 RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool)
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> Int
forall s l t context.
(forall ctx. RunNodeWithStatus ctx s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool
forall ctx.
RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool
forall {context} {s} {l} {t}.
RunNodeWithStatus context s l t -> Bool
isItBlock (AppState
app AppState
-> Getting
     [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
     AppState
     [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
forall s a. s -> Getting a s a -> a
^. Getting
  [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
  AppState
  [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
Lens'
  AppState [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
appRunTree)
    totalSucceededTests :: Int
totalSucceededTests = (forall ctx.
 RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool)
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> Int
forall s l t context.
(forall ctx. RunNodeWithStatus ctx s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool
forall ctx.
RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool
forall {context} {l} {t}.
RunNodeWithStatus context Status l t -> Bool
isSuccessItBlock (AppState
app AppState
-> Getting
     [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
     AppState
     [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
forall s a. s -> Getting a s a -> a
^. Getting
  [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
  AppState
  [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
Lens'
  AppState [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
appRunTree)
    totalPendingTests :: Int
totalPendingTests = (forall ctx.
 RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool)
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> Int
forall s l t context.
(forall ctx. RunNodeWithStatus ctx s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool
forall ctx.
RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool
forall {context} {l} {t}.
RunNodeWithStatus context Status l t -> Bool
isPendingItBlock (AppState
app AppState
-> Getting
     [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
     AppState
     [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
forall s a. s -> Getting a s a -> a
^. Getting
  [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
  AppState
  [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
Lens'
  AppState [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
appRunTree)
    totalFailedTests :: Int
totalFailedTests = (forall ctx.
 RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool)
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> Int
forall s l t context.
(forall ctx. RunNodeWithStatus ctx s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool
forall ctx.
RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool
forall {context} {l} {t}.
RunNodeWithStatus context Status l t -> Bool
isFailedItBlock (AppState
app AppState
-> Getting
     [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
     AppState
     [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
forall s a. s -> Getting a s a -> a
^. Getting
  [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
  AppState
  [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
Lens'
  AppState [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
appRunTree)
    totalRunningTests :: Int
totalRunningTests = (forall ctx.
 RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool)
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> Int
forall s l t context.
(forall ctx. RunNodeWithStatus ctx s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool
forall ctx.
RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool
forall {context} {l} {t}.
RunNodeWithStatus context Status l t -> Bool
isRunningItBlock (AppState
app AppState
-> Getting
     [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
     AppState
     [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
forall s a. s -> Getting a s a -> a
^. Getting
  [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
  AppState
  [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
Lens'
  AppState [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
appRunTree)
    totalNotStartedTests :: Int
totalNotStartedTests = (forall ctx.
 RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool)
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> Int
forall s l t context.
(forall ctx. RunNodeWithStatus ctx s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool
forall ctx.
RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool
forall {context} {l} {t}.
RunNodeWithStatus context Status l t -> Bool
isNotStartedItBlock (AppState
app AppState
-> Getting
     [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
     AppState
     [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
forall s a. s -> Getting a s a -> a
^. Getting
  [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
  AppState
  [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
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 [CustomTUIException] -> Maybe CustomTUIException
forall a. [a] -> Maybe a
headMay ([CustomTUIException] -> Maybe CustomTUIException)
-> [CustomTUIException] -> Maybe CustomTUIException
forall a b. (a -> b) -> a -> b
$ [Maybe CustomTUIException] -> [CustomTUIException]
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
_ = Maybe CallStack
forall a. Maybe a
Nothing