{-# 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)