{-# 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 Control.Monad.Trans
import Control.Monad.Trans.State hiding (get, put)
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 qualified Graphics.Vty.CrossPlatform 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 = TerminalUIFormatter
-> [RunNode BaseContext]
-> Maybe (CommandLineOptions ())
-> BaseContext
-> m ()
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
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

isTuiFormatterSupported :: IO Bool
isTuiFormatterSupported :: IO Bool
isTuiFormatterSupported = Either SomeException Vty -> Bool
forall a b. Either a b -> Bool
isRight (Either SomeException Vty -> Bool)
-> IO (Either SomeException Vty) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Vty -> IO (Either SomeException Vty)
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> m (Either SomeException a)
tryAny (VtyUserConfig -> IO Vty
V.mkVty VtyUserConfig
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 Int
Maybe String
Maybe LogLevel
InitialFolding
Maybe String -> (Text -> IO ()) -> SrcLoc -> IO ()
terminalUIVisibilityThreshold :: TerminalUIFormatter -> Int
terminalUIShowRunTimes :: TerminalUIFormatter -> Bool
terminalUIShowVisibilityThresholds :: TerminalUIFormatter -> Bool
terminalUILogLevel :: TerminalUIFormatter -> Maybe LogLevel
terminalUIInitialFolding :: TerminalUIFormatter -> InitialFolding
terminalUIDefaultEditor :: TerminalUIFormatter -> Maybe String
terminalUIOpenInEditor :: TerminalUIFormatter
-> Maybe String -> (Text -> IO ()) -> SrcLoc -> IO ()
terminalUICustomExceptionFormatters :: TerminalUIFormatter -> CustomExceptionFormatters
terminalUIVisibilityThreshold :: Int
terminalUIInitialFolding :: InitialFolding
terminalUIShowRunTimes :: Bool
terminalUIShowFileLocations :: Bool
terminalUIShowVisibilityThresholds :: Bool
terminalUILogLevel :: Maybe LogLevel
terminalUIRefreshPeriod :: Int
terminalUIClockUpdatePeriod :: Maybe Int
terminalUIDefaultEditor :: Maybe String
terminalUIOpenInEditor :: Maybe String -> (Text -> IO ()) -> SrcLoc -> IO ()
terminalUICustomExceptionFormatters :: CustomExceptionFormatters
terminalUIShowFileLocations :: TerminalUIFormatter -> Bool
terminalUIRefreshPeriod :: TerminalUIFormatter -> Int
terminalUIClockUpdatePeriod :: TerminalUIFormatter -> Maybe Int
..}) [RunNode BaseContext]
rts Maybe (CommandLineOptions ())
_maybeCommandLineOptions BaseContext
baseContext = do
  UTCTime
startTime <- IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime

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

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

  let initialState :: AppState
initialState = AppState -> AppState
updateFilteredTree (AppState -> AppState) -> AppState -> AppState
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 = ClickableName
-> Vector MainListElem
-> Int
-> GenericList ClickableName Vector MainListElem
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list ClickableName
MainList Vector MainListElem
forall a. Monoid a => a
mempty Int
1
          , _appBaseContext :: BaseContext
_appBaseContext = BaseContext
baseContext

          , _appStartTime :: UTCTime
_appStartTime = UTCTime
startTime
          , _appCurrentTime :: UTCTime
_appCurrentTime = UTCTime
startTime
          , _appSomethingRunning :: Bool
_appSomethingRunning = Bool
initialSomethingRunning

          , _appVisibilityThresholdSteps :: [Int]
_appVisibilityThresholdSteps = [Int] -> [Int]
forall a. Ord a => [a] -> [a]
L.sort ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. Eq a => [a] -> [a]
L.nub ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Int
terminalUIVisibilityThreshold Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ((RunNodeCommonWithStatus
   (Var Status) (Var (Seq LogEntry)) (Var Bool)
 -> Int)
-> [RunNodeCommonWithStatus
      (Var Status) (Var (Seq LogEntry)) (Var Bool)]
-> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> Int
forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeVisibilityLevel ([RunNodeCommonWithStatus
    (Var Status) (Var (Seq LogEntry)) (Var Bool)]
 -> [Int])
-> [RunNodeCommonWithStatus
      (Var Status) (Var (Seq LogEntry)) (Var Bool)]
-> [Int]
forall a b. (a -> b) -> a -> b
$ (RunNode BaseContext
 -> [RunNodeCommonWithStatus
       (Var Status) (Var (Seq LogEntry)) (Var Bool)])
-> [RunNode BaseContext]
-> [RunNodeCommonWithStatus
      (Var Status) (Var (Seq LogEntry)) (Var Bool)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RunNode BaseContext
-> [RunNodeCommonWithStatus
      (Var Status) (Var (Seq LogEntry)) (Var Bool)]
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 (IO () -> Text -> IO ()
forall a b. a -> b -> a
const (IO () -> Text -> IO ()) -> IO () -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
          , _appDebug :: Text -> IO ()
_appDebug = (IO () -> Text -> IO ()
forall a b. a -> b -> a
const (IO () -> Text -> IO ()) -> IO () -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
          , _appCustomExceptionFormatters :: CustomExceptionFormatters
_appCustomExceptionFormatters = CustomExceptionFormatters
terminalUICustomExceptionFormatters
        }

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

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

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

  let buildVty :: IO Vty
buildVty = do
        Vty
v <- VtyUserConfig -> IO Vty
V.mkVty VtyUserConfig
V.defaultConfig
        let output :: Output
output = Vty -> Output
V.outputIface Vty
v
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Output -> Mode -> Bool
V.supportsMode Output
output Mode
V.Mouse) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Output -> Mode -> Bool -> IO ()
V.setMode Output
output Mode
V.Mouse Bool
True
        Vty -> IO Vty
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Vty
v
  Vty
initialVty <- IO Vty -> m Vty
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Vty
buildVty

  let updateCurrentTimeForever :: Int -> IO b
updateCurrentTimeForever Int
period = IO () -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO b) -> IO () -> IO b
forall a b. (a -> b) -> a -> b
$ do
        UTCTime
now <- IO UTCTime
getCurrentTime
        BChan AppEvent -> AppEvent -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan AppEvent
eventChan (UTCTime -> AppEvent
CurrentTimeUpdated UTCTime
now)
        Int -> IO ()
threadDelay Int
period

  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
    (case Maybe Int
terminalUIClockUpdatePeriod of Maybe Int
Nothing -> IO () -> IO ()
forall a. a -> a
id; Just Int
ts -> \IO ()
action -> IO Any -> (Async Any -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (Int -> IO Any
forall {b}. Int -> IO b
updateCurrentTimeForever Int
ts) (\Async Any
_ -> IO ()
action)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      (IO () -> IO () -> IO ()) -> IO () -> IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO () -> IO () -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadMask m) =>
m a -> m b -> m a
onException (Async Any -> IO ()
forall a. Async a -> IO ()
cancel Async Any
eventAsync) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        IO AppState -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO AppState -> IO ()) -> IO AppState -> IO ()
forall a b. (a -> b) -> a -> b
$ Vty
-> IO Vty
-> Maybe (BChan AppEvent)
-> App AppState AppEvent ClickableName
-> AppState
-> IO AppState
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 (BChan AppEvent -> Maybe (BChan AppEvent)
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 = AppState
-> [CursorLocation ClickableName]
-> Maybe (CursorLocation ClickableName)
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 -> EventM ClickableName AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get EventM ClickableName AppState AppState
-> (AppState -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall a b.
EventM ClickableName AppState a
-> (a -> EventM ClickableName AppState b)
-> EventM ClickableName AppState b
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 = () -> EventM ClickableName AppState ()
forall a. a -> EventM ClickableName AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#else
  , appHandleEvent = appEvent
  , appStartEvent = return
#endif
  , appAttrMap :: AppState -> AttrMap
appAttrMap = AttrMap -> AppState -> AttrMap
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 = AppState -> EventM ClickableName AppState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put

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

doHalt :: p -> EventM n s ()
doHalt p
_ = EventM n s ()
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 Bool
somethingRunning)) = do
  UTCTime
now <- IO UTCTime -> EventM ClickableName AppState UTCTime
forall a. IO a -> EventM ClickableName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  AppState -> EventM ClickableName AppState ()
continue (AppState -> EventM ClickableName AppState ())
-> AppState -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState
s
    AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& ([RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
 -> Identity
      [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool])
-> AppState -> Identity AppState
Lens'
  AppState [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
appRunTree (([RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
  -> Identity
       [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool])
 -> AppState -> Identity AppState)
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> AppState
-> AppState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
newTree
    AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (UTCTime -> Identity UTCTime) -> AppState -> Identity AppState
Lens' AppState UTCTime
appCurrentTime ((UTCTime -> Identity UTCTime) -> AppState -> Identity AppState)
-> UTCTime -> AppState -> AppState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UTCTime
now
    AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> AppState -> Identity AppState
Lens' AppState Bool
appSomethingRunning ((Bool -> Identity Bool) -> AppState -> Identity AppState)
-> Bool -> AppState -> AppState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
somethingRunning
    AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& AppState -> AppState
updateFilteredTree
appEvent AppState
s (AppEvent (CurrentTimeUpdated UTCTime
ts)) = do
  AppState -> EventM ClickableName AppState ()
continue (AppState -> EventM ClickableName AppState ())
-> AppState -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ case (AppState
s AppState -> Getting Bool AppState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool AppState Bool
Lens' AppState Bool
appSomethingRunning) of
    Bool
True -> AppState
s AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (UTCTime -> Identity UTCTime) -> AppState -> Identity AppState
Lens' AppState UTCTime
appCurrentTime ((UTCTime -> Identity UTCTime) -> AppState -> Identity AppState)
-> UTCTime -> AppState -> AppState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UTCTime
ts
    Bool
False -> AppState
s

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

appEvent AppState
s (MouseDown (ListRow Int
_i) Button
V.BScrollUp [Modifier]
_ Location
_) = do
  ViewportScroll ClickableName
-> forall s. Int -> EventM ClickableName s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (ClickableName -> ViewportScroll ClickableName
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
  ViewportScroll ClickableName
-> forall s. Int -> EventM ClickableName s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (ClickableName -> ViewportScroll ClickableName
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 AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (GenericList ClickableName Vector MainListElem
 -> Identity (GenericList ClickableName Vector MainListElem))
-> AppState -> Identity AppState
Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList ((GenericList ClickableName Vector MainListElem
  -> Identity (GenericList ClickableName Vector MainListElem))
 -> AppState -> Identity AppState)
-> (GenericList ClickableName Vector MainListElem
    -> GenericList ClickableName Vector MainListElem)
-> AppState
-> AppState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int
-> GenericList ClickableName Vector MainListElem
-> GenericList ClickableName Vector MainListElem
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 Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
nextKey -> AppState -> EventM ClickableName AppState ()
continue (AppState
s AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (GenericList ClickableName Vector MainListElem
 -> Identity (GenericList ClickableName Vector MainListElem))
-> AppState -> Identity AppState
Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList ((GenericList ClickableName Vector MainListElem
  -> Identity (GenericList ClickableName Vector MainListElem))
 -> AppState -> Identity AppState)
-> (GenericList ClickableName Vector MainListElem
    -> GenericList ClickableName Vector MainListElem)
-> AppState
-> AppState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int
-> GenericList ClickableName Vector MainListElem
-> GenericList ClickableName Vector MainListElem
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 Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
previousKey -> AppState -> EventM ClickableName AppState ()
continue (AppState
s AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (GenericList ClickableName Vector MainListElem
 -> Identity (GenericList ClickableName Vector MainListElem))
-> AppState -> Identity AppState
Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList ((GenericList ClickableName Vector MainListElem
  -> Identity (GenericList ClickableName Vector MainListElem))
 -> AppState -> Identity AppState)
-> (GenericList ClickableName Vector MainListElem
    -> GenericList ClickableName Vector MainListElem)
-> AppState
-> AppState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int
-> GenericList ClickableName Vector MainListElem
-> GenericList ClickableName Vector MainListElem
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 Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
nextFailureKey -> do
      let ls :: [MainListElem]
ls = Vector MainListElem -> [MainListElem]
forall a. Vector a -> [a]
Vec.toList (Vector MainListElem -> [MainListElem])
-> Vector MainListElem -> [MainListElem]
forall a b. (a -> b) -> a -> b
$ GenericList ClickableName Vector MainListElem
-> Vector MainListElem
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements (AppState
s 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)
      let listToSearch :: [(Int, MainListElem)]
listToSearch = case GenericList ClickableName Vector MainListElem
-> Maybe (Int, MainListElem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s 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) of
            Just (Int
i, MainListElem {}) -> let ([(Int, MainListElem)]
front, [(Int, MainListElem)]
back) = Int
-> [(Int, MainListElem)]
-> ([(Int, MainListElem)], [(Int, MainListElem)])
forall a. Int -> [a] -> ([a], [a])
L.splitAt (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([Int] -> [MainListElem] -> [(Int, MainListElem)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [MainListElem]
ls) in [(Int, MainListElem)]
back [(Int, MainListElem)]
-> [(Int, MainListElem)] -> [(Int, MainListElem)]
forall a. Semigroup a => a -> a -> a
<> [(Int, MainListElem)]
front
            Maybe (Int, MainListElem)
Nothing -> [Int] -> [MainListElem] -> [(Int, MainListElem)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [MainListElem]
ls
      case ((Int, MainListElem) -> Bool)
-> [(Int, MainListElem)] -> Maybe (Int, MainListElem)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (Status -> Bool
isFailureStatus (Status -> Bool)
-> ((Int, MainListElem) -> Status) -> (Int, MainListElem) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MainListElem -> Status
status (MainListElem -> Status)
-> ((Int, MainListElem) -> MainListElem)
-> (Int, MainListElem)
-> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, MainListElem) -> MainListElem
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 AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (GenericList ClickableName Vector MainListElem
 -> Identity (GenericList ClickableName Vector MainListElem))
-> AppState -> Identity AppState
Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList ((GenericList ClickableName Vector MainListElem
  -> Identity (GenericList ClickableName Vector MainListElem))
 -> AppState -> Identity AppState)
-> (GenericList ClickableName Vector MainListElem
    -> GenericList ClickableName Vector MainListElem)
-> AppState
-> AppState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int
-> GenericList ClickableName Vector MainListElem
-> GenericList ClickableName Vector MainListElem
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 Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
previousFailureKey -> do
      let ls :: [MainListElem]
ls = Vector MainListElem -> [MainListElem]
forall a. Vector a -> [a]
Vec.toList (Vector MainListElem -> [MainListElem])
-> Vector MainListElem -> [MainListElem]
forall a b. (a -> b) -> a -> b
$ GenericList ClickableName Vector MainListElem
-> Vector MainListElem
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements (AppState
s 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)
      let listToSearch :: [(Int, MainListElem)]
listToSearch = case GenericList ClickableName Vector MainListElem
-> Maybe (Int, MainListElem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s 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) of
            Just (Int
i, MainListElem {}) -> let ([(Int, MainListElem)]
front, [(Int, MainListElem)]
back) = Int
-> [(Int, MainListElem)]
-> ([(Int, MainListElem)], [(Int, MainListElem)])
forall a. Int -> [a] -> ([a], [a])
L.splitAt Int
i ([Int] -> [MainListElem] -> [(Int, MainListElem)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [MainListElem]
ls) in ([(Int, MainListElem)] -> [(Int, MainListElem)]
forall a. [a] -> [a]
L.reverse [(Int, MainListElem)]
front) [(Int, MainListElem)]
-> [(Int, MainListElem)] -> [(Int, MainListElem)]
forall a. Semigroup a => a -> a -> a
<> ([(Int, MainListElem)] -> [(Int, MainListElem)]
forall a. [a] -> [a]
L.reverse [(Int, MainListElem)]
back)
            Maybe (Int, MainListElem)
Nothing -> [(Int, MainListElem)] -> [(Int, MainListElem)]
forall a. [a] -> [a]
L.reverse ([Int] -> [MainListElem] -> [(Int, MainListElem)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [MainListElem]
ls)
      case ((Int, MainListElem) -> Bool)
-> [(Int, MainListElem)] -> Maybe (Int, MainListElem)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (Status -> Bool
isFailureStatus (Status -> Bool)
-> ((Int, MainListElem) -> Status) -> (Int, MainListElem) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MainListElem -> Status
status (MainListElem -> Status)
-> ((Int, MainListElem) -> MainListElem)
-> (Int, MainListElem)
-> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, MainListElem) -> MainListElem
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 AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (GenericList ClickableName Vector MainListElem
 -> Identity (GenericList ClickableName Vector MainListElem))
-> AppState -> Identity AppState
Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList ((GenericList ClickableName Vector MainListElem
  -> Identity (GenericList ClickableName Vector MainListElem))
 -> AppState -> Identity AppState)
-> (GenericList ClickableName Vector MainListElem
    -> GenericList ClickableName Vector MainListElem)
-> AppState
-> AppState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int
-> GenericList ClickableName Vector MainListElem
-> GenericList ClickableName Vector MainListElem
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 Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
closeNodeKey -> AppState -> (Bool -> Bool) -> EventM ClickableName AppState ()
modifyOpen AppState
s (Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
False)
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
openNodeKey -> AppState -> (Bool -> Bool) -> EventM ClickableName AppState ()
modifyOpen AppState
s (Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
True)
    V.EvKey c :: Key
c@(V.KChar Char
ch) [Modifier
V.MMeta] | Key
c Key -> [Key] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Char -> Key) -> String -> [Key]
forall a b. (a -> b) -> [a] -> [b]
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 = String -> Int
forall a. Read a => String -> a
read [Char
ch]
      IO () -> EventM ClickableName AppState ()
forall a. IO a -> EventM ClickableName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> IO () -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ Vector MainListElem -> Int -> IO ()
forall (t :: * -> *). Foldable t => t MainListElem -> Int -> IO ()
openToDepth (AppState
s AppState
-> Getting (Vector MainListElem) AppState (Vector MainListElem)
-> Vector MainListElem
forall s a. s -> Getting a s a -> a
^. ((GenericList ClickableName Vector MainListElem
 -> Const
      (Vector MainListElem)
      (GenericList ClickableName Vector MainListElem))
-> AppState -> Const (Vector MainListElem) AppState
Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList ((GenericList ClickableName Vector MainListElem
  -> Const
       (Vector MainListElem)
       (GenericList ClickableName Vector MainListElem))
 -> AppState -> Const (Vector MainListElem) AppState)
-> ((Vector MainListElem
     -> Const (Vector MainListElem) (Vector MainListElem))
    -> GenericList ClickableName Vector MainListElem
    -> Const
         (Vector MainListElem)
         (GenericList ClickableName Vector MainListElem))
-> Getting (Vector MainListElem) AppState (Vector MainListElem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector MainListElem
 -> Const (Vector MainListElem) (Vector MainListElem))
-> GenericList ClickableName Vector MainListElem
-> Const
     (Vector MainListElem)
     (GenericList ClickableName Vector MainListElem)
forall n (t1 :: * -> *) e1 (t2 :: * -> *) e2 (f :: * -> *).
Functor f =>
(t1 e1 -> f (t2 e2))
-> GenericList n t1 e1 -> f (GenericList n t2 e2)
listElementsL)) Int
num
      AppState -> EventM ClickableName AppState ()
continue AppState
s
    V.EvKey Key
c [] | Key
c Key -> [Key] -> Bool
forall a. Eq a => a -> [a] -> Bool
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] -> AppState
-> (forall {s}.
    ViewportScroll ClickableName -> EventM ClickableName s ())
-> EventM ClickableName AppState ()
forall n.
AppState
-> (forall s. ViewportScroll ClickableName -> EventM n s ())
-> EventM n AppState ()
withScroll AppState
s ((forall {s}.
  ViewportScroll ClickableName -> EventM ClickableName s ())
 -> EventM ClickableName AppState ())
-> (forall {s}.
    ViewportScroll ClickableName -> EventM ClickableName s ())
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ \ViewportScroll ClickableName
vp -> ViewportScroll ClickableName
-> forall s. Int -> EventM ClickableName s ()
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] -> AppState
-> (forall {s}.
    ViewportScroll ClickableName -> EventM ClickableName s ())
-> EventM ClickableName AppState ()
forall n.
AppState
-> (forall s. ViewportScroll ClickableName -> EventM n s ())
-> EventM n AppState ()
withScroll AppState
s ((forall {s}.
  ViewportScroll ClickableName -> EventM ClickableName s ())
 -> EventM ClickableName AppState ())
-> (forall {s}.
    ViewportScroll ClickableName -> EventM ClickableName s ())
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ \ViewportScroll ClickableName
vp -> ViewportScroll ClickableName
-> forall s. Int -> EventM ClickableName s ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy ViewportScroll ClickableName
vp (-Int
1)
    V.EvKey Key
V.KDown [Modifier
V.MCtrl] -> AppState
-> (forall {s}.
    ViewportScroll ClickableName -> EventM ClickableName s ())
-> EventM ClickableName AppState ()
forall n.
AppState
-> (forall s. ViewportScroll ClickableName -> EventM n s ())
-> EventM n AppState ()
withScroll AppState
s ((forall {s}.
  ViewportScroll ClickableName -> EventM ClickableName s ())
 -> EventM ClickableName AppState ())
-> (forall {s}.
    ViewportScroll ClickableName -> EventM ClickableName s ())
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ \ViewportScroll ClickableName
vp -> ViewportScroll ClickableName
-> forall s. Int -> EventM ClickableName s ()
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] -> AppState
-> (forall {s}.
    ViewportScroll ClickableName -> EventM ClickableName s ())
-> EventM ClickableName AppState ()
forall n.
AppState
-> (forall s. ViewportScroll ClickableName -> EventM n s ())
-> EventM n AppState ()
withScroll AppState
s ((forall {s}.
  ViewportScroll ClickableName -> EventM ClickableName s ())
 -> EventM ClickableName AppState ())
-> (forall {s}.
    ViewportScroll ClickableName -> EventM ClickableName s ())
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ \ViewportScroll ClickableName
vp -> ViewportScroll ClickableName
-> forall s. Int -> EventM ClickableName s ()
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] -> AppState
-> (forall {s}.
    ViewportScroll ClickableName -> EventM ClickableName s ())
-> EventM ClickableName AppState ()
forall n.
AppState
-> (forall s. ViewportScroll ClickableName -> EventM n s ())
-> EventM n AppState ()
withScroll AppState
s ((forall {s}.
  ViewportScroll ClickableName -> EventM ClickableName s ())
 -> EventM ClickableName AppState ())
-> (forall {s}.
    ViewportScroll ClickableName -> EventM ClickableName s ())
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ \ViewportScroll ClickableName
vp -> ViewportScroll ClickableName
-> forall s. Direction -> EventM ClickableName s ()
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] -> AppState
-> (forall {s}.
    ViewportScroll ClickableName -> EventM ClickableName s ())
-> EventM ClickableName AppState ()
forall n.
AppState
-> (forall s. ViewportScroll ClickableName -> EventM n s ())
-> EventM n AppState ()
withScroll AppState
s ((forall {s}.
  ViewportScroll ClickableName -> EventM ClickableName s ())
 -> EventM ClickableName AppState ())
-> (forall {s}.
    ViewportScroll ClickableName -> EventM ClickableName s ())
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ \ViewportScroll ClickableName
vp -> ViewportScroll ClickableName
-> forall s. Direction -> EventM ClickableName s ()
forall n. ViewportScroll n -> forall s. Direction -> EventM n s ()
vScrollPage ViewportScroll ClickableName
vp Direction
Down
    V.EvKey Key
V.KHome [Modifier
V.MCtrl] -> AppState
-> (forall {s}.
    ViewportScroll ClickableName -> EventM ClickableName s ())
-> EventM ClickableName AppState ()
forall n.
AppState
-> (forall s. ViewportScroll ClickableName -> EventM n s ())
-> EventM n AppState ()
withScroll AppState
s ((forall {s}.
  ViewportScroll ClickableName -> EventM ClickableName s ())
 -> EventM ClickableName AppState ())
-> (forall {s}.
    ViewportScroll ClickableName -> EventM ClickableName s ())
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ \ViewportScroll ClickableName
vp -> ViewportScroll ClickableName -> forall s. EventM ClickableName s ()
forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToBeginning ViewportScroll ClickableName
vp
    V.EvKey Key
V.KEnd [Modifier
V.MCtrl] -> AppState
-> (forall {s}.
    ViewportScroll ClickableName -> EventM ClickableName s ())
-> EventM ClickableName AppState ()
forall n.
AppState
-> (forall s. ViewportScroll ClickableName -> EventM n s ())
-> EventM n AppState ()
withScroll AppState
s ((forall {s}.
  ViewportScroll ClickableName -> EventM ClickableName s ())
 -> EventM ClickableName AppState ())
-> (forall {s}.
    ViewportScroll ClickableName -> EventM ClickableName s ())
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ \ViewportScroll ClickableName
vp -> ViewportScroll ClickableName -> forall s. EventM ClickableName s ()
forall n. ViewportScroll n -> forall s. EventM n s ()
vScrollToEnd ViewportScroll ClickableName
vp

    -- Column 2
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
cancelAllKey -> do
      IO () -> EventM ClickableName AppState ()
forall a. IO a -> EventM ClickableName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> IO () -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ (RunNode BaseContext -> IO ()) -> [RunNode BaseContext] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RunNode BaseContext -> IO ()
forall context. RunNode context -> IO ()
cancelNode (AppState
s AppState
-> Getting [RunNode BaseContext] AppState [RunNode BaseContext]
-> [RunNode BaseContext]
forall s a. s -> Getting a s a -> a
^. Getting [RunNode BaseContext] AppState [RunNode BaseContext]
Lens' AppState [RunNode BaseContext]
appRunTreeBase)
      AppState -> EventM ClickableName AppState ()
continue AppState
s
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
cancelSelectedKey -> AppState
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall {a}.
AppState
-> EventM ClickableName AppState a
-> EventM ClickableName AppState ()
withContinueS AppState
s (EventM ClickableName AppState ()
 -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ do
      Maybe (Int, MainListElem)
-> ((Int, MainListElem) -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust (GenericList ClickableName Vector MainListElem
-> Maybe (Int, MainListElem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s 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)) (((Int, MainListElem) -> EventM ClickableName AppState ())
 -> EventM ClickableName AppState ())
-> ((Int, MainListElem) -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ \(Int
_, MainListElem {Bool
Int
String
Maybe String
Seq LogEntry
RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
Status
status :: MainListElem -> Status
label :: String
depth :: Int
toggled :: Bool
open :: Bool
status :: Status
logs :: Seq LogEntry
visibilityLevel :: Int
folderPath :: Maybe String
node :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
ident :: Int
label :: MainListElem -> String
depth :: MainListElem -> Int
toggled :: MainListElem -> Bool
open :: MainListElem -> Bool
logs :: MainListElem -> Seq LogEntry
visibilityLevel :: MainListElem -> Int
folderPath :: MainListElem -> Maybe String
node :: MainListElem
-> RunNodeCommonWithStatus
     (Var Status) (Var (Seq LogEntry)) (Var Bool)
ident :: MainListElem -> Int
..}) -> IO () -> EventM ClickableName AppState ()
forall a. IO a -> EventM ClickableName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> IO () -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$
        (Var Status -> IO Status
forall a. TVar a -> IO a
readTVarIO (Var Status -> IO Status) -> Var Status -> IO Status
forall a b. (a -> b) -> a -> b
$ RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> Var Status
forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeStatus RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
node) IO Status -> (Status -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Running {Maybe NominalDiffTime
UTCTime
Async Result
statusStartTime :: UTCTime
statusSetupTime :: Maybe NominalDiffTime
statusAsync :: Async Result
statusStartTime :: Status -> UTCTime
statusSetupTime :: Status -> Maybe NominalDiffTime
statusAsync :: Status -> Async Result
..} -> Async Result -> IO ()
forall a. Async a -> IO ()
cancel Async Result
statusAsync
          Status
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
runAllKey -> do
      UTCTime
now <- IO UTCTime -> EventM ClickableName AppState UTCTime
forall a. IO a -> EventM ClickableName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      Bool
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool -> Bool)
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool)
-> (RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool
    -> Bool)
-> RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Bool
isRunning (Status -> Bool)
-> (RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool
    -> Status)
-> RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunNodeCommonWithStatus Status (Seq LogEntry) Bool -> Status
forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeStatus (RunNodeCommonWithStatus Status (Seq LogEntry) Bool -> Status)
-> (RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool
    -> RunNodeCommonWithStatus Status (Seq LogEntry) Bool)
-> RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool
-> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool
-> RunNodeCommonWithStatus Status (Seq LogEntry) Bool
forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon) (AppState
s 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)) (EventM ClickableName AppState ()
 -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ IO () -> EventM ClickableName AppState ()
forall a. IO a -> EventM ClickableName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> IO () -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ do
        (RunNode BaseContext -> IO ()) -> [RunNode BaseContext] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RunNode BaseContext -> IO ()
forall context. RunNode context -> IO ()
clearRecursively (AppState
s AppState
-> Getting [RunNode BaseContext] AppState [RunNode BaseContext]
-> [RunNode BaseContext]
forall s a. s -> Getting a s a -> a
^. Getting [RunNode BaseContext] AppState [RunNode BaseContext]
Lens' AppState [RunNode BaseContext]
appRunTreeBase)
        IO (Async ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Async ()) -> IO ()) -> IO (Async ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ IO [Result] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [Result] -> IO ()) -> IO [Result] -> IO ()
forall a b. (a -> b) -> a -> b
$ [RunNode BaseContext] -> BaseContext -> IO [Result]
forall context.
HasBaseContext context =>
[RunNode context] -> context -> IO [Result]
runNodesSequentially (AppState
s AppState
-> Getting [RunNode BaseContext] AppState [RunNode BaseContext]
-> [RunNode BaseContext]
forall s a. s -> Getting a s a -> a
^. Getting [RunNode BaseContext] AppState [RunNode BaseContext]
Lens' AppState [RunNode BaseContext]
appRunTreeBase) (AppState
s AppState -> Getting BaseContext AppState BaseContext -> BaseContext
forall s a. s -> Getting a s a -> a
^. Getting BaseContext AppState BaseContext
Lens' AppState BaseContext
appBaseContext)
      AppState -> EventM ClickableName AppState ()
continue (AppState -> EventM ClickableName AppState ())
-> AppState -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState
s
        AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (UTCTime -> Identity UTCTime) -> AppState -> Identity AppState
Lens' AppState UTCTime
appStartTime ((UTCTime -> Identity UTCTime) -> AppState -> Identity AppState)
-> UTCTime -> AppState -> AppState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UTCTime
now
        AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (UTCTime -> Identity UTCTime) -> AppState -> Identity AppState
Lens' AppState UTCTime
appCurrentTime ((UTCTime -> Identity UTCTime) -> AppState -> Identity AppState)
-> UTCTime -> AppState -> AppState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UTCTime
now
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
runSelectedKey ->
      Maybe (Int, MainListElem)
-> ((Int, MainListElem) -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust (GenericList ClickableName Vector MainListElem
-> Maybe (Int, MainListElem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s 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)) (((Int, MainListElem) -> EventM ClickableName AppState ())
 -> EventM ClickableName AppState ())
-> ((Int, MainListElem) -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ \(Int
_, MainListElem {Bool
Int
String
Maybe String
Seq LogEntry
RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
Status
status :: MainListElem -> Status
label :: MainListElem -> String
depth :: MainListElem -> Int
toggled :: MainListElem -> Bool
open :: MainListElem -> Bool
logs :: MainListElem -> Seq LogEntry
visibilityLevel :: MainListElem -> Int
folderPath :: MainListElem -> Maybe String
node :: MainListElem
-> RunNodeCommonWithStatus
     (Var Status) (Var (Seq LogEntry)) (Var Bool)
ident :: MainListElem -> Int
label :: String
depth :: Int
toggled :: Bool
open :: Bool
status :: Status
logs :: Seq LogEntry
visibilityLevel :: Int
folderPath :: Maybe String
node :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
ident :: Int
..}) -> case Status
status of
        Running {} -> AppState -> EventM ClickableName AppState ()
continue AppState
s
        Status
_ -> do
          -- Get the set of IDs for only this node's ancestors and children
          let ancestorIds :: Set Int
ancestorIds = [Int] -> Set Int
forall a. Ord a => [a] -> Set a
S.fromList ([Int] -> Set Int) -> [Int] -> Set Int
forall a b. (a -> b) -> a -> b
$ Seq Int -> [Int]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Int -> [Int]) -> Seq Int -> [Int]
forall a b. (a -> b) -> a -> b
$ RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> Seq Int
forall s l t. RunNodeCommonWithStatus s l t -> Seq Int
runTreeAncestors RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
node
          case Int
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> Maybe (Set Int)
forall context. Int -> [RunNodeFixed context] -> Maybe (Set Int)
findRunNodeChildrenById Int
ident (AppState
s 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) of
            Maybe (Set Int)
Nothing -> AppState -> EventM ClickableName AppState ()
continue AppState
s
            Just Set Int
childIds -> do
              let allIds :: Set Int
allIds = Set Int
ancestorIds Set Int -> Set Int -> Set Int
forall a. Semigroup a => a -> a -> a
<> Set Int
childIds
              -- Clear the status of all affected nodes
              IO () -> EventM ClickableName AppState ()
forall a. IO a -> EventM ClickableName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> IO () -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ (RunNode BaseContext -> IO ()) -> [RunNode BaseContext] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((RunNodeCommonWithStatus
   (Var Status) (Var (Seq LogEntry)) (Var Bool)
 -> Bool)
-> RunNode BaseContext -> IO ()
forall context.
(RunNodeCommonWithStatus
   (Var Status) (Var (Seq LogEntry)) (Var Bool)
 -> Bool)
-> RunNode context -> IO ()
clearRecursivelyWhere (\RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
x -> RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> Int
forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeId RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
x Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Int
allIds)) (AppState
s AppState
-> Getting [RunNode BaseContext] AppState [RunNode BaseContext]
-> [RunNode BaseContext]
forall s a. s -> Getting a s a -> a
^. Getting [RunNode BaseContext] AppState [RunNode BaseContext]
Lens' AppState [RunNode BaseContext]
appRunTreeBase)
              -- Start a run for all affected nodes
              UTCTime
now <- IO UTCTime -> EventM ClickableName AppState UTCTime
forall a. IO a -> EventM ClickableName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
              let bc :: BaseContext
bc = (AppState
s AppState -> Getting BaseContext AppState BaseContext -> BaseContext
forall s a. s -> Getting a s a -> a
^. Getting BaseContext AppState BaseContext
Lens' AppState BaseContext
appBaseContext) { baseContextOnlyRunIds = Just allIds }
              EventM ClickableName AppState (Async ())
-> EventM ClickableName AppState ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (EventM ClickableName AppState (Async ())
 -> EventM ClickableName AppState ())
-> EventM ClickableName AppState (Async ())
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ IO (Async ()) -> EventM ClickableName AppState (Async ())
forall a. IO a -> EventM ClickableName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Async ()) -> EventM ClickableName AppState (Async ()))
-> IO (Async ()) -> EventM ClickableName AppState (Async ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ IO [Result] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [Result] -> IO ()) -> IO [Result] -> IO ()
forall a b. (a -> b) -> a -> b
$ [RunNode BaseContext] -> BaseContext -> IO [Result]
forall context.
HasBaseContext context =>
[RunNode context] -> context -> IO [Result]
runNodesSequentially (AppState
s AppState
-> Getting [RunNode BaseContext] AppState [RunNode BaseContext]
-> [RunNode BaseContext]
forall s a. s -> Getting a s a -> a
^. Getting [RunNode BaseContext] AppState [RunNode BaseContext]
Lens' AppState [RunNode BaseContext]
appRunTreeBase) BaseContext
bc
              AppState -> EventM ClickableName AppState ()
continue (AppState -> EventM ClickableName AppState ())
-> AppState -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState
s
                AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (UTCTime -> Identity UTCTime) -> AppState -> Identity AppState
Lens' AppState UTCTime
appStartTime ((UTCTime -> Identity UTCTime) -> AppState -> Identity AppState)
-> UTCTime -> AppState -> AppState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UTCTime
now
                AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (UTCTime -> Identity UTCTime) -> AppState -> Identity AppState
Lens' AppState UTCTime
appCurrentTime ((UTCTime -> Identity UTCTime) -> AppState -> Identity AppState)
-> UTCTime -> AppState -> AppState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UTCTime
now
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
clearSelectedKey -> AppState
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall {a}.
AppState
-> EventM ClickableName AppState a
-> EventM ClickableName AppState ()
withContinueS AppState
s (EventM ClickableName AppState ()
 -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ do
      Maybe (Int, MainListElem)
-> ((Int, MainListElem) -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust (GenericList ClickableName Vector MainListElem
-> Maybe (Int, MainListElem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s 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)) (((Int, MainListElem) -> EventM ClickableName AppState ())
 -> EventM ClickableName AppState ())
-> ((Int, MainListElem) -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ \(Int
_, MainListElem {Bool
Int
String
Maybe String
Seq LogEntry
RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
Status
status :: MainListElem -> Status
label :: MainListElem -> String
depth :: MainListElem -> Int
toggled :: MainListElem -> Bool
open :: MainListElem -> Bool
logs :: MainListElem -> Seq LogEntry
visibilityLevel :: MainListElem -> Int
folderPath :: MainListElem -> Maybe String
node :: MainListElem
-> RunNodeCommonWithStatus
     (Var Status) (Var (Seq LogEntry)) (Var Bool)
ident :: MainListElem -> Int
label :: String
depth :: Int
toggled :: Bool
open :: Bool
status :: Status
logs :: Seq LogEntry
visibilityLevel :: Int
folderPath :: Maybe String
node :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
ident :: Int
..}) -> case Status
status of
        Running {} -> () -> EventM ClickableName AppState ()
forall a. a -> EventM ClickableName AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Status
_ -> case Int
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> Maybe (Set Int)
forall context. Int -> [RunNodeFixed context] -> Maybe (Set Int)
findRunNodeChildrenById Int
ident (AppState
s 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) of
          Maybe (Set Int)
Nothing -> () -> EventM ClickableName AppState ()
forall a. a -> EventM ClickableName AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just Set Int
childIds -> IO () -> EventM ClickableName AppState ()
forall a. IO a -> EventM ClickableName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> IO () -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ (RunNode BaseContext -> IO ()) -> [RunNode BaseContext] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((RunNodeCommonWithStatus
   (Var Status) (Var (Seq LogEntry)) (Var Bool)
 -> Bool)
-> RunNode BaseContext -> IO ()
forall context.
(RunNodeCommonWithStatus
   (Var Status) (Var (Seq LogEntry)) (Var Bool)
 -> Bool)
-> RunNode context -> IO ()
clearRecursivelyWhere (\RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
x -> RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> Int
forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeId RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
x Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Int
childIds)) (AppState
s AppState
-> Getting [RunNode BaseContext] AppState [RunNode BaseContext]
-> [RunNode BaseContext]
forall s a. s -> Getting a s a -> a
^. Getting [RunNode BaseContext] AppState [RunNode BaseContext]
Lens' AppState [RunNode BaseContext]
appRunTreeBase)
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
clearAllKey -> AppState
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall {a}.
AppState
-> EventM ClickableName AppState a
-> EventM ClickableName AppState ()
withContinueS AppState
s (EventM ClickableName AppState ()
 -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ do
      IO () -> EventM ClickableName AppState ()
forall a. IO a -> EventM ClickableName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> IO () -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ (RunNode BaseContext -> IO ()) -> [RunNode BaseContext] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RunNode BaseContext -> IO ()
forall context. RunNode context -> IO ()
clearRecursively (AppState
s AppState
-> Getting [RunNode BaseContext] AppState [RunNode BaseContext]
-> [RunNode BaseContext]
forall s a. s -> Getting a s a -> a
^. Getting [RunNode BaseContext] AppState [RunNode BaseContext]
Lens' AppState [RunNode BaseContext]
appRunTreeBase)
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
openSelectedFolderInFileExplorer -> AppState
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall {a}.
AppState
-> EventM ClickableName AppState a
-> EventM ClickableName AppState ()
withContinueS AppState
s (EventM ClickableName AppState ()
 -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ do
      Maybe (Int, MainListElem)
-> ((Int, MainListElem) -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust (GenericList ClickableName Vector MainListElem
-> Maybe (Int, MainListElem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s 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)) (((Int, MainListElem) -> EventM ClickableName AppState ())
 -> EventM ClickableName AppState ())
-> ((Int, MainListElem) -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ \(Int
_i, MainListElem {Maybe String
folderPath :: MainListElem -> Maybe String
folderPath :: Maybe String
folderPath}) ->
        Maybe String
-> (String -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust Maybe String
folderPath ((String -> EventM ClickableName AppState ())
 -> EventM ClickableName AppState ())
-> (String -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ IO () -> EventM ClickableName AppState ()
forall a. IO a -> EventM ClickableName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> (String -> IO ()) -> String -> EventM ClickableName AppState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
openFileExplorerFolderPortable
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
openTestRootKey -> AppState
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall {a}.
AppState
-> EventM ClickableName AppState a
-> EventM ClickableName AppState ()
withContinueS AppState
s (EventM ClickableName AppState ()
 -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$
      Maybe String
-> (String -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust (BaseContext -> Maybe String
baseContextRunRoot (AppState
s AppState -> Getting BaseContext AppState BaseContext -> BaseContext
forall s a. s -> Getting a s a -> a
^. Getting BaseContext AppState BaseContext
Lens' AppState BaseContext
appBaseContext)) ((String -> EventM ClickableName AppState ())
 -> EventM ClickableName AppState ())
-> (String -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ IO () -> EventM ClickableName AppState ()
forall a. IO a -> EventM ClickableName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> (String -> IO ()) -> String -> EventM ClickableName AppState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
openFileExplorerFolderPortable
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
openTestInEditorKey -> case GenericList ClickableName Vector MainListElem
-> Maybe (Int, MainListElem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s 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) of
      Just (Int
_i, MainListElem {node :: MainListElem
-> RunNodeCommonWithStatus
     (Var Status) (Var (Seq LogEntry)) (Var Bool)
node=(RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> Maybe SrcLoc
forall s l t. RunNodeCommonWithStatus s l t -> Maybe SrcLoc
runTreeLoc -> Just SrcLoc
loc)}) -> AppState -> SrcLoc -> EventM ClickableName AppState ()
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 Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
openLogsInEditorKey -> case GenericList ClickableName Vector MainListElem
-> Maybe (Int, MainListElem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s 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) of
      Just (Int
_i, MainListElem {node :: MainListElem
-> RunNodeCommonWithStatus
     (Var Status) (Var (Seq LogEntry)) (Var Bool)
node=(RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> Maybe String
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
          }
        IO AppState -> EventM ClickableName AppState ()
forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume ((AppState
s AppState
-> Getting (SrcLoc -> IO ()) AppState (SrcLoc -> IO ())
-> SrcLoc
-> IO ()
forall s a. s -> Getting a s a -> a
^. Getting (SrcLoc -> IO ()) AppState (SrcLoc -> IO ())
Lens' AppState (SrcLoc -> IO ())
appOpenInEditor) SrcLoc
srcLoc IO () -> IO AppState -> IO AppState
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AppState -> IO AppState
forall a. a -> IO a
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 Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
openFailureInEditorKey -> do
      case (GenericList ClickableName Vector MainListElem
-> Maybe (Int, MainListElem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s 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)) of
        Maybe (Int, MainListElem)
Nothing -> AppState -> EventM ClickableName AppState ()
continue AppState
s
        Just (Int
_i, MainListElem {Status
status :: MainListElem -> Status
status :: Status
status}) -> case Status
status of
          Done UTCTime
_ UTCTime
_ Maybe NominalDiffTime
_ Maybe NominalDiffTime
_ (Failure (FailureReason -> Maybe CallStack
failureCallStack -> Just (CallStack -> [(String, SrcLoc)]
getCallStack -> ((String
_, SrcLoc
loc):[(String, SrcLoc)]
_)))) -> AppState -> SrcLoc -> EventM ClickableName AppState ()
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 Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
cycleVisibilityThresholdKey -> do
      let newVisibilityThreshold :: Int
newVisibilityThreshold =  case [(Integer
i, Int
x) | (Integer
i, Int
x) <- [Integer] -> [Int] -> [(Integer, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] (AppState
s AppState -> Getting [Int] AppState [Int] -> [Int]
forall s a. s -> Getting a s a -> a
^. Getting [Int] AppState [Int]
Lens' AppState [Int]
appVisibilityThresholdSteps)
                                                 , Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> AppState
s AppState -> Getting Int AppState Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int AppState Int
Lens' AppState Int
appVisibilityThreshold] of
            [] -> Int
0
            [(Integer, Int)]
xs -> [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Integer, Int) -> Int) -> [(Integer, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer, Int) -> Int
forall a b. (a, b) -> b
snd [(Integer, Int)]
xs
      AppState -> EventM ClickableName AppState ()
continue (AppState -> EventM ClickableName AppState ())
-> AppState -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState
s
        AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int) -> AppState -> Identity AppState
Lens' AppState Int
appVisibilityThreshold ((Int -> Identity Int) -> AppState -> Identity AppState)
-> Int -> AppState -> AppState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
newVisibilityThreshold
        AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& AppState -> AppState
updateFilteredTree
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
toggleShowRunTimesKey -> AppState -> EventM ClickableName AppState ()
continue (AppState -> EventM ClickableName AppState ())
-> AppState -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState
s
      AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> AppState -> Identity AppState
Lens' AppState Bool
appShowRunTimes ((Bool -> Identity Bool) -> AppState -> Identity AppState)
-> (Bool -> Bool) -> AppState -> AppState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Bool -> Bool
not
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
toggleFileLocationsKey -> AppState -> EventM ClickableName AppState ()
continue (AppState -> EventM ClickableName AppState ())
-> AppState -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState
s
      AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> AppState -> Identity AppState
Lens' AppState Bool
appShowFileLocations ((Bool -> Identity Bool) -> AppState -> Identity AppState)
-> (Bool -> Bool) -> AppState -> AppState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Bool -> Bool
not
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
toggleVisibilityThresholdsKey -> AppState -> EventM ClickableName AppState ()
continue (AppState -> EventM ClickableName AppState ())
-> AppState -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState
s
      AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> AppState -> Identity AppState
Lens' AppState Bool
appShowVisibilityThresholds ((Bool -> Identity Bool) -> AppState -> Identity AppState)
-> (Bool -> Bool) -> AppState -> AppState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Bool -> Bool
not
    V.EvKey Key
c [] | Key
c Key -> [Key] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key
V.KEsc, Key
exitKey] -> do
      -- Cancel everything and wait for cleanups
      IO () -> EventM ClickableName AppState ()
forall a. IO a -> EventM ClickableName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> IO () -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ (RunNode BaseContext -> IO ()) -> [RunNode BaseContext] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RunNode BaseContext -> IO ()
forall context. RunNode context -> IO ()
cancelNode (AppState
s AppState
-> Getting [RunNode BaseContext] AppState [RunNode BaseContext]
-> [RunNode BaseContext]
forall s a. s -> Getting a s a -> a
^. Getting [RunNode BaseContext] AppState [RunNode BaseContext]
Lens' AppState [RunNode BaseContext]
appRunTreeBase)
      [RunNode BaseContext]
-> (RunNode BaseContext -> EventM ClickableName AppState Result)
-> EventM ClickableName AppState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (AppState
s AppState
-> Getting [RunNode BaseContext] AppState [RunNode BaseContext]
-> [RunNode BaseContext]
forall s a. s -> Getting a s a -> a
^. Getting [RunNode BaseContext] AppState [RunNode BaseContext]
Lens' AppState [RunNode BaseContext]
appRunTreeBase) (IO Result -> EventM ClickableName AppState Result
forall a. IO a -> EventM ClickableName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> EventM ClickableName AppState Result)
-> (RunNode BaseContext -> IO Result)
-> RunNode BaseContext
-> EventM ClickableName AppState Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunNode BaseContext -> IO Result
forall context. RunNode context -> IO Result
waitForTree)
      AppState -> EventM ClickableName AppState ()
forall {p} {n} {s}. p -> EventM n s ()
doHalt AppState
s
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
debugKey -> AppState -> EventM ClickableName AppState ()
continue (AppState
s AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (Maybe LogLevel -> Identity (Maybe LogLevel))
-> AppState -> Identity AppState
Lens' AppState (Maybe LogLevel)
appLogLevel ((Maybe LogLevel -> Identity (Maybe LogLevel))
 -> AppState -> Identity AppState)
-> LogLevel -> AppState -> AppState
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ LogLevel
LevelDebug)
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
infoKey -> AppState -> EventM ClickableName AppState ()
continue (AppState
s AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (Maybe LogLevel -> Identity (Maybe LogLevel))
-> AppState -> Identity AppState
Lens' AppState (Maybe LogLevel)
appLogLevel ((Maybe LogLevel -> Identity (Maybe LogLevel))
 -> AppState -> Identity AppState)
-> LogLevel -> AppState -> AppState
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ LogLevel
LevelInfo)
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
warnKey -> AppState -> EventM ClickableName AppState ()
continue (AppState
s AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (Maybe LogLevel -> Identity (Maybe LogLevel))
-> AppState -> Identity AppState
Lens' AppState (Maybe LogLevel)
appLogLevel ((Maybe LogLevel -> Identity (Maybe LogLevel))
 -> AppState -> Identity AppState)
-> LogLevel -> AppState -> AppState
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ LogLevel
LevelWarn)
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
errorKey -> AppState -> EventM ClickableName AppState ()
continue (AppState
s AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (Maybe LogLevel -> Identity (Maybe LogLevel))
-> AppState -> Identity AppState
Lens' AppState (Maybe LogLevel)
appLogLevel ((Maybe LogLevel -> Identity (Maybe LogLevel))
 -> AppState -> Identity AppState)
-> LogLevel -> AppState -> AppState
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 -> LensLike'
  (Zoomed
     (EventM
        ClickableName (GenericList ClickableName Vector MainListElem))
     ())
  AppState
  (GenericList ClickableName Vector MainListElem)
-> EventM
     ClickableName (GenericList ClickableName Vector MainListElem) ()
-> EventM ClickableName AppState ()
forall c.
LensLike'
  (Zoomed
     (EventM
        ClickableName (GenericList ClickableName Vector MainListElem))
     c)
  AppState
  (GenericList ClickableName Vector MainListElem)
-> EventM
     ClickableName (GenericList ClickableName Vector MainListElem) c
-> EventM ClickableName AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (GenericList ClickableName Vector MainListElem
 -> Focusing
      (StateT (EventState ClickableName) IO)
      ()
      (GenericList ClickableName Vector MainListElem))
-> AppState
-> Focusing (StateT (EventState ClickableName) IO) () AppState
LensLike'
  (Zoomed
     (EventM
        ClickableName (GenericList ClickableName Vector MainListElem))
     ())
  AppState
  (GenericList ClickableName Vector MainListElem)
Lens' AppState (GenericList ClickableName Vector MainListElem)
appMainList (EventM
   ClickableName (GenericList ClickableName Vector MainListElem) ()
 -> EventM ClickableName AppState ())
-> EventM
     ClickableName (GenericList ClickableName Vector MainListElem) ()
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ Event
-> EventM
     ClickableName (GenericList ClickableName Vector MainListElem) ()
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 EventM ClickableName AppState a
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall a b.
EventM ClickableName AppState a
-> EventM ClickableName AppState b
-> EventM ClickableName AppState b
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
_ = () -> EventM ClickableName AppState ()
forall a. a -> EventM ClickableName AppState a
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 GenericList ClickableName Vector MainListElem
-> Maybe (Int, MainListElem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s 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) of
  Maybe (Int, MainListElem)
Nothing -> AppState -> EventM ClickableName AppState ()
continue AppState
s
  Just (Int
_i, MainListElem {Bool
Int
String
Maybe String
Seq LogEntry
RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
Status
status :: MainListElem -> Status
label :: MainListElem -> String
depth :: MainListElem -> Int
toggled :: MainListElem -> Bool
open :: MainListElem -> Bool
logs :: MainListElem -> Seq LogEntry
visibilityLevel :: MainListElem -> Int
folderPath :: MainListElem -> Maybe String
node :: MainListElem
-> RunNodeCommonWithStatus
     (Var Status) (Var (Seq LogEntry)) (Var Bool)
ident :: MainListElem -> Int
label :: String
depth :: Int
toggled :: Bool
open :: Bool
status :: Status
logs :: Seq LogEntry
visibilityLevel :: Int
folderPath :: Maybe String
node :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
ident :: Int
..}) -> do
    IO () -> EventM ClickableName AppState ()
forall a. IO a -> EventM ClickableName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> IO () -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ Var Bool -> (Bool -> Bool) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> Var Bool
forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeToggled RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
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 GenericList ClickableName Vector MainListElem
-> Maybe (Int, MainListElem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s 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) of
  Maybe (Int, MainListElem)
Nothing -> AppState -> EventM ClickableName AppState ()
continue AppState
s
  Just (Int
_i, MainListElem {Bool
Int
String
Maybe String
Seq LogEntry
RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
Status
status :: MainListElem -> Status
label :: MainListElem -> String
depth :: MainListElem -> Int
toggled :: MainListElem -> Bool
open :: MainListElem -> Bool
logs :: MainListElem -> Seq LogEntry
visibilityLevel :: MainListElem -> Int
folderPath :: MainListElem -> Maybe String
node :: MainListElem
-> RunNodeCommonWithStatus
     (Var Status) (Var (Seq LogEntry)) (Var Bool)
ident :: MainListElem -> Int
label :: String
depth :: Int
toggled :: Bool
open :: Bool
status :: Status
logs :: Seq LogEntry
visibilityLevel :: Int
folderPath :: Maybe String
node :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
ident :: Int
..}) -> do
    IO () -> EventM ClickableName AppState ()
forall a. IO a -> EventM ClickableName AppState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> IO () -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ Var Bool -> (Bool -> Bool) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> Var Bool
forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeOpen RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
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 =
  STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ [RunNodeCommonWithStatus
   (Var Status) (Var (Seq LogEntry)) (Var Bool)]
-> (RunNodeCommonWithStatus
      (Var Status) (Var (Seq LogEntry)) (Var Bool)
    -> STM ())
-> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ((RunNode context
 -> [RunNodeCommonWithStatus
       (Var Status) (Var (Seq LogEntry)) (Var Bool)])
-> [RunNode context]
-> [RunNodeCommonWithStatus
      (Var Status) (Var (Seq LogEntry)) (Var Bool)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RunNode context
-> [RunNodeCommonWithStatus
      (Var Status) (Var (Seq LogEntry)) (Var Bool)]
forall context s l t.
RunNodeWithStatus context s l t -> [RunNodeCommonWithStatus s l t]
getCommons [RunNode context]
nodes) ((RunNodeCommonWithStatus
    (Var Status) (Var (Seq LogEntry)) (Var Bool)
  -> STM ())
 -> STM ())
-> (RunNodeCommonWithStatus
      (Var Status) (Var (Seq LogEntry)) (Var Bool)
    -> STM ())
-> STM ()
forall a b. (a -> b) -> a -> b
$ \RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
node ->
    Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> Int
forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeId RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
node) Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Seq Int -> [Int]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Int
openSet)) (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$
      Var Bool -> (Bool -> Bool) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> Var Bool
forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeOpen RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
node) (Bool -> Bool -> Bool
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 =
  STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ t MainListElem -> (MainListElem -> STM ()) -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t MainListElem
elems ((MainListElem -> STM ()) -> STM ())
-> (MainListElem -> STM ()) -> STM ()
forall a b. (a -> b) -> a -> b
$ \(MainListElem {Bool
Int
String
Maybe String
Seq LogEntry
RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
Status
status :: MainListElem -> Status
label :: MainListElem -> String
depth :: MainListElem -> Int
toggled :: MainListElem -> Bool
open :: MainListElem -> Bool
logs :: MainListElem -> Seq LogEntry
visibilityLevel :: MainListElem -> Int
folderPath :: MainListElem -> Maybe String
node :: MainListElem
-> RunNodeCommonWithStatus
     (Var Status) (Var (Seq LogEntry)) (Var Bool)
ident :: MainListElem -> Int
label :: String
depth :: Int
toggled :: Bool
open :: Bool
status :: Status
logs :: Seq LogEntry
visibilityLevel :: Int
folderPath :: Maybe String
node :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
ident :: Int
..}) ->
    if | (Int
depth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
thresh) -> Var Bool -> (Bool -> Bool) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> Var Bool
forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeOpen RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
node) (Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
True)
       | Bool
otherwise -> Var Bool -> (Bool -> Bool) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> Var Bool
forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeOpen RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
node) (Bool -> Bool -> Bool
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 = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
setInitialFolding InitialFolding
InitialFoldingAllClosed [RunNode BaseContext]
rts =
  STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ [RunNodeCommonWithStatus
   (Var Status) (Var (Seq LogEntry)) (Var Bool)]
-> (RunNodeCommonWithStatus
      (Var Status) (Var (Seq LogEntry)) (Var Bool)
    -> STM ())
-> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ((RunNode BaseContext
 -> [RunNodeCommonWithStatus
       (Var Status) (Var (Seq LogEntry)) (Var Bool)])
-> [RunNode BaseContext]
-> [RunNodeCommonWithStatus
      (Var Status) (Var (Seq LogEntry)) (Var Bool)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RunNode BaseContext
-> [RunNodeCommonWithStatus
      (Var Status) (Var (Seq LogEntry)) (Var Bool)]
forall context s l t.
RunNodeWithStatus context s l t -> [RunNodeCommonWithStatus s l t]
getCommons [RunNode BaseContext]
rts) ((RunNodeCommonWithStatus
    (Var Status) (Var (Seq LogEntry)) (Var Bool)
  -> STM ())
 -> STM ())
-> (RunNodeCommonWithStatus
      (Var Status) (Var (Seq LogEntry)) (Var Bool)
    -> STM ())
-> STM ()
forall a b. (a -> b) -> a -> b
$ \(RunNodeCommonWithStatus {Bool
Int
String
Maybe String
Maybe SrcLoc
Var Bool
Var (Seq LogEntry)
Var Status
Seq Int
runTreeVisibilityLevel :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeAncestors :: forall s l t. RunNodeCommonWithStatus s l t -> Seq Int
runTreeStatus :: forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeId :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeLoc :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe SrcLoc
runTreeFolder :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe String
runTreeToggled :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeOpen :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeLabel :: String
runTreeId :: Int
runTreeAncestors :: Seq Int
runTreeToggled :: Var Bool
runTreeOpen :: Var Bool
runTreeStatus :: Var Status
runTreeVisible :: Bool
runTreeFolder :: Maybe String
runTreeVisibilityLevel :: Int
runTreeRecordTime :: Bool
runTreeLogs :: Var (Seq LogEntry)
runTreeLoc :: Maybe SrcLoc
runTreeLabel :: forall s l t. RunNodeCommonWithStatus s l t -> String
runTreeVisible :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeRecordTime :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeLogs :: forall s l t. RunNodeCommonWithStatus s l t -> l
..}) ->
    Var Bool -> (Bool -> Bool) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar Var Bool
runTreeOpen (Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
False)
setInitialFolding (InitialFoldingTopNOpen Int
n) [RunNode BaseContext]
rts =
  STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ [RunNodeCommonWithStatus
   (Var Status) (Var (Seq LogEntry)) (Var Bool)]
-> (RunNodeCommonWithStatus
      (Var Status) (Var (Seq LogEntry)) (Var Bool)
    -> STM ())
-> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ((RunNode BaseContext
 -> [RunNodeCommonWithStatus
       (Var Status) (Var (Seq LogEntry)) (Var Bool)])
-> [RunNode BaseContext]
-> [RunNodeCommonWithStatus
      (Var Status) (Var (Seq LogEntry)) (Var Bool)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RunNode BaseContext
-> [RunNodeCommonWithStatus
      (Var Status) (Var (Seq LogEntry)) (Var Bool)]
forall context s l t.
RunNodeWithStatus context s l t -> [RunNodeCommonWithStatus s l t]
getCommons [RunNode BaseContext]
rts) ((RunNodeCommonWithStatus
    (Var Status) (Var (Seq LogEntry)) (Var Bool)
  -> STM ())
 -> STM ())
-> (RunNodeCommonWithStatus
      (Var Status) (Var (Seq LogEntry)) (Var Bool)
    -> STM ())
-> STM ()
forall a b. (a -> b) -> a -> b
$ \(RunNodeCommonWithStatus {Bool
Int
String
Maybe String
Maybe SrcLoc
Var Bool
Var (Seq LogEntry)
Var Status
Seq Int
runTreeVisibilityLevel :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeAncestors :: forall s l t. RunNodeCommonWithStatus s l t -> Seq Int
runTreeStatus :: forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeId :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeLoc :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe SrcLoc
runTreeFolder :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe String
runTreeToggled :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeOpen :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeLabel :: forall s l t. RunNodeCommonWithStatus s l t -> String
runTreeVisible :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeRecordTime :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeLogs :: forall s l t. RunNodeCommonWithStatus s l t -> l
runTreeLabel :: String
runTreeId :: Int
runTreeAncestors :: Seq Int
runTreeToggled :: Var Bool
runTreeOpen :: Var Bool
runTreeStatus :: Var Status
runTreeVisible :: Bool
runTreeFolder :: Maybe String
runTreeVisibilityLevel :: Int
runTreeRecordTime :: Bool
runTreeLogs :: Var (Seq LogEntry)
runTreeLoc :: Maybe SrcLoc
..}) ->
    Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Seq Int -> Int
forall a. Seq a -> Int
Seq.length Seq Int
runTreeAncestors Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
n) (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$
      Var Bool -> (Bool -> Bool) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar Var Bool
runTreeOpen (Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
False)

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

-- * Clearing

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

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

clearCommon :: RunNodeCommon -> IO ()
clearCommon :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> IO ()
clearCommon (RunNodeCommonWithStatus {Bool
Int
String
Maybe String
Maybe SrcLoc
Var Bool
Var (Seq LogEntry)
Var Status
Seq Int
runTreeVisibilityLevel :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeAncestors :: forall s l t. RunNodeCommonWithStatus s l t -> Seq Int
runTreeStatus :: forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeId :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeLoc :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe SrcLoc
runTreeFolder :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe String
runTreeToggled :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeOpen :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeLabel :: forall s l t. RunNodeCommonWithStatus s l t -> String
runTreeVisible :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeRecordTime :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeLogs :: forall s l t. RunNodeCommonWithStatus s l t -> l
runTreeLabel :: String
runTreeId :: Int
runTreeAncestors :: Seq Int
runTreeToggled :: Var Bool
runTreeOpen :: Var Bool
runTreeStatus :: Var Status
runTreeVisible :: Bool
runTreeFolder :: Maybe String
runTreeVisibilityLevel :: Int
runTreeRecordTime :: Bool
runTreeLogs :: Var (Seq LogEntry)
runTreeLoc :: Maybe SrcLoc
..}) = do
  STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Var Status -> Status -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar Var Status
runTreeStatus Status
NotStarted
    Var (Seq LogEntry) -> Seq LogEntry -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar Var (Seq LogEntry)
runTreeLogs Seq LogEntry
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 = [Set Int] -> Maybe (Set Int)
forall a. [a] -> Maybe a
headMay ([Set Int] -> Maybe (Set Int)) -> [Set Int] -> Maybe (Set Int)
forall a b. (a -> b) -> a -> b
$ (RunNodeFixed context -> Maybe (Set Int))
-> [RunNodeFixed context] -> [Set Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Int -> RunNodeFixed context -> Maybe (Set Int)
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RunNodeCommonWithStatus Status (Seq LogEntry) Bool -> Int
forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeId (RunNodeFixed context
-> RunNodeCommonWithStatus Status (Seq LogEntry) Bool
forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon RunNodeFixed context
node) = Set Int -> Maybe (Set Int)
forall a. a -> Maybe a
Just (Set Int -> Maybe (Set Int)) -> Set Int -> Maybe (Set Int)
forall a b. (a -> b) -> a -> b
$ [Int] -> Set Int
forall a. Ord a => [a] -> Set a
S.fromList ([Int] -> Set Int) -> [Int] -> Set Int
forall a b. (a -> b) -> a -> b
$ (forall context1.
 RunNodeWithStatus context1 Status (Seq LogEntry) Bool -> Int)
-> RunNodeFixed context -> [Int]
forall s l t a context.
(forall context1. RunNodeWithStatus context1 s l t -> a)
-> RunNodeWithStatus context s l t -> [a]
extractValues (RunNodeCommonWithStatus Status (Seq LogEntry) Bool -> Int
forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeId (RunNodeCommonWithStatus Status (Seq LogEntry) Bool -> Int)
-> (RunNodeWithStatus context1 Status (Seq LogEntry) Bool
    -> RunNodeCommonWithStatus Status (Seq LogEntry) Bool)
-> RunNodeWithStatus context1 Status (Seq LogEntry) Bool
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunNodeWithStatus context1 Status (Seq LogEntry) Bool
-> RunNodeCommonWithStatus Status (Seq LogEntry) Bool
forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon) RunNodeFixed context
node
findRunNodeChildrenById' Int
_ident (RunNodeIt {}) = Maybe (Set Int)
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 ()
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeChildrenAugmented :: [RunNodeWithStatus
   (LabelValue lab intro :> context) Status (Seq LogEntry) Bool]
runNodeAlloc :: ExampleT context IO intro
runNodeCleanup :: intro -> ExampleT context IO ()
runNodeChildrenAugmented :: ()
runNodeAlloc :: ()
runNodeCleanup :: ()
..}) = Int
-> [RunNodeWithStatus
      (LabelValue lab intro :> context) Status (Seq LogEntry) Bool]
-> Maybe (Set Int)
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 ()
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeChildrenAugmented :: ()
runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeChildrenAugmented :: [RunNodeWithStatus
   (LabelValue lab intro :> context) Status (Seq LogEntry) Bool]
runNodeIntroduceAction :: (intro -> ExampleT context IO [Result]) -> ExampleT context IO ()
runNodeIntroduceAction :: ()
..}) = Int
-> [RunNodeWithStatus
      (LabelValue lab intro :> context) Status (Seq LogEntry) Bool]
-> Maybe (Set Int)
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 = Int -> [RunNodeFixed context] -> Maybe (Set Int)
forall context. Int -> [RunNodeFixed context] -> Maybe (Set Int)
findRunNodeChildrenById Int
ident (RunNodeFixed context -> [RunNodeFixed context]
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 GenericList ClickableName Vector MainListElem
-> Maybe (Int, MainListElem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s 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) of
    Maybe (Int, MainListElem)
Nothing -> () -> EventM n AppState ()
forall a. a -> EventM n AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just (Int
_, MainListElem {Bool
Int
String
Maybe String
Seq LogEntry
RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
Status
status :: MainListElem -> Status
label :: MainListElem -> String
depth :: MainListElem -> Int
toggled :: MainListElem -> Bool
open :: MainListElem -> Bool
logs :: MainListElem -> Seq LogEntry
visibilityLevel :: MainListElem -> Int
folderPath :: MainListElem -> Maybe String
node :: MainListElem
-> RunNodeCommonWithStatus
     (Var Status) (Var (Seq LogEntry)) (Var Bool)
ident :: MainListElem -> Int
label :: String
depth :: Int
toggled :: Bool
open :: Bool
status :: Status
logs :: Seq LogEntry
visibilityLevel :: Int
folderPath :: Maybe String
node :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
ident :: Int
..}) -> do
      let scroll :: ViewportScroll ClickableName
scroll = ClickableName -> ViewportScroll ClickableName
forall n. n -> ViewportScroll n
viewportScroll (Text -> ClickableName
InnerViewport [i|viewport_#{ident}|])
      ViewportScroll ClickableName -> EventM n AppState ()
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 -> SrcLoc -> EventM n AppState SrcLoc
forall a. a -> EventM n AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return SrcLoc
loc'
    Bool
True -> do
      case Options -> Maybe String
optionsProjectRoot (BaseContext -> Options
baseContextOptions (AppState
s AppState -> Getting BaseContext AppState BaseContext -> BaseContext
forall s a. s -> Getting a s a -> a
^. Getting BaseContext AppState BaseContext
Lens' AppState BaseContext
appBaseContext)) of
        Just String
d -> SrcLoc -> EventM n AppState SrcLoc
forall a. a -> EventM n AppState a
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcLoc -> EventM n AppState SrcLoc)
-> SrcLoc -> EventM n AppState SrcLoc
forall a b. (a -> b) -> a -> b
$ SrcLoc
loc' { srcLocFile = d </> (srcLocFile loc') }
        Maybe String
Nothing -> SrcLoc -> EventM n AppState SrcLoc
forall a. a -> EventM n AppState a
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?
  IO AppState -> EventM n AppState ()
forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume (((AppState
s AppState
-> Getting (SrcLoc -> IO ()) AppState (SrcLoc -> IO ())
-> SrcLoc
-> IO ()
forall s a. s -> Getting a s a -> a
^. Getting (SrcLoc -> IO ()) AppState (SrcLoc -> IO ())
Lens' AppState (SrcLoc -> IO ())
appOpenInEditor) SrcLoc
loc) IO () -> IO AppState -> IO AppState
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AppState -> IO AppState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AppState
s)