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

module Test.Sandwich.Formatters.TerminalUI (
  -- | The terminal UI formatter produces an interactive UI for running tests and inspecting their results.
  defaultTerminalUIFormatter

  -- * Options
  , terminalUIVisibilityThreshold
  , terminalUIShowRunTimes
  , terminalUIShowVisibilityThresholds
  , terminalUILogLevel
  , terminalUIInitialFolding
  , terminalUIDefaultEditor
  , terminalUIOpenInEditor
  , terminalUICustomExceptionFormatters

  -- * Auxiliary types
  , InitialFolding(..)
  , CustomTUIException(..)

  -- * Util
  , isTuiFormatterSupported
  ) where

import Brick as B
import Brick.BChan
import Brick.Widgets.List
import Control.Concurrent
import Control.Concurrent.Async
import Control.Concurrent.STM
import Control.Exception.Safe
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.IO.Unlift
import Control.Monad.Logger hiding (logError)
import Data.Either
import Data.Foldable
import qualified Data.List as L
import Data.Maybe
import qualified Data.Sequence as Seq
import qualified Data.Set as S
import Data.String.Interpolate
import Data.Time
import qualified Data.Vector as Vec
import GHC.Stack
import qualified Graphics.Vty as V
import Lens.Micro
import Safe
import System.FilePath
import Test.Sandwich.Formatters.TerminalUI.AttrMap
import Test.Sandwich.Formatters.TerminalUI.CrossPlatform
import Test.Sandwich.Formatters.TerminalUI.Draw
import Test.Sandwich.Formatters.TerminalUI.Filter
import Test.Sandwich.Formatters.TerminalUI.Keys
import Test.Sandwich.Formatters.TerminalUI.Types
import Test.Sandwich.Interpreters.RunTree.Util
import Test.Sandwich.Interpreters.StartTree
import Test.Sandwich.Logging
import Test.Sandwich.RunTree
import Test.Sandwich.Shutdown
import Test.Sandwich.Types.ArgParsing
import Test.Sandwich.Types.RunTree
import Test.Sandwich.Types.Spec
import Test.Sandwich.Util


instance Formatter TerminalUIFormatter where
  formatterName :: TerminalUIFormatter -> String
formatterName TerminalUIFormatter
_ = String
"terminal-ui-formatter"
  runFormatter :: forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m, MonadCatch m) =>
TerminalUIFormatter
-> [RunNode BaseContext]
-> Maybe (CommandLineOptions ())
-> BaseContext
-> m ()
runFormatter = forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
TerminalUIFormatter
-> [RunNode BaseContext]
-> Maybe (CommandLineOptions ())
-> BaseContext
-> m ()
runApp
  finalizeFormatter :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadCatch m) =>
TerminalUIFormatter -> [RunNode BaseContext] -> BaseContext -> m ()
finalizeFormatter TerminalUIFormatter
_ [RunNode BaseContext]
_ BaseContext
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

isTuiFormatterSupported :: IO Bool
isTuiFormatterSupported :: IO Bool
isTuiFormatterSupported = forall a b. Either a b -> Bool
isRight forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAny (Config -> IO Vty
V.mkVty Config
V.defaultConfig)

runApp :: (MonadLoggerIO m, MonadUnliftIO m) => TerminalUIFormatter -> [RunNode BaseContext] -> Maybe (CommandLineOptions ()) -> BaseContext -> m ()
runApp :: forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m) =>
TerminalUIFormatter
-> [RunNode BaseContext]
-> Maybe (CommandLineOptions ())
-> BaseContext
-> m ()
runApp (TerminalUIFormatter {Bool
Int
CustomExceptionFormatters
Maybe String
Maybe LogLevel
InitialFolding
Maybe String -> (Text -> IO ()) -> SrcLoc -> IO ()
terminalUIRefreshPeriod :: TerminalUIFormatter -> Int
terminalUIShowFileLocations :: TerminalUIFormatter -> Bool
terminalUICustomExceptionFormatters :: CustomExceptionFormatters
terminalUIOpenInEditor :: Maybe String -> (Text -> IO ()) -> SrcLoc -> IO ()
terminalUIDefaultEditor :: Maybe String
terminalUIRefreshPeriod :: Int
terminalUILogLevel :: Maybe LogLevel
terminalUIShowVisibilityThresholds :: Bool
terminalUIShowFileLocations :: Bool
terminalUIShowRunTimes :: Bool
terminalUIInitialFolding :: InitialFolding
terminalUIVisibilityThreshold :: Int
terminalUICustomExceptionFormatters :: TerminalUIFormatter -> CustomExceptionFormatters
terminalUIOpenInEditor :: TerminalUIFormatter
-> Maybe String -> (Text -> IO ()) -> SrcLoc -> IO ()
terminalUIDefaultEditor :: TerminalUIFormatter -> Maybe String
terminalUIInitialFolding :: TerminalUIFormatter -> InitialFolding
terminalUILogLevel :: TerminalUIFormatter -> Maybe LogLevel
terminalUIShowVisibilityThresholds :: TerminalUIFormatter -> Bool
terminalUIShowRunTimes :: TerminalUIFormatter -> Bool
terminalUIVisibilityThreshold :: TerminalUIFormatter -> Int
..}) [RunNode BaseContext]
rts Maybe (CommandLineOptions ())
_maybeCommandLineOptions BaseContext
baseContext = do
  UTCTime
startTime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime

  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ InitialFolding -> [RunNode BaseContext] -> IO ()
setInitialFolding InitialFolding
terminalUIInitialFolding [RunNode BaseContext]
rts

  [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
rtsFixed <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall context. RunNode context -> STM (RunNodeFixed context)
fixRunTree [RunNode BaseContext]
rts

  let initialState :: AppState
initialState = AppState -> AppState
updateFilteredTree forall a b. (a -> b) -> a -> b
$
        AppState {
          _appRunTreeBase :: [RunNode BaseContext]
_appRunTreeBase = [RunNode BaseContext]
rts
          , _appRunTree :: [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
_appRunTree = [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
rtsFixed
          , _appMainList :: GenericList ClickableName Vector MainListElem
_appMainList = forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list ClickableName
MainList forall a. Monoid a => a
mempty Int
1
          , _appBaseContext :: BaseContext
_appBaseContext = BaseContext
baseContext

          , _appStartTime :: UTCTime
_appStartTime = UTCTime
startTime
          , _appTimeSinceStart :: NominalDiffTime
_appTimeSinceStart = NominalDiffTime
0

          , _appVisibilityThresholdSteps :: [Int]
_appVisibilityThresholdSteps = forall a. Ord a => [a] -> [a]
L.sort forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
L.nub forall a b. (a -> b) -> a -> b
$ Int
terminalUIVisibilityThreshold forall a. a -> [a] -> [a]
: (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeVisibilityLevel forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall context s l t.
RunNodeWithStatus context s l t -> [RunNodeCommonWithStatus s l t]
getCommons [RunNode BaseContext]
rts)
          , _appVisibilityThreshold :: Int
_appVisibilityThreshold = Int
terminalUIVisibilityThreshold

          , _appLogLevel :: Maybe LogLevel
_appLogLevel = Maybe LogLevel
terminalUILogLevel
          , _appShowRunTimes :: Bool
_appShowRunTimes = Bool
terminalUIShowRunTimes
          , _appShowFileLocations :: Bool
_appShowFileLocations = Bool
terminalUIShowFileLocations
          , _appShowVisibilityThresholds :: Bool
_appShowVisibilityThresholds = Bool
terminalUIShowVisibilityThresholds

          , _appOpenInEditor :: SrcLoc -> IO ()
_appOpenInEditor = Maybe String -> (Text -> IO ()) -> SrcLoc -> IO ()
terminalUIOpenInEditor Maybe String
terminalUIDefaultEditor (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ())
          , _appDebug :: Text -> IO ()
_appDebug = (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ())
          , _appCustomExceptionFormatters :: CustomExceptionFormatters
_appCustomExceptionFormatters = CustomExceptionFormatters
terminalUICustomExceptionFormatters
        }

  BChan AppEvent
eventChan <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Int -> IO (BChan a)
newBChan Int
10

  Loc -> Text -> LogLevel -> LogStr -> IO ()
logFn <- forall (m :: * -> *).
MonadLoggerIO m =>
m (Loc -> Text -> LogLevel -> LogStr -> IO ())
askLoggerIO

  TVar [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
currentFixedTree <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (TVar a)
newTVarIO [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
rtsFixed
  Async Any
eventAsync <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO (Async a)
async forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
      forall (m :: * -> *) a.
MonadCatch m =>
(SomeException -> m a) -> m a -> m a
handleAny (\SomeException
e -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT Loc -> Text -> LogLevel -> LogStr -> IO ()
logFn (forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logError [i|Got exception in event async: #{e}|]) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO ()
threadDelay Int
terminalUIRefreshPeriod) forall a b. (a -> b) -> a -> b
$ do
        [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
newFixedTree <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
          [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
currentFixed <- forall a. TVar a -> STM a
readTVar TVar [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
currentFixedTree
          [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
newFixed <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall context. RunNode context -> STM (RunNodeFixed context)
fixRunTree [RunNode BaseContext]
rts
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall context s l t.
RunNodeWithStatus context s l t -> [RunNodeCommonWithStatus s l t]
getCommons [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
newFixed forall a. Eq a => a -> a -> Bool
== forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall context s l t.
RunNodeWithStatus context s l t -> [RunNodeCommonWithStatus s l t]
getCommons [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
currentFixed) forall a. STM a
retry
          forall a. TVar a -> a -> STM ()
writeTVar TVar [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
currentFixedTree [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
newFixed
          forall (m :: * -> *) a. Monad m => a -> m a
return [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
newFixed
        forall a. BChan a -> a -> IO ()
writeBChan BChan AppEvent
eventChan ([RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> AppEvent
RunTreeUpdated [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
newFixedTree)
        Int -> IO ()
threadDelay Int
terminalUIRefreshPeriod

  let buildVty :: IO Vty
buildVty = do
        Vty
v <- Config -> IO Vty
V.mkVty Config
V.defaultConfig
        let output :: Output
output = Vty -> Output
V.outputIface Vty
v
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Output -> Mode -> Bool
V.supportsMode Output
output Mode
V.Mouse) forall a b. (a -> b) -> a -> b
$
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Output -> Mode -> Bool -> IO ()
V.setMode Output
output Mode
V.Mouse Bool
True
        forall (m :: * -> *) a. Monad m => a -> m a
return Vty
v
  Vty
initialVty <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Vty
buildVty
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
onException (forall a. Async a -> IO ()
cancel Async Any
eventAsync) forall a b. (a -> b) -> a -> b
$
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall n e s.
Ord n =>
Vty -> IO Vty -> Maybe (BChan e) -> App s e n -> s -> IO s
customMain Vty
initialVty IO Vty
buildVty (forall a. a -> Maybe a
Just BChan AppEvent
eventChan) App AppState AppEvent ClickableName
app AppState
initialState

app :: App AppState AppEvent ClickableName
app :: App AppState AppEvent ClickableName
app = App {
  appDraw :: AppState -> [Widget ClickableName]
appDraw = AppState -> [Widget ClickableName]
drawUI
  , appChooseCursor :: AppState
-> [CursorLocation ClickableName]
-> Maybe (CursorLocation ClickableName)
appChooseCursor = forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
showFirstCursor
#if MIN_VERSION_brick(1,0,0)
  , appHandleEvent :: BrickEvent ClickableName AppEvent
-> EventM ClickableName AppState ()
appHandleEvent = \BrickEvent ClickableName AppEvent
event -> forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \AppState
s -> AppState
-> BrickEvent ClickableName AppEvent
-> EventM ClickableName AppState ()
appEvent AppState
s BrickEvent ClickableName AppEvent
event
  , appStartEvent :: EventM ClickableName AppState ()
appStartEvent = forall (m :: * -> *) a. Monad m => a -> m a
return ()
#else
  , appHandleEvent = appEvent
  , appStartEvent = return
#endif
  , appAttrMap :: AppState -> AttrMap
appAttrMap = forall a b. a -> b -> a
const AttrMap
mainAttrMap
  }

#if MIN_VERSION_brick(1,0,0)
continue :: AppState -> EventM ClickableName AppState ()
continue :: AppState -> EventM ClickableName AppState ()
continue = forall s (m :: * -> *). MonadState s m => s -> m ()
put

continueNoChange :: AppState -> EventM ClickableName AppState ()
continueNoChange :: AppState -> EventM ClickableName AppState ()
continueNoChange AppState
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()

doHalt :: p -> EventM n s ()
doHalt p
_ = forall n s. EventM n s ()
halt
#else
continueNoChange :: AppState -> EventM ClickableName (Next AppState)
continueNoChange = continue

doHalt = halt
#endif

#if MIN_VERSION_brick(1,0,0)
appEvent :: AppState -> BrickEvent ClickableName AppEvent -> EventM ClickableName AppState ()
#else
appEvent :: AppState -> BrickEvent ClickableName AppEvent -> EventM ClickableName (Next AppState)
#endif
appEvent :: AppState
-> BrickEvent ClickableName AppEvent
-> EventM ClickableName AppState ()
appEvent AppState
s (AppEvent (RunTreeUpdated [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
newTree)) = do
  UTCTime
now <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  AppState -> EventM ClickableName AppState ()
continue forall a b. (a -> b) -> a -> b
$ AppState
s
    forall a b. a -> (a -> b) -> b
& Lens'
  AppState [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
appRunTree forall s t a b. ASetter s t a b -> b -> s -> t
.~ [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
newTree
    forall a b. a -> (a -> b) -> b
& Lens' AppState NominalDiffTime
appTimeSinceStart forall s t a b. ASetter s t a b -> b -> s -> t
.~ (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
now (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState UTCTime
appStartTime))
    forall a b. a -> (a -> b) -> b
& AppState -> AppState
updateFilteredTree

appEvent AppState
s (MouseDown ClickableName
ColorBar Button
_ [Modifier]
_ (B.Location (Int
x, Int
_))) = do
  forall n s. Eq n => n -> EventM n s (Maybe (Extent n))
lookupExtent ClickableName
ColorBar forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Extent ClickableName)
Nothing -> AppState -> EventM ClickableName AppState ()
continue AppState
s
    Just (Extent {extentSize :: forall n. Extent n -> (Int, Int)
extentSize=(Int
w, Int
_), extentUpperLeft :: forall n. Extent n -> Location
extentUpperLeft=(B.Location (Int
l, Int
_))}) -> do
      let Double
percent :: Double = (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x forall a. Num a => a -> a -> a
- Int
l)) forall a. Fractional a => a -> a -> a
/ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w)
      let allCommons :: [RunNodeCommonWithStatus Status (Seq LogEntry) Bool]
allCommons = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall context s l t.
RunNodeWithStatus context s l t -> [RunNodeCommonWithStatus s l t]
getCommons forall a b. (a -> b) -> a -> b
$ AppState
s forall s a. s -> Getting a s a -> a
^. Lens'
  AppState [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
appRunTree
      let index :: Int
index = forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min (forall (t :: * -> *) a. Foldable t => t a -> Int
length [RunNodeCommonWithStatus Status (Seq LogEntry) Bool]
allCommons forall a. Num a => a -> a -> a
- Int
1) forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ Double
percent forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (forall (t :: * -> *) a. Foldable t => t a -> Int
length [RunNodeCommonWithStatus Status (Seq LogEntry) Bool]
allCommons forall a. Num a => a -> a -> a
- Int
1))
      -- A subsequent RunTreeUpdated will pick up the new open nodes
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall context. [RunNode context] -> Seq Int -> IO ()
openIndices (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState [RunNode BaseContext]
appRunTreeBase) (forall s l t. RunNodeCommonWithStatus s l t -> Seq Int
runTreeAncestors forall a b. (a -> b) -> a -> b
$ [RunNodeCommonWithStatus Status (Seq LogEntry) Bool]
allCommons forall a. [a] -> Int -> a
!! Int
index)
      AppState -> EventM ClickableName AppState ()
continue forall a b. (a -> b) -> a -> b
$ AppState
s
        forall a b. a -> (a -> b) -> b
& Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo Int
index)
        forall a b. a -> (a -> b) -> b
& AppState -> AppState
updateFilteredTree

appEvent AppState
s (MouseDown (ListRow Int
_i) Button
V.BScrollUp [Modifier]
_ Location
_) = do
  forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (forall n. n -> ViewportScroll n
viewportScroll ClickableName
MainList) (-Int
1)
  AppState -> EventM ClickableName AppState ()
continueNoChange AppState
s
appEvent AppState
s (MouseDown (ListRow Int
_i) Button
V.BScrollDown [Modifier]
_ Location
_) = do
  forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (forall n. n -> ViewportScroll n
viewportScroll ClickableName
MainList) Int
1
  AppState -> EventM ClickableName AppState ()
continueNoChange AppState
s
appEvent AppState
s (MouseDown (ListRow Int
i) Button
V.BLeft [Modifier]
_ Location
_) = do
  AppState -> EventM ClickableName AppState ()
continue (AppState
s forall a b. a -> (a -> b) -> b
& Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo Int
i))
appEvent AppState
s (VtyEvent Event
e) =
  case Event
e of
    -- Column 1
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
nextKey -> AppState -> EventM ClickableName AppState ()
continue (AppState
s forall a b. a -> (a -> b) -> b
& Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveBy Int
1))
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
previousKey -> AppState -> EventM ClickableName AppState ()
continue (AppState
s forall a b. a -> (a -> b) -> b
& Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveBy (-Int
1)))
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
nextFailureKey -> do
      let ls :: [MainListElem]
ls = forall a. Vector a -> [a]
Vec.toList forall a b. (a -> b) -> a -> b
$ forall n (t :: * -> *) e. GenericList n t e -> t e
listElements (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList)
      let listToSearch :: [(Int, MainListElem)]
listToSearch = case forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList) of
            Just (Int
i, MainListElem {}) -> let ([(Int, MainListElem)]
front, [(Int, MainListElem)]
back) = forall a. Int -> [a] -> ([a], [a])
L.splitAt (Int
i forall a. Num a => a -> a -> a
+ Int
1) (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [MainListElem]
ls) in [(Int, MainListElem)]
back forall a. Semigroup a => a -> a -> a
<> [(Int, MainListElem)]
front
            Maybe (Int, MainListElem)
Nothing -> forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [MainListElem]
ls
      case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (Status -> Bool
isFailureStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. MainListElem -> Status
status forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Int, MainListElem)]
listToSearch of
        Maybe (Int, MainListElem)
Nothing -> AppState -> EventM ClickableName AppState ()
continue AppState
s
        Just (Int
i', MainListElem
_) -> AppState -> EventM ClickableName AppState ()
continue (AppState
s forall a b. a -> (a -> b) -> b
& Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo Int
i'))
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
previousFailureKey -> do
      let ls :: [MainListElem]
ls = forall a. Vector a -> [a]
Vec.toList forall a b. (a -> b) -> a -> b
$ forall n (t :: * -> *) e. GenericList n t e -> t e
listElements (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList)
      let listToSearch :: [(Int, MainListElem)]
listToSearch = case forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList) of
            Just (Int
i, MainListElem {}) -> let ([(Int, MainListElem)]
front, [(Int, MainListElem)]
back) = forall a. Int -> [a] -> ([a], [a])
L.splitAt Int
i (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [MainListElem]
ls) in (forall a. [a] -> [a]
L.reverse [(Int, MainListElem)]
front) forall a. Semigroup a => a -> a -> a
<> (forall a. [a] -> [a]
L.reverse [(Int, MainListElem)]
back)
            Maybe (Int, MainListElem)
Nothing -> forall a. [a] -> [a]
L.reverse (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [MainListElem]
ls)
      case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (Status -> Bool
isFailureStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. MainListElem -> Status
status forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Int, MainListElem)]
listToSearch of
        Maybe (Int, MainListElem)
Nothing -> AppState -> EventM ClickableName AppState ()
continue AppState
s
        Just (Int
i', MainListElem
_) -> AppState -> EventM ClickableName AppState ()
continue (AppState
s forall a b. a -> (a -> b) -> b
& Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo Int
i'))
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
closeNodeKey -> AppState -> (Bool -> Bool) -> EventM ClickableName AppState ()
modifyOpen AppState
s (forall a b. a -> b -> a
const Bool
False)
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
openNodeKey -> AppState -> (Bool -> Bool) -> EventM ClickableName AppState ()
modifyOpen AppState
s (forall a b. a -> b -> a
const Bool
True)
    V.EvKey c :: Key
c@(V.KChar Char
ch) [Modifier
V.MMeta] | Key
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Key
V.KChar [Char
'0'..Char
'9']) -> do
      let Int
num :: Int = forall a. Read a => String -> a
read [Char
ch]
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t MainListElem -> Int -> IO ()
openToDepth (AppState
s forall s a. s -> Getting a s a -> a
^. (Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n (t1 :: * -> *) e1 (t2 :: * -> *) e2.
Lens (GenericList n t1 e1) (GenericList n t2 e2) (t1 e1) (t2 e2)
listElementsL)) Int
num
      AppState -> EventM ClickableName AppState ()
continue AppState
s
    V.EvKey Key
c [] | Key
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key]
toggleKeys -> AppState -> (Bool -> Bool) -> EventM ClickableName AppState ()
modifyToggled AppState
s Bool -> Bool
not

    -- Scrolling in toggled items
    -- Wanted to make these uniformly Ctrl+whatever, but Ctrl+PageUp/PageDown was causing it to get KEsc and exit (?)
    V.EvKey Key
V.KUp [Modifier
V.MCtrl] -> forall n.
AppState
-> (forall s. ViewportScroll ClickableName -> EventM n s ())
-> EventM n AppState ()
withScroll AppState
s forall a b. (a -> b) -> a -> b
$ \ViewportScroll ClickableName
vp -> forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll ClickableName
vp (-Int
1)
    V.EvKey (V.KChar Char
'p') [Modifier
V.MCtrl] -> forall n.
AppState
-> (forall s. ViewportScroll ClickableName -> EventM n s ())
-> EventM n AppState ()
withScroll AppState
s forall a b. (a -> b) -> a -> b
$ \ViewportScroll ClickableName
vp -> forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll ClickableName
vp (-Int
1)
    V.EvKey Key
V.KDown [Modifier
V.MCtrl] -> forall n.
AppState
-> (forall s. ViewportScroll ClickableName -> EventM n s ())
-> EventM n AppState ()
withScroll AppState
s forall a b. (a -> b) -> a -> b
$ \ViewportScroll ClickableName
vp -> forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll ClickableName
vp Int
1
    V.EvKey (V.KChar Char
'n') [Modifier
V.MCtrl] -> forall n.
AppState
-> (forall s. ViewportScroll ClickableName -> EventM n s ())
-> EventM n AppState ()
withScroll AppState
s forall a b. (a -> b) -> a -> b
$ \ViewportScroll ClickableName
vp -> forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll ClickableName
vp Int
1
    V.EvKey (V.KChar Char
'v') [Modifier
V.MMeta] -> forall n.
AppState
-> (forall s. ViewportScroll ClickableName -> EventM n s ())
-> EventM n AppState ()
withScroll AppState
s forall a b. (a -> b) -> a -> b
$ \ViewportScroll ClickableName
vp -> forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage ViewportScroll ClickableName
vp Direction
Up
    V.EvKey (V.KChar Char
'v') [Modifier
V.MCtrl] -> forall n.
AppState
-> (forall s. ViewportScroll ClickableName -> EventM n s ())
-> EventM n AppState ()
withScroll AppState
s forall a b. (a -> b) -> a -> b
$ \ViewportScroll ClickableName
vp -> forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage ViewportScroll ClickableName
vp Direction
Down
    V.EvKey Key
V.KHome [Modifier
V.MCtrl] -> forall n.
AppState
-> (forall s. ViewportScroll ClickableName -> EventM n s ())
-> EventM n AppState ()
withScroll AppState
s forall a b. (a -> b) -> a -> b
$ \ViewportScroll ClickableName
vp -> forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToBeginning ViewportScroll ClickableName
vp
    V.EvKey Key
V.KEnd [Modifier
V.MCtrl] -> forall n.
AppState
-> (forall s. ViewportScroll ClickableName -> EventM n s ())
-> EventM n AppState ()
withScroll AppState
s forall a b. (a -> b) -> a -> b
$ \ViewportScroll ClickableName
vp -> forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToEnd ViewportScroll ClickableName
vp

    -- Column 2
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
cancelAllKey -> do
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall context. RunNode context -> IO ()
cancelNode (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState [RunNode BaseContext]
appRunTreeBase)
      AppState -> EventM ClickableName AppState ()
continue AppState
s
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
cancelSelectedKey -> forall {a}.
AppState
-> EventM ClickableName AppState a
-> EventM ClickableName AppState ()
withContinueS AppState
s forall a b. (a -> b) -> a -> b
$ do
      forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust (forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList)) forall a b. (a -> b) -> a -> b
$ \(Int
_, 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
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
status :: MainListElem -> Status
..}) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
        (forall a. TVar a -> IO a
readTVarIO forall a b. (a -> b) -> a -> b
$ forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeStatus RunNodeCommon
node) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Running {UTCTime
Async Result
statusAsync :: Status -> Async Result
statusStartTime :: Status -> UTCTime
statusAsync :: Async Result
statusStartTime :: UTCTime
..} -> forall a. Async a -> IO ()
cancel Async Result
statusAsync
          Status
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
runAllKey -> forall {a}.
AppState
-> EventM ClickableName AppState a
-> EventM ClickableName AppState ()
withContinueS AppState
s forall a b. (a -> b) -> a -> b
$ do
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Bool
isRunning forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon) (AppState
s forall s a. s -> Getting a s a -> a
^. Lens'
  AppState [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
appRunTree)) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall context. RunNode context -> IO ()
clearRecursively (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState [RunNode BaseContext]
appRunTreeBase)
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO (Async a)
async forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall context.
HasBaseContext context =>
[RunNode context] -> context -> IO [Result]
runNodesSequentially (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState [RunNode BaseContext]
appRunTreeBase) (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState BaseContext
appBaseContext)
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
runSelectedKey -> forall {a}.
AppState
-> EventM ClickableName AppState a
-> EventM ClickableName AppState ()
withContinueS AppState
s forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust (forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList)) forall a b. (a -> b) -> a -> b
$ \(Int
_, 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
open :: MainListElem -> Bool
toggled :: MainListElem -> Bool
depth :: MainListElem -> Int
label :: MainListElem -> String
status :: MainListElem -> Status
..}) -> case Status
status of
        Running {} -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Status
_ -> do
          -- Get the set of IDs for only this node's ancestors and children
          let ancestorIds :: Set Int
ancestorIds = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall s l t. RunNodeCommonWithStatus s l t -> Seq Int
runTreeAncestors RunNodeCommon
node
          case forall context. Int -> [RunNodeFixed context] -> Maybe (Set Int)
findRunNodeChildrenById Int
ident (AppState
s forall s a. s -> Getting a s a -> a
^. Lens'
  AppState [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
appRunTree) of
            Maybe (Set Int)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just Set Int
childIds -> do
              let allIds :: Set Int
allIds = Set Int
ancestorIds forall a. Semigroup a => a -> a -> a
<> Set Int
childIds
              -- Clear the status of all affected nodes
              forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall context. (RunNodeCommon -> Bool) -> RunNode context -> IO ()
clearRecursivelyWhere (\RunNodeCommon
x -> forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeId RunNodeCommon
x forall a. Ord a => a -> Set a -> Bool
`S.member` Set Int
allIds)) (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState [RunNode BaseContext]
appRunTreeBase)
              -- Start a run for all affected nodes
              let bc :: BaseContext
bc = (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState BaseContext
appBaseContext) { baseContextOnlyRunIds :: Maybe (Set Int)
baseContextOnlyRunIds = forall a. a -> Maybe a
Just Set Int
allIds }
              forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO (Async a)
async forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall context.
HasBaseContext context =>
[RunNode context] -> context -> IO [Result]
runNodesSequentially (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState [RunNode BaseContext]
appRunTreeBase) BaseContext
bc
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
clearSelectedKey -> forall {a}.
AppState
-> EventM ClickableName AppState a
-> EventM ClickableName AppState ()
withContinueS AppState
s forall a b. (a -> b) -> a -> b
$ do
      forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust (forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList)) forall a b. (a -> b) -> a -> b
$ \(Int
_, 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
open :: MainListElem -> Bool
toggled :: MainListElem -> Bool
depth :: MainListElem -> Int
label :: MainListElem -> String
status :: MainListElem -> Status
..}) -> case Status
status of
        Running {} -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Status
_ -> case forall context. Int -> [RunNodeFixed context] -> Maybe (Set Int)
findRunNodeChildrenById Int
ident (AppState
s forall s a. s -> Getting a s a -> a
^. Lens'
  AppState [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
appRunTree) of
          Maybe (Set Int)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just Set Int
childIds -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall context. (RunNodeCommon -> Bool) -> RunNode context -> IO ()
clearRecursivelyWhere (\RunNodeCommon
x -> forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeId RunNodeCommon
x forall a. Ord a => a -> Set a -> Bool
`S.member` Set Int
childIds)) (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState [RunNode BaseContext]
appRunTreeBase)
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
clearAllKey -> forall {a}.
AppState
-> EventM ClickableName AppState a
-> EventM ClickableName AppState ()
withContinueS AppState
s forall a b. (a -> b) -> a -> b
$ do
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall context. RunNode context -> IO ()
clearRecursively (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState [RunNode BaseContext]
appRunTreeBase)
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
openSelectedFolderInFileExplorer -> forall {a}.
AppState
-> EventM ClickableName AppState a
-> EventM ClickableName AppState ()
withContinueS AppState
s forall a b. (a -> b) -> a -> b
$ do
      forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust (forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList)) forall a b. (a -> b) -> a -> b
$ \(Int
_i, MainListElem {Maybe String
folderPath :: Maybe String
folderPath :: MainListElem -> Maybe String
folderPath}) ->
        forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust Maybe String
folderPath forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
openFileExplorerFolderPortable
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
openTestRootKey -> forall {a}.
AppState
-> EventM ClickableName AppState a
-> EventM ClickableName AppState ()
withContinueS AppState
s forall a b. (a -> b) -> a -> b
$
      forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust (BaseContext -> Maybe String
baseContextRunRoot (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState BaseContext
appBaseContext)) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
openFileExplorerFolderPortable
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
openTestInEditorKey -> case forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList) of
      Just (Int
_i, MainListElem {node :: MainListElem -> RunNodeCommon
node=(forall s l t. RunNodeCommonWithStatus s l t -> Maybe SrcLoc
runTreeLoc -> Just SrcLoc
loc)}) -> forall {n}. Ord n => AppState -> SrcLoc -> EventM n AppState ()
openSrcLoc AppState
s SrcLoc
loc
      Maybe (Int, MainListElem)
_ -> AppState -> EventM ClickableName AppState ()
continue AppState
s
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
openLogsInEditorKey -> case forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList) of
      Just (Int
_i, MainListElem {node :: MainListElem -> RunNodeCommon
node=(forall s l t. RunNodeCommonWithStatus s l t -> Maybe String
runTreeFolder -> Just String
dir)}) -> do
        let srcLoc :: SrcLoc
srcLoc = SrcLoc {
          srcLocPackage :: String
srcLocPackage = String
""
          , srcLocModule :: String
srcLocModule = String
""
          , srcLocFile :: String
srcLocFile = String
dir String -> String -> String
</> String
"test_logs.txt"
          , srcLocStartLine :: Int
srcLocStartLine = Int
0
          , srcLocStartCol :: Int
srcLocStartCol = Int
0
          , srcLocEndLine :: Int
srcLocEndLine = Int
0
          , srcLocEndCol :: Int
srcLocEndCol = Int
0
          }
        forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume ((AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState (SrcLoc -> IO ())
appOpenInEditor) SrcLoc
srcLoc forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return AppState
s)
      Maybe (Int, MainListElem)
_ -> AppState -> EventM ClickableName AppState ()
continue AppState
s
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
openFailureInEditorKey -> do
      case (forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList)) of
        Maybe (Int, MainListElem)
Nothing -> AppState -> EventM ClickableName AppState ()
continue AppState
s
        Just (Int
_i, MainListElem {Status
status :: Status
status :: MainListElem -> Status
status}) -> case Status
status of
          Done UTCTime
_ UTCTime
_ (Failure (FailureReason -> Maybe CallStack
failureCallStack -> Just (CallStack -> [(String, SrcLoc)]
getCallStack -> ((String
_, SrcLoc
loc):[(String, SrcLoc)]
_)))) -> forall {n}. Ord n => AppState -> SrcLoc -> EventM n AppState ()
openSrcLoc AppState
s SrcLoc
loc
          Status
_ -> AppState -> EventM ClickableName AppState ()
continue AppState
s

    -- Column 3
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
cycleVisibilityThresholdKey -> do
      let newVisibilityThreshold :: Int
newVisibilityThreshold =  case [(Integer
i, Int
x) | (Integer
i, Int
x) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState [Int]
appVisibilityThresholdSteps)
                                                 , Int
x forall a. Ord a => a -> a -> Bool
> AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState Int
appVisibilityThreshold] of
            [] -> Int
0
            [(Integer, Int)]
xs -> forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd [(Integer, Int)]
xs
      AppState -> EventM ClickableName AppState ()
continue forall a b. (a -> b) -> a -> b
$ AppState
s
        forall a b. a -> (a -> b) -> b
& Lens' AppState Int
appVisibilityThreshold forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
newVisibilityThreshold
        forall a b. a -> (a -> b) -> b
& AppState -> AppState
updateFilteredTree
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
toggleShowRunTimesKey -> AppState -> EventM ClickableName AppState ()
continue forall a b. (a -> b) -> a -> b
$ AppState
s
      forall a b. a -> (a -> b) -> b
& Lens' AppState Bool
appShowRunTimes forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Bool -> Bool
not
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
toggleFileLocationsKey -> AppState -> EventM ClickableName AppState ()
continue forall a b. (a -> b) -> a -> b
$ AppState
s
      forall a b. a -> (a -> b) -> b
& Lens' AppState Bool
appShowFileLocations forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Bool -> Bool
not
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
toggleVisibilityThresholdsKey -> AppState -> EventM ClickableName AppState ()
continue forall a b. (a -> b) -> a -> b
$ AppState
s
      forall a b. a -> (a -> b) -> b
& Lens' AppState Bool
appShowVisibilityThresholds forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Bool -> Bool
not
    V.EvKey Key
c [] | Key
c forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key
V.KEsc, Key
exitKey]-> do
      -- Cancel everything and wait for cleanups
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall context. RunNode context -> IO ()
cancelNode (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState [RunNode BaseContext]
appRunTreeBase)
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState [RunNode BaseContext]
appRunTreeBase) (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall context. RunNode context -> IO Result
waitForTree)
      forall {p} {n} {s}. p -> EventM n s ()
doHalt AppState
s
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
debugKey -> AppState -> EventM ClickableName AppState ()
continue (AppState
s forall a b. a -> (a -> b) -> b
& Lens' AppState (Maybe LogLevel)
appLogLevel forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ LogLevel
LevelDebug)
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
infoKey -> AppState -> EventM ClickableName AppState ()
continue (AppState
s forall a b. a -> (a -> b) -> b
& Lens' AppState (Maybe LogLevel)
appLogLevel forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ LogLevel
LevelInfo)
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
warnKey -> AppState -> EventM ClickableName AppState ()
continue (AppState
s forall a b. a -> (a -> b) -> b
& Lens' AppState (Maybe LogLevel)
appLogLevel forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ LogLevel
LevelWarn)
    V.EvKey Key
c [] | Key
c forall a. Eq a => a -> a -> Bool
== Key
errorKey -> AppState -> EventM ClickableName AppState ()
continue (AppState
s forall a b. a -> (a -> b) -> b
& Lens' AppState (Maybe LogLevel)
appLogLevel forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ LogLevel
LevelError)

#if MIN_VERSION_brick(1,0,0)
    Event
ev -> forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
ev
#else
    ev -> handleEventLensed s appMainList handleListEvent ev >>= continue
#endif

  where withContinueS :: AppState
-> EventM ClickableName AppState a
-> EventM ClickableName AppState ()
withContinueS AppState
s EventM ClickableName AppState a
action = EventM ClickableName AppState a
action forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AppState -> EventM ClickableName AppState ()
continue AppState
s
#if MIN_VERSION_brick(1,0,0)
appEvent AppState
_ BrickEvent ClickableName AppEvent
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
#else
appEvent s _ = continue s
#endif

modifyToggled :: AppState -> (Bool -> Bool) -> EventM ClickableName AppState ()
modifyToggled AppState
s Bool -> Bool
f = case forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList) of
  Maybe (Int, MainListElem)
Nothing -> AppState -> EventM ClickableName AppState ()
continue AppState
s
  Just (Int
_i, 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
open :: MainListElem -> Bool
toggled :: MainListElem -> Bool
depth :: MainListElem -> Int
label :: MainListElem -> String
status :: MainListElem -> Status
..}) -> do
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeToggled RunNodeCommon
node) Bool -> Bool
f
    AppState -> EventM ClickableName AppState ()
continue AppState
s

modifyOpen :: AppState -> (Bool -> Bool) -> EventM ClickableName AppState ()
modifyOpen AppState
s Bool -> Bool
f = case forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList) of
  Maybe (Int, MainListElem)
Nothing -> AppState -> EventM ClickableName AppState ()
continue AppState
s
  Just (Int
_i, 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
open :: MainListElem -> Bool
toggled :: MainListElem -> Bool
depth :: MainListElem -> Int
label :: MainListElem -> String
status :: MainListElem -> Status
..}) -> do
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeOpen RunNodeCommon
node) Bool -> Bool
f
    AppState -> EventM ClickableName AppState ()
continue AppState
s

openIndices :: [RunNode context] -> Seq.Seq Int -> IO ()
openIndices :: forall context. [RunNode context] -> Seq Int -> IO ()
openIndices [RunNode context]
nodes Seq Int
openSet =
  forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall context s l t.
RunNodeWithStatus context s l t -> [RunNodeCommonWithStatus s l t]
getCommons [RunNode context]
nodes) forall a b. (a -> b) -> a -> b
$ \RunNodeCommon
node ->
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeId RunNodeCommon
node) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Int
openSet)) forall a b. (a -> b) -> a -> b
$
      forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeOpen RunNodeCommon
node) (forall a b. a -> b -> a
const Bool
True)

openToDepth :: (Foldable t) => t MainListElem -> Int -> IO ()
openToDepth :: forall (t :: * -> *). Foldable t => t MainListElem -> Int -> IO ()
openToDepth t MainListElem
elems Int
thresh =
  forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t MainListElem
elems forall a b. (a -> b) -> a -> b
$ \(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
open :: MainListElem -> Bool
toggled :: MainListElem -> Bool
depth :: MainListElem -> Int
label :: MainListElem -> String
status :: MainListElem -> Status
..}) ->
    if | (Int
depth forall a. Ord a => a -> a -> Bool
< Int
thresh) -> forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeOpen RunNodeCommon
node) (forall a b. a -> b -> a
const Bool
True)
       | Bool
otherwise -> forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeOpen RunNodeCommon
node) (forall a b. a -> b -> a
const Bool
False)

setInitialFolding :: InitialFolding -> [RunNode BaseContext] -> IO ()
setInitialFolding :: InitialFolding -> [RunNode BaseContext] -> IO ()
setInitialFolding InitialFolding
InitialFoldingAllOpen [RunNode BaseContext]
_rts = forall (m :: * -> *) a. Monad m => a -> m a
return ()
setInitialFolding InitialFolding
InitialFoldingAllClosed [RunNode BaseContext]
rts =
  forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall context s l t.
RunNodeWithStatus context s l t -> [RunNodeCommonWithStatus s l t]
getCommons [RunNode BaseContext]
rts) forall a b. (a -> b) -> a -> b
$ \(RunNodeCommonWithStatus {Bool
Int
String
Maybe String
Maybe SrcLoc
Var Bool
Var (Seq LogEntry)
Var Status
Seq Int
runTreeLogs :: forall s l t. RunNodeCommonWithStatus s l t -> l
runTreeRecordTime :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeVisible :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeLabel :: forall s l t. RunNodeCommonWithStatus s l t -> String
runTreeLoc :: Maybe SrcLoc
runTreeLogs :: Var (Seq LogEntry)
runTreeRecordTime :: Bool
runTreeVisibilityLevel :: Int
runTreeFolder :: Maybe String
runTreeVisible :: Bool
runTreeStatus :: Var Status
runTreeOpen :: Var Bool
runTreeToggled :: Var Bool
runTreeAncestors :: Seq Int
runTreeId :: Int
runTreeLabel :: String
runTreeOpen :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeToggled :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeFolder :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe String
runTreeLoc :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe SrcLoc
runTreeId :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeStatus :: forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeAncestors :: forall s l t. RunNodeCommonWithStatus s l t -> Seq Int
runTreeVisibilityLevel :: forall s l t. RunNodeCommonWithStatus s l t -> Int
..}) ->
    forall a. TVar a -> (a -> a) -> STM ()
modifyTVar Var Bool
runTreeOpen (forall a b. a -> b -> a
const Bool
False)
setInitialFolding (InitialFoldingTopNOpen Int
n) [RunNode BaseContext]
rts =
  forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall context s l t.
RunNodeWithStatus context s l t -> [RunNodeCommonWithStatus s l t]
getCommons [RunNode BaseContext]
rts) forall a b. (a -> b) -> a -> b
$ \(RunNodeCommonWithStatus {Bool
Int
String
Maybe String
Maybe SrcLoc
Var Bool
Var (Seq LogEntry)
Var Status
Seq Int
runTreeLoc :: Maybe SrcLoc
runTreeLogs :: Var (Seq LogEntry)
runTreeRecordTime :: Bool
runTreeVisibilityLevel :: Int
runTreeFolder :: Maybe String
runTreeVisible :: Bool
runTreeStatus :: Var Status
runTreeOpen :: Var Bool
runTreeToggled :: Var Bool
runTreeAncestors :: Seq Int
runTreeId :: Int
runTreeLabel :: String
runTreeLogs :: forall s l t. RunNodeCommonWithStatus s l t -> l
runTreeRecordTime :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeVisible :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeLabel :: forall s l t. RunNodeCommonWithStatus s l t -> String
runTreeOpen :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeToggled :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeFolder :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe String
runTreeLoc :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe SrcLoc
runTreeId :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeStatus :: forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeAncestors :: forall s l t. RunNodeCommonWithStatus s l t -> Seq Int
runTreeVisibilityLevel :: forall s l t. RunNodeCommonWithStatus s l t -> Int
..}) ->
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Seq a -> Int
Seq.length Seq Int
runTreeAncestors forall a. Ord a => a -> a -> Bool
> Int
n) forall a b. (a -> b) -> a -> b
$
      forall a. TVar a -> (a -> a) -> STM ()
modifyTVar Var Bool
runTreeOpen (forall a b. a -> b -> a
const Bool
False)

updateFilteredTree :: AppState -> AppState
updateFilteredTree :: AppState -> AppState
updateFilteredTree AppState
s = AppState
s
  forall a b. a -> (a -> b) -> b
& Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
t e -> Maybe Int -> GenericList n t e -> GenericList n t e
listReplace Vector MainListElem
elems (forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
listSelected forall a b. (a -> b) -> a -> b
$ AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList)
  where filteredTree :: [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
filteredTree = forall context.
Int -> [RunNodeFixed context] -> [RunNodeFixed context]
filterRunTree (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState Int
appVisibilityThreshold) (AppState
s forall s a. s -> Getting a s a -> a
^. Lens'
  AppState [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
appRunTree)
        Vector MainListElem
elems :: Vec.Vector MainListElem = forall a. [a] -> Vector a
Vec.fromList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall context.
(RunNodeFixed context, RunNode context) -> [MainListElem]
treeToList (forall a b. [a] -> [b] -> [(a, b)]
zip [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
filteredTree (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState [RunNode BaseContext]
appRunTreeBase))

-- * Clearing

clearRecursively :: RunNode context -> IO ()
clearRecursively :: forall context. RunNode context -> IO ()
clearRecursively = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RunNodeCommon -> IO ()
clearCommon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall context s l t.
RunNodeWithStatus context s l t -> [RunNodeCommonWithStatus s l t]
getCommons

clearRecursivelyWhere :: (RunNodeCommon -> Bool) -> RunNode context -> IO ()
clearRecursivelyWhere :: forall context. (RunNodeCommon -> Bool) -> RunNode context -> IO ()
clearRecursivelyWhere RunNodeCommon -> Bool
f = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RunNodeCommon -> IO ()
clearCommon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter RunNodeCommon -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall context s l t.
RunNodeWithStatus context s l t -> [RunNodeCommonWithStatus s l t]
getCommons

clearCommon :: RunNodeCommon -> IO ()
clearCommon :: RunNodeCommon -> IO ()
clearCommon (RunNodeCommonWithStatus {Bool
Int
String
Maybe String
Maybe SrcLoc
Var Bool
Var (Seq LogEntry)
Var Status
Seq Int
runTreeLoc :: Maybe SrcLoc
runTreeLogs :: Var (Seq LogEntry)
runTreeRecordTime :: Bool
runTreeVisibilityLevel :: Int
runTreeFolder :: Maybe String
runTreeVisible :: Bool
runTreeStatus :: Var Status
runTreeOpen :: Var Bool
runTreeToggled :: Var Bool
runTreeAncestors :: Seq Int
runTreeId :: Int
runTreeLabel :: String
runTreeLogs :: forall s l t. RunNodeCommonWithStatus s l t -> l
runTreeRecordTime :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeVisible :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeLabel :: forall s l t. RunNodeCommonWithStatus s l t -> String
runTreeOpen :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeToggled :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeFolder :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe String
runTreeLoc :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe SrcLoc
runTreeId :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeStatus :: forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeAncestors :: forall s l t. RunNodeCommonWithStatus s l t -> Seq Int
runTreeVisibilityLevel :: forall s l t. RunNodeCommonWithStatus s l t -> Int
..}) = do
  forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
    forall a. TVar a -> a -> STM ()
writeTVar Var Status
runTreeStatus Status
NotStarted
    forall a. TVar a -> a -> STM ()
writeTVar Var (Seq LogEntry)
runTreeLogs forall a. Monoid a => a
mempty

  -- TODO: clearing the folders might be better for reproducibility, but it might be more surprising than not doing it.
  -- Also, we'd want to be a little judicious about which folders get cleared -- clearing entire "describe" folders would
  -- blow away unrelated test results. So maybe it's better to not clear, and for tests to just do idempotent things in
  -- their folders.
  -- whenJust runTreeFolder $ \folder -> do
  --   doesDirectoryExist folder >>= \case
  --     False -> return ()
  --     True -> clearDirectoryContents folder
  -- where
  --   clearDirectoryContents :: FilePath -> IO ()
  --   clearDirectoryContents path = do
  --     paths <- listDirectory path
  --     forM_ paths removePathForcibly

findRunNodeChildrenById :: Int -> [RunNodeFixed context] -> Maybe (S.Set Int)
findRunNodeChildrenById :: forall context. Int -> [RunNodeFixed context] -> Maybe (Set Int)
findRunNodeChildrenById Int
ident [RunNodeFixed context]
rts = forall a. [a] -> Maybe a
headMay forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall context. Int -> RunNodeFixed context -> Maybe (Set Int)
findRunNodeChildrenById' Int
ident) [RunNodeFixed context]
rts

findRunNodeChildrenById' :: Int -> RunNodeFixed context -> Maybe (S.Set Int)
findRunNodeChildrenById' :: forall context. Int -> RunNodeFixed context -> Maybe (Set Int)
findRunNodeChildrenById' Int
ident RunNodeFixed context
node | Int
ident forall a. Eq a => a -> a -> Bool
== forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeId (forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon RunNodeFixed context
node) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall s l t a context.
(forall context1. RunNodeWithStatus context1 s l t -> a)
-> RunNodeWithStatus context s l t -> [a]
extractValues (forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon) RunNodeFixed context
node
findRunNodeChildrenById' Int
_ident (RunNodeIt {}) = forall a. Maybe a
Nothing
findRunNodeChildrenById' Int
ident (RunNodeIntroduce {[RunNodeWithStatus
   (LabelValue lab intro :> context) Status (Seq LogEntry) Bool]
ExampleT context IO intro
RunNodeCommonWithStatus Status (Seq LogEntry) Bool
intro -> ExampleT context IO ()
runNodeCleanup :: ()
runNodeAlloc :: ()
runNodeChildrenAugmented :: ()
runNodeCleanup :: intro -> ExampleT context IO ()
runNodeAlloc :: ExampleT context IO intro
runNodeChildrenAugmented :: [RunNodeWithStatus
   (LabelValue lab intro :> context) Status (Seq LogEntry) Bool]
runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
..}) = forall context. Int -> [RunNodeFixed context] -> Maybe (Set Int)
findRunNodeChildrenById Int
ident [RunNodeWithStatus
   (LabelValue lab intro :> context) Status (Seq LogEntry) Bool]
runNodeChildrenAugmented
findRunNodeChildrenById' Int
ident (RunNodeIntroduceWith {[RunNodeWithStatus
   (LabelValue lab intro :> context) Status (Seq LogEntry) Bool]
RunNodeCommonWithStatus Status (Seq LogEntry) Bool
(intro -> ExampleT context IO [Result]) -> ExampleT context IO ()
runNodeIntroduceAction :: ()
runNodeIntroduceAction :: (intro -> ExampleT context IO [Result]) -> ExampleT context IO ()
runNodeChildrenAugmented :: [RunNodeWithStatus
   (LabelValue lab intro :> context) Status (Seq LogEntry) Bool]
runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeChildrenAugmented :: ()
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
..}) = forall context. Int -> [RunNodeFixed context] -> Maybe (Set Int)
findRunNodeChildrenById Int
ident [RunNodeWithStatus
   (LabelValue lab intro :> context) Status (Seq LogEntry) Bool]
runNodeChildrenAugmented
findRunNodeChildrenById' Int
ident RunNodeFixed context
node = forall context. Int -> [RunNodeFixed context] -> Maybe (Set Int)
findRunNodeChildrenById Int
ident (forall s l t context.
RunNodeWithStatus context s l t
-> [RunNodeWithStatus context s l t]
runNodeChildren RunNodeFixed context
node)

#if MIN_VERSION_brick(1,0,0)
withScroll :: AppState -> (forall s. ViewportScroll ClickableName -> EventM n s ()) -> EventM n AppState ()
#else
withScroll :: AppState -> (ViewportScroll ClickableName -> EventM n ()) -> EventM n (Next AppState)
#endif
withScroll :: forall n.
AppState
-> (forall s. ViewportScroll ClickableName -> EventM n s ())
-> EventM n AppState ()
withScroll AppState
s forall s. ViewportScroll ClickableName -> EventM n s ()
action = do
  case forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList) of
    Maybe (Int, MainListElem)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just (Int
_, 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
open :: MainListElem -> Bool
toggled :: MainListElem -> Bool
depth :: MainListElem -> Int
label :: MainListElem -> String
status :: MainListElem -> Status
..}) -> do
      let scroll :: ViewportScroll ClickableName
scroll = forall n. n -> ViewportScroll n
viewportScroll (Text -> ClickableName
InnerViewport [i|viewport_#{ident}|])
      forall s. ViewportScroll ClickableName -> EventM n s ()
action ViewportScroll ClickableName
scroll

#if !MIN_VERSION_brick(1,0,0)
  continue s
#endif

openSrcLoc :: AppState -> SrcLoc -> EventM n AppState ()
openSrcLoc AppState
s SrcLoc
loc' = do
  -- Try to make the file path in the SrcLoc absolute
  SrcLoc
loc <- case String -> Bool
isRelative (SrcLoc -> String
srcLocFile SrcLoc
loc') of
    Bool
False -> forall (m :: * -> *) a. Monad m => a -> m a
return SrcLoc
loc'
    Bool
True -> do
      case Options -> Maybe String
optionsProjectRoot (BaseContext -> Options
baseContextOptions (AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState BaseContext
appBaseContext)) of
        Just String
d -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SrcLoc
loc' { srcLocFile :: String
srcLocFile = String
d String -> String -> String
</> (SrcLoc -> String
srcLocFile SrcLoc
loc') }
        Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return SrcLoc
loc'

  -- TODO: check if the path exists and show a warning message if not
  -- Maybe choose the first callstack location we can find?
  forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume (((AppState
s forall s a. s -> Getting a s a -> a
^. Lens' AppState (SrcLoc -> IO ())
appOpenInEditor) SrcLoc
loc) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return AppState
s)