{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# 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 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 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.RunTree
import Test.Sandwich.Types.RunTree


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. 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
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
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
..}) = ClickableName -> Widget ClickableName -> Widget ClickableName
forall 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 (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Widget Any]
forall n. [Widget n]
infoWidgets)
          Widget ClickableName -> Maybe (Widget ClickableName)
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
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
..}) = [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 {UTCTime
Async Result
statusAsync :: Status -> Async Result
statusStartTime :: Status -> UTCTime
statusAsync :: Async Result
statusStartTime :: UTCTime
..} -> 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
$ String -> Widget n
forall n. String -> Widget n
str (String -> Widget n) -> String -> Widget n
forall a b. (a -> b) -> a -> b
$ UTCTime -> String
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
..} -> 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
$ Image -> Widget n
forall n. Image -> Widget n
raw (Image -> Widget n) -> Image -> Widget n
forall a b. (a -> b) -> a -> b
$ Attr -> String -> Image
V.string Attr
attr (String -> Image) -> String -> Image
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> String
formatNominalDiffTime (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
statusEndTime UTCTime
statusStartTime)
            where totalElapsed :: Double
totalElapsed = NominalDiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Ord a => a -> a -> a
max (AppState
app AppState
-> Getting NominalDiffTime AppState NominalDiffTime
-> NominalDiffTime
forall s a. s -> Getting a s a -> a
^. Getting NominalDiffTime AppState NominalDiffTime
Lens' AppState NominalDiffTime
appTimeSinceStart) (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
statusEndTime (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)))
                  duration :: Double
duration = NominalDiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
statusEndTime UTCTime
statusStartTime)
                  Double
intensity :: Double = Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase (Double
totalElapsed Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1) (Double
duration Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1)
                  Int
minGray :: Int = Int
50
                  Int
maxGray :: Int = Int
255
                  Int
level :: Int = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
maxGray (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
minGray (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minGray Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
intensity Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
maxGray Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
minGray))))
                  attr :: Attr
attr = Attr :: MaybeDefault Style
-> MaybeDefault Color
-> MaybeDefault Color
-> MaybeDefault Text
-> Attr
V.Attr {
                    attrStyle :: MaybeDefault Style
V.attrStyle = MaybeDefault Style
forall v. MaybeDefault v
V.Default
                    , attrForeColor :: MaybeDefault Color
V.attrForeColor = Color -> MaybeDefault Color
forall v. v -> MaybeDefault v
V.SetTo (Int -> Color
forall i. Integral i => i -> Color
grayAt Int
level)
                    , attrBackColor :: MaybeDefault Color
V.attrBackColor = MaybeDefault Color
forall v. MaybeDefault v
V.Default
                    , attrURL :: MaybeDefault Text
V.attrURL = MaybeDefault Text
forall v. MaybeDefault v
V.Default
                    }
          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
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
..}) = [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
$ Status -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget Status
status, 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
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 <- Status -> Maybe CallStack
getCallStackFromStatus Status
status
      Widget n -> Maybe (Widget n)
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
$ CallStack -> Widget n
forall a n. ToBrickWidget a => a -> Widget n
toBrickWidget CallStack
cs

    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 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 (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 (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 (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
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
..}) = [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_end :: Loc -> CharPos
loc_module :: Loc -> String
loc_package :: Loc -> String
loc_filename :: Loc -> String
loc_end :: CharPos
loc_module :: String
loc_package :: String
loc_filename :: String
..}) = [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 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 (AppState
app AppState
-> Getting NominalDiffTime AppState NominalDiffTime
-> NominalDiffTime
forall s a. s -> Getting a s a -> a
^. Getting NominalDiffTime AppState NominalDiffTime
Lens' AppState NominalDiffTime
appTimeSinceStart)])
  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 context1.
 RunNodeWithStatus context1 Status (Seq LogEntry) Bool -> Bool)
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> Int
forall s l t context.
(forall context1. RunNodeWithStatus context1 s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere forall context1.
RunNodeWithStatus context1 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 context1.
 RunNodeWithStatus context1 Status (Seq LogEntry) Bool -> Bool)
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> Int
forall s l t context.
(forall context1. RunNodeWithStatus context1 s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere forall context1.
RunNodeWithStatus context1 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 context1.
 RunNodeWithStatus context1 Status (Seq LogEntry) Bool -> Bool)
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> Int
forall s l t context.
(forall context1. RunNodeWithStatus context1 s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere forall context1.
RunNodeWithStatus context1 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 context1.
 RunNodeWithStatus context1 Status (Seq LogEntry) Bool -> Bool)
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> Int
forall s l t context.
(forall context1. RunNodeWithStatus context1 s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere forall context1.
RunNodeWithStatus context1 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 context1.
 RunNodeWithStatus context1 Status (Seq LogEntry) Bool -> Bool)
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> Int
forall s l t context.
(forall context1. RunNodeWithStatus context1 s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere forall context1.
RunNodeWithStatus context1 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 context1.
 RunNodeWithStatus context1 Status (Seq LogEntry) Bool -> Bool)
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> Int
forall s l t context.
(forall context1. RunNodeWithStatus context1 s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere forall context1.
RunNodeWithStatus context1 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)