{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ViewPatterns #-}

module Test.Sandwich.Formatters.TerminalUI (
  defaultTerminalUIFormatter
  , terminalUIVisibilityThreshold
  , terminalUIShowRunTimes
  , terminalUIShowVisibilityThresholds
  , terminalUILogLevel
  , terminalUIInitialFolding
  , terminalUIDefaultEditor
  , terminalUIOpenInEditor
  , InitialFolding(..)
  , TerminalUIFormatter
  ) 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
import Data.Foldable
import qualified Data.List as L
import Data.Maybe
import qualified Data.Sequence as Seq
import qualified Data.Set as S
import Data.String.Interpolate
import Data.Time
import qualified Data.Vector as Vec
import GHC.Stack
import qualified Graphics.Vty as V
import Lens.Micro
import Safe
import System.FilePath
import Test.Sandwich.Formatters.TerminalUI.AttrMap
import Test.Sandwich.Formatters.TerminalUI.CrossPlatform
import Test.Sandwich.Formatters.TerminalUI.Draw
import Test.Sandwich.Formatters.TerminalUI.Filter
import Test.Sandwich.Formatters.TerminalUI.Keys
import Test.Sandwich.Formatters.TerminalUI.Types
import Test.Sandwich.Interpreters.RunTree.Util
import Test.Sandwich.Interpreters.StartTree
import Test.Sandwich.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 :: TerminalUIFormatter
-> [RunNode BaseContext]
-> Maybe (CommandLineOptions ())
-> BaseContext
-> m ()
runFormatter = TerminalUIFormatter
-> [RunNode BaseContext]
-> Maybe (CommandLineOptions ())
-> BaseContext
-> m ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadUnliftIO m) =>
TerminalUIFormatter
-> [RunNode BaseContext]
-> Maybe (CommandLineOptions ())
-> BaseContext
-> m ()
runApp
  finalizeFormatter :: TerminalUIFormatter -> [RunNode BaseContext] -> BaseContext -> m ()
finalizeFormatter TerminalUIFormatter
_ [RunNode BaseContext]
_ BaseContext
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

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

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

  let initialState :: AppState
initialState = AppState -> AppState
updateFilteredTree (AppState -> AppState) -> AppState -> AppState
forall a b. (a -> b) -> a -> b
$
        AppState :: [RunNode BaseContext]
-> [RunNodeFixed BaseContext]
-> List ClickableName MainListElem
-> BaseContext
-> UTCTime
-> NominalDiffTime
-> [Int]
-> Int
-> Maybe LogLevel
-> Bool
-> Bool
-> Bool
-> (SrcLoc -> IO ())
-> (Text -> IO ())
-> AppState
AppState {
          _appRunTreeBase :: [RunNode BaseContext]
_appRunTreeBase = [RunNode BaseContext]
rts
          , _appRunTree :: [RunNodeFixed BaseContext]
_appRunTree = [RunNodeFixed BaseContext]
rtsFixed
          , _appMainList :: List ClickableName MainListElem
_appMainList = ClickableName
-> Vector MainListElem -> Int -> List ClickableName 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
          , _appTimeSinceStart :: NominalDiffTime
_appTimeSinceStart = NominalDiffTime
0

          , _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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return ())
        }

  BChan AppEvent
eventChan <- Int -> IO (BChan AppEvent)
forall a. Int -> IO (BChan a)
newBChan Int
10

  TVar [RunNodeFixed BaseContext]
currentFixedTree <- [RunNodeFixed BaseContext] -> IO (TVar [RunNodeFixed BaseContext])
forall a. a -> IO (TVar a)
newTVarIO [RunNodeFixed BaseContext]
rtsFixed
  Async Any
eventAsync <- 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
    [RunNodeFixed BaseContext]
newFixedTree <- STM [RunNodeFixed BaseContext] -> IO [RunNodeFixed BaseContext]
forall a. STM a -> IO a
atomically (STM [RunNodeFixed BaseContext] -> IO [RunNodeFixed BaseContext])
-> STM [RunNodeFixed BaseContext] -> IO [RunNodeFixed BaseContext]
forall a b. (a -> b) -> a -> b
$ do
      [RunNodeFixed BaseContext]
currentFixed <- TVar [RunNodeFixed BaseContext] -> STM [RunNodeFixed BaseContext]
forall a. TVar a -> STM a
readTVar TVar [RunNodeFixed BaseContext]
currentFixedTree
      [RunNodeFixed BaseContext]
newFixed <- (RunNode BaseContext -> STM (RunNodeFixed BaseContext))
-> [RunNode BaseContext] -> STM [RunNodeFixed BaseContext]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RunNode BaseContext -> STM (RunNodeFixed BaseContext)
forall context. RunNode context -> STM (RunNodeFixed context)
fixRunTree [RunNode BaseContext]
rts
      Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((RunNodeFixed BaseContext
 -> [RunNodeCommonWithStatus Status (Seq LogEntry) Bool])
-> [RunNodeFixed BaseContext]
-> [[RunNodeCommonWithStatus Status (Seq LogEntry) Bool]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RunNodeFixed BaseContext
-> [RunNodeCommonWithStatus Status (Seq LogEntry) Bool]
forall context s l t.
RunNodeWithStatus context s l t -> [RunNodeCommonWithStatus s l t]
getCommons [RunNodeFixed BaseContext]
newFixed [[RunNodeCommonWithStatus Status (Seq LogEntry) Bool]]
-> [[RunNodeCommonWithStatus Status (Seq LogEntry) Bool]] -> Bool
forall a. Eq a => a -> a -> Bool
== (RunNodeFixed BaseContext
 -> [RunNodeCommonWithStatus Status (Seq LogEntry) Bool])
-> [RunNodeFixed BaseContext]
-> [[RunNodeCommonWithStatus Status (Seq LogEntry) Bool]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RunNodeFixed BaseContext
-> [RunNodeCommonWithStatus Status (Seq LogEntry) Bool]
forall context s l t.
RunNodeWithStatus context s l t -> [RunNodeCommonWithStatus s l t]
getCommons [RunNodeFixed BaseContext]
currentFixed) STM ()
forall a. STM a
retry
      TVar [RunNodeFixed BaseContext]
-> [RunNodeFixed BaseContext] -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar [RunNodeFixed BaseContext]
currentFixedTree [RunNodeFixed BaseContext]
newFixed
      [RunNodeFixed BaseContext] -> STM [RunNodeFixed BaseContext]
forall (m :: * -> *) a. Monad m => a -> m a
return [RunNodeFixed BaseContext]
newFixed
    BChan AppEvent -> AppEvent -> IO ()
forall a. BChan a -> a -> IO ()
writeBChan BChan AppEvent
eventChan ([RunNodeFixed BaseContext] -> AppEvent
RunTreeUpdated [RunNodeFixed BaseContext]
newFixedTree)
    Int -> IO ()
threadDelay Int
terminalUIRefreshPeriod

  let buildVty :: IO Vty
buildVty = do
        Vty
v <- Config -> IO Vty
V.mkVty Config
V.defaultConfig
        let output :: Output
output = Vty -> Output
V.outputIface Vty
v
        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 (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 (m :: * -> *) a. Monad m => a -> m a
return Vty
v
  Vty
initialVty <- IO Vty
buildVty
  (IO () -> IO () -> IO ()) -> IO () -> IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO () -> IO () -> IO ()
forall (m :: * -> *) a b. 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 :: forall s e n.
(s -> [Widget n])
-> (s -> [CursorLocation n] -> Maybe (CursorLocation n))
-> (s -> BrickEvent n e -> EventM n (Next s))
-> (s -> EventM n s)
-> (s -> AttrMap)
-> App s e n
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
  , appHandleEvent :: AppState
-> BrickEvent ClickableName AppEvent
-> EventM ClickableName (Next AppState)
appHandleEvent = AppState
-> BrickEvent ClickableName AppEvent
-> EventM ClickableName (Next AppState)
appEvent
  , appStartEvent :: AppState -> EventM ClickableName AppState
appStartEvent = AppState -> EventM ClickableName AppState
forall (m :: * -> *) a. Monad m => a -> m a
return
  , appAttrMap :: AppState -> AttrMap
appAttrMap = AttrMap -> AppState -> AttrMap
forall a b. a -> b -> a
const AttrMap
mainAttrMap
  }

appEvent :: AppState -> BrickEvent ClickableName AppEvent -> EventM ClickableName (Next AppState)
appEvent :: AppState
-> BrickEvent ClickableName AppEvent
-> EventM ClickableName (Next AppState)
appEvent AppState
s (AppEvent (RunTreeUpdated [RunNodeFixed BaseContext]
newTree)) = do
  UTCTime
now <- IO UTCTime -> EventM ClickableName UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  AppState -> EventM ClickableName (Next AppState)
forall s n. s -> EventM n (Next s)
continue (AppState -> EventM ClickableName (Next AppState))
-> AppState -> EventM ClickableName (Next AppState)
forall a b. (a -> b) -> a -> b
$ AppState
s
    AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& ([RunNodeFixed BaseContext] -> Identity [RunNodeFixed BaseContext])
-> AppState -> Identity AppState
Lens' AppState [RunNodeFixed BaseContext]
appRunTree (([RunNodeFixed BaseContext]
  -> Identity [RunNodeFixed BaseContext])
 -> AppState -> Identity AppState)
-> [RunNodeFixed BaseContext] -> AppState -> AppState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [RunNodeFixed BaseContext]
newTree
    AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (NominalDiffTime -> Identity NominalDiffTime)
-> AppState -> Identity AppState
Lens' AppState NominalDiffTime
appTimeSinceStart ((NominalDiffTime -> Identity NominalDiffTime)
 -> AppState -> Identity AppState)
-> NominalDiffTime -> AppState -> AppState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
now (AppState
s AppState -> Getting UTCTime AppState UTCTime -> UTCTime
forall s a. s -> Getting a s a -> a
^. Getting UTCTime AppState UTCTime
Lens' AppState UTCTime
appStartTime))
    AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& AppState -> AppState
updateFilteredTree

appEvent AppState
s (MouseDown ClickableName
ColorBar Button
_ [Modifier]
_ (B.Location (Int
x, Int
_))) = do
  ClickableName
-> EventM ClickableName (Maybe (Extent ClickableName))
forall n. Eq n => n -> EventM n (Maybe (Extent n))
lookupExtent ClickableName
ColorBar EventM ClickableName (Maybe (Extent ClickableName))
-> (Maybe (Extent ClickableName)
    -> EventM ClickableName (Next AppState))
-> EventM ClickableName (Next AppState)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Extent ClickableName)
Nothing -> AppState -> EventM ClickableName (Next AppState)
forall s n. s -> EventM n (Next s)
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 = (RunNodeFixed BaseContext
 -> [RunNodeCommonWithStatus Status (Seq LogEntry) Bool])
-> [RunNodeFixed BaseContext]
-> [RunNodeCommonWithStatus Status (Seq LogEntry) Bool]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RunNodeFixed BaseContext
-> [RunNodeCommonWithStatus Status (Seq LogEntry) Bool]
forall context s l t.
RunNodeWithStatus context s l t -> [RunNodeCommonWithStatus s l t]
getCommons ([RunNodeFixed BaseContext]
 -> [RunNodeCommonWithStatus Status (Seq LogEntry) Bool])
-> [RunNodeFixed BaseContext]
-> [RunNodeCommonWithStatus Status (Seq LogEntry) Bool]
forall a b. (a -> b) -> a -> b
$ AppState
s AppState
-> Getting
     [RunNodeFixed BaseContext] AppState [RunNodeFixed BaseContext]
-> [RunNodeFixed BaseContext]
forall s a. s -> Getting a s a -> a
^. Getting
  [RunNodeFixed BaseContext] AppState [RunNodeFixed BaseContext]
Lens' AppState [RunNodeFixed BaseContext]
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 (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 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 (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 ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName ())
-> IO () -> EventM ClickableName ()
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. [a] -> Int -> a
!! Int
index)
      AppState -> EventM ClickableName (Next AppState)
forall s n. s -> EventM n (Next s)
continue (AppState -> EventM ClickableName (Next AppState))
-> AppState -> EventM ClickableName (Next AppState)
forall a b. (a -> b) -> a -> b
$ AppState
s
        AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (List ClickableName MainListElem
 -> Identity (List ClickableName MainListElem))
-> AppState -> Identity AppState
Lens' AppState (List ClickableName MainListElem)
appMainList ((List ClickableName MainListElem
  -> Identity (List ClickableName MainListElem))
 -> AppState -> Identity AppState)
-> (List ClickableName MainListElem
    -> List ClickableName MainListElem)
-> AppState
-> AppState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int
-> List ClickableName MainListElem
-> List ClickableName 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 -> Int -> EventM ClickableName ()
forall n. ViewportScroll n -> Int -> EventM n ()
vScrollBy (ClickableName -> ViewportScroll ClickableName
forall n. n -> ViewportScroll n
viewportScroll ClickableName
MainList) (-Int
1)
  AppState -> EventM ClickableName (Next AppState)
forall s n. s -> EventM n (Next s)
continue AppState
s
appEvent AppState
s (MouseDown (ListRow Int
_i) Button
V.BScrollDown [Modifier]
_ Location
_) = do
  ViewportScroll ClickableName -> Int -> EventM ClickableName ()
forall n. ViewportScroll n -> Int -> EventM n ()
vScrollBy (ClickableName -> ViewportScroll ClickableName
forall n. n -> ViewportScroll n
viewportScroll ClickableName
MainList) Int
1
  AppState -> EventM ClickableName (Next AppState)
forall s n. s -> EventM n (Next s)
continue AppState
s
appEvent AppState
s (MouseDown (ListRow Int
i) Button
V.BLeft [Modifier]
_ Location
_) = do
  AppState -> EventM ClickableName (Next AppState)
forall s n. s -> EventM n (Next s)
continue (AppState
s AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (List ClickableName MainListElem
 -> Identity (List ClickableName MainListElem))
-> AppState -> Identity AppState
Lens' AppState (List ClickableName MainListElem)
appMainList ((List ClickableName MainListElem
  -> Identity (List ClickableName MainListElem))
 -> AppState -> Identity AppState)
-> (List ClickableName MainListElem
    -> List ClickableName MainListElem)
-> AppState
-> AppState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int
-> List ClickableName MainListElem
-> List ClickableName 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 (Next AppState)
forall s n. s -> EventM n (Next s)
continue (AppState
s AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (List ClickableName MainListElem
 -> Identity (List ClickableName MainListElem))
-> AppState -> Identity AppState
Lens' AppState (List ClickableName MainListElem)
appMainList ((List ClickableName MainListElem
  -> Identity (List ClickableName MainListElem))
 -> AppState -> Identity AppState)
-> (List ClickableName MainListElem
    -> List ClickableName MainListElem)
-> AppState
-> AppState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int
-> List ClickableName MainListElem
-> List ClickableName 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 (Next AppState)
forall s n. s -> EventM n (Next s)
continue (AppState
s AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (List ClickableName MainListElem
 -> Identity (List ClickableName MainListElem))
-> AppState -> Identity AppState
Lens' AppState (List ClickableName MainListElem)
appMainList ((List ClickableName MainListElem
  -> Identity (List ClickableName MainListElem))
 -> AppState -> Identity AppState)
-> (List ClickableName MainListElem
    -> List ClickableName MainListElem)
-> AppState
-> AppState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int
-> List ClickableName MainListElem
-> List ClickableName 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
$ List ClickableName MainListElem -> Vector MainListElem
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements (AppState
s AppState
-> Getting
     (List ClickableName MainListElem)
     AppState
     (List ClickableName MainListElem)
-> List ClickableName MainListElem
forall s a. s -> Getting a s a -> a
^. Getting
  (List ClickableName MainListElem)
  AppState
  (List ClickableName MainListElem)
Lens' AppState (List ClickableName MainListElem)
appMainList)
      let listToSearch :: [(Int, MainListElem)]
listToSearch = case List ClickableName MainListElem -> Maybe (Int, MainListElem)
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s AppState
-> Getting
     (List ClickableName MainListElem)
     AppState
     (List ClickableName MainListElem)
-> List ClickableName MainListElem
forall s a. s -> Getting a s a -> a
^. Getting
  (List ClickableName MainListElem)
  AppState
  (List ClickableName MainListElem)
Lens' AppState (List ClickableName 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 (Next AppState)
forall s n. s -> EventM n (Next s)
continue AppState
s
        Just (Int
i', MainListElem
_) -> AppState -> EventM ClickableName (Next AppState)
forall s n. s -> EventM n (Next s)
continue (AppState
s AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (List ClickableName MainListElem
 -> Identity (List ClickableName MainListElem))
-> AppState -> Identity AppState
Lens' AppState (List ClickableName MainListElem)
appMainList ((List ClickableName MainListElem
  -> Identity (List ClickableName MainListElem))
 -> AppState -> Identity AppState)
-> (List ClickableName MainListElem
    -> List ClickableName MainListElem)
-> AppState
-> AppState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int
-> List ClickableName MainListElem
-> List ClickableName 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
$ List ClickableName MainListElem -> Vector MainListElem
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements (AppState
s AppState
-> Getting
     (List ClickableName MainListElem)
     AppState
     (List ClickableName MainListElem)
-> List ClickableName MainListElem
forall s a. s -> Getting a s a -> a
^. Getting
  (List ClickableName MainListElem)
  AppState
  (List ClickableName MainListElem)
Lens' AppState (List ClickableName MainListElem)
appMainList)
      let listToSearch :: [(Int, MainListElem)]
listToSearch = case List ClickableName MainListElem -> Maybe (Int, MainListElem)
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s AppState
-> Getting
     (List ClickableName MainListElem)
     AppState
     (List ClickableName MainListElem)
-> List ClickableName MainListElem
forall s a. s -> Getting a s a -> a
^. Getting
  (List ClickableName MainListElem)
  AppState
  (List ClickableName MainListElem)
Lens' AppState (List ClickableName 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 (Next AppState)
forall s n. s -> EventM n (Next s)
continue AppState
s
        Just (Int
i', MainListElem
_) -> AppState -> EventM ClickableName (Next AppState)
forall s n. s -> EventM n (Next s)
continue (AppState
s AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (List ClickableName MainListElem
 -> Identity (List ClickableName MainListElem))
-> AppState -> Identity AppState
Lens' AppState (List ClickableName MainListElem)
appMainList ((List ClickableName MainListElem
  -> Identity (List ClickableName MainListElem))
 -> AppState -> Identity AppState)
-> (List ClickableName MainListElem
    -> List ClickableName MainListElem)
-> AppState
-> AppState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int
-> List ClickableName MainListElem
-> List ClickableName 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 (Next AppState)
forall n. AppState -> (Bool -> Bool) -> EventM n (Next 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 (Next AppState)
forall n. AppState -> (Bool -> Bool) -> EventM n (Next 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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Char -> Key) -> String -> [Key]
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 ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName ())
-> IO () -> EventM ClickableName ()
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
^. ((List ClickableName MainListElem
 -> Const (Vector MainListElem) (List ClickableName MainListElem))
-> AppState -> Const (Vector MainListElem) AppState
Lens' AppState (List ClickableName MainListElem)
appMainList ((List ClickableName MainListElem
  -> Const (Vector MainListElem) (List ClickableName MainListElem))
 -> AppState -> Const (Vector MainListElem) AppState)
-> ((Vector MainListElem
     -> Const (Vector MainListElem) (Vector MainListElem))
    -> List ClickableName MainListElem
    -> Const (Vector MainListElem) (List ClickableName MainListElem))
-> Getting (Vector MainListElem) AppState (Vector MainListElem)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector MainListElem
 -> Const (Vector MainListElem) (Vector MainListElem))
-> List ClickableName MainListElem
-> Const (Vector MainListElem) (List ClickableName MainListElem)
forall n (t1 :: * -> *) e1 (t2 :: * -> *) e2.
Lens (GenericList n t1 e1) (GenericList n t2 e2) (t1 e1) (t2 e2)
listElementsL)) Int
num
      AppState -> EventM ClickableName (Next AppState)
forall s n. s -> EventM n (Next s)
continue AppState
s
    V.EvKey Key
c [] | Key
c Key -> [Key] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key]
toggleKeys -> AppState -> (Bool -> Bool) -> EventM ClickableName (Next AppState)
forall n. AppState -> (Bool -> Bool) -> EventM n (Next 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
-> (ViewportScroll ClickableName -> EventM ClickableName ())
-> EventM ClickableName (Next AppState)
forall n.
AppState
-> (ViewportScroll ClickableName -> EventM n ())
-> EventM n (Next AppState)
withScroll AppState
s ((ViewportScroll ClickableName -> EventM ClickableName ())
 -> EventM ClickableName (Next AppState))
-> (ViewportScroll ClickableName -> EventM ClickableName ())
-> EventM ClickableName (Next AppState)
forall a b. (a -> b) -> a -> b
$ (ViewportScroll ClickableName -> Int -> EventM ClickableName ())
-> Int -> ViewportScroll ClickableName -> EventM ClickableName ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ViewportScroll ClickableName -> Int -> EventM ClickableName ()
forall n. ViewportScroll n -> Int -> EventM n ()
vScrollBy (-Int
1)
    V.EvKey (V.KChar Char
'p') [Modifier
V.MCtrl] -> AppState
-> (ViewportScroll ClickableName -> EventM ClickableName ())
-> EventM ClickableName (Next AppState)
forall n.
AppState
-> (ViewportScroll ClickableName -> EventM n ())
-> EventM n (Next AppState)
withScroll AppState
s ((ViewportScroll ClickableName -> EventM ClickableName ())
 -> EventM ClickableName (Next AppState))
-> (ViewportScroll ClickableName -> EventM ClickableName ())
-> EventM ClickableName (Next AppState)
forall a b. (a -> b) -> a -> b
$ (ViewportScroll ClickableName -> Int -> EventM ClickableName ())
-> Int -> ViewportScroll ClickableName -> EventM ClickableName ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ViewportScroll ClickableName -> Int -> EventM ClickableName ()
forall n. ViewportScroll n -> Int -> EventM n ()
vScrollBy (-Int
1)
    V.EvKey Key
V.KDown [Modifier
V.MCtrl] -> AppState
-> (ViewportScroll ClickableName -> EventM ClickableName ())
-> EventM ClickableName (Next AppState)
forall n.
AppState
-> (ViewportScroll ClickableName -> EventM n ())
-> EventM n (Next AppState)
withScroll AppState
s ((ViewportScroll ClickableName -> EventM ClickableName ())
 -> EventM ClickableName (Next AppState))
-> (ViewportScroll ClickableName -> EventM ClickableName ())
-> EventM ClickableName (Next AppState)
forall a b. (a -> b) -> a -> b
$ (ViewportScroll ClickableName -> Int -> EventM ClickableName ())
-> Int -> ViewportScroll ClickableName -> EventM ClickableName ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ViewportScroll ClickableName -> Int -> EventM ClickableName ()
forall n. ViewportScroll n -> Int -> EventM n ()
vScrollBy Int
1
    V.EvKey (V.KChar Char
'n') [Modifier
V.MCtrl] -> AppState
-> (ViewportScroll ClickableName -> EventM ClickableName ())
-> EventM ClickableName (Next AppState)
forall n.
AppState
-> (ViewportScroll ClickableName -> EventM n ())
-> EventM n (Next AppState)
withScroll AppState
s ((ViewportScroll ClickableName -> EventM ClickableName ())
 -> EventM ClickableName (Next AppState))
-> (ViewportScroll ClickableName -> EventM ClickableName ())
-> EventM ClickableName (Next AppState)
forall a b. (a -> b) -> a -> b
$ (ViewportScroll ClickableName -> Int -> EventM ClickableName ())
-> Int -> ViewportScroll ClickableName -> EventM ClickableName ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ViewportScroll ClickableName -> Int -> EventM ClickableName ()
forall n. ViewportScroll n -> Int -> EventM n ()
vScrollBy Int
1
    V.EvKey (V.KChar Char
'v') [Modifier
V.MMeta] -> AppState
-> (ViewportScroll ClickableName -> EventM ClickableName ())
-> EventM ClickableName (Next AppState)
forall n.
AppState
-> (ViewportScroll ClickableName -> EventM n ())
-> EventM n (Next AppState)
withScroll AppState
s ((ViewportScroll ClickableName -> EventM ClickableName ())
 -> EventM ClickableName (Next AppState))
-> (ViewportScroll ClickableName -> EventM ClickableName ())
-> EventM ClickableName (Next AppState)
forall a b. (a -> b) -> a -> b
$ (ViewportScroll ClickableName
 -> Direction -> EventM ClickableName ())
-> Direction
-> ViewportScroll ClickableName
-> EventM ClickableName ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ViewportScroll ClickableName
-> Direction -> EventM ClickableName ()
forall n. ViewportScroll n -> Direction -> EventM n ()
vScrollPage Direction
Up
    V.EvKey (V.KChar Char
'v') [Modifier
V.MCtrl] -> AppState
-> (ViewportScroll ClickableName -> EventM ClickableName ())
-> EventM ClickableName (Next AppState)
forall n.
AppState
-> (ViewportScroll ClickableName -> EventM n ())
-> EventM n (Next AppState)
withScroll AppState
s ((ViewportScroll ClickableName -> EventM ClickableName ())
 -> EventM ClickableName (Next AppState))
-> (ViewportScroll ClickableName -> EventM ClickableName ())
-> EventM ClickableName (Next AppState)
forall a b. (a -> b) -> a -> b
$ (ViewportScroll ClickableName
 -> Direction -> EventM ClickableName ())
-> Direction
-> ViewportScroll ClickableName
-> EventM ClickableName ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ViewportScroll ClickableName
-> Direction -> EventM ClickableName ()
forall n. ViewportScroll n -> Direction -> EventM n ()
vScrollPage Direction
Down
    V.EvKey Key
V.KHome [Modifier
V.MCtrl] -> AppState
-> (ViewportScroll ClickableName -> EventM ClickableName ())
-> EventM ClickableName (Next AppState)
forall n.
AppState
-> (ViewportScroll ClickableName -> EventM n ())
-> EventM n (Next AppState)
withScroll AppState
s ViewportScroll ClickableName -> EventM ClickableName ()
forall n. ViewportScroll n -> EventM n ()
vScrollToBeginning
    V.EvKey Key
V.KEnd [Modifier
V.MCtrl] -> AppState
-> (ViewportScroll ClickableName -> EventM ClickableName ())
-> EventM ClickableName (Next AppState)
forall n.
AppState
-> (ViewportScroll ClickableName -> EventM n ())
-> EventM n (Next AppState)
withScroll AppState
s ViewportScroll ClickableName -> EventM ClickableName ()
forall n. ViewportScroll n -> EventM n ()
vScrollToEnd

    -- Column 2
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
cancelAllKey -> do
      IO () -> EventM ClickableName ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName ())
-> IO () -> EventM ClickableName ()
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 (Next AppState)
forall s n. s -> EventM n (Next s)
continue AppState
s
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
cancelSelectedKey -> EventM ClickableName () -> EventM ClickableName (Next AppState)
forall n a. EventM n a -> EventM n (Next AppState)
withContinueS (EventM ClickableName () -> EventM ClickableName (Next AppState))
-> EventM ClickableName () -> EventM ClickableName (Next AppState)
forall a b. (a -> b) -> a -> b
$ do
      Maybe (Int, MainListElem)
-> ((Int, MainListElem) -> EventM ClickableName ())
-> EventM ClickableName ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust (List ClickableName MainListElem -> Maybe (Int, MainListElem)
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s AppState
-> Getting
     (List ClickableName MainListElem)
     AppState
     (List ClickableName MainListElem)
-> List ClickableName MainListElem
forall s a. s -> Getting a s a -> a
^. Getting
  (List ClickableName MainListElem)
  AppState
  (List ClickableName MainListElem)
Lens' AppState (List ClickableName MainListElem)
appMainList)) (((Int, MainListElem) -> EventM ClickableName ())
 -> EventM ClickableName ())
-> ((Int, MainListElem) -> EventM ClickableName ())
-> EventM ClickableName ()
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
ident :: MainListElem -> Int
node :: MainListElem
-> RunNodeCommonWithStatus
     (Var Status) (Var (Seq LogEntry)) (Var Bool)
folderPath :: MainListElem -> Maybe String
visibilityLevel :: MainListElem -> Int
logs :: MainListElem -> Seq LogEntry
open :: MainListElem -> Bool
toggled :: MainListElem -> Bool
depth :: MainListElem -> Int
label :: MainListElem -> String
ident :: Int
node :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
folderPath :: Maybe String
visibilityLevel :: Int
logs :: Seq LogEntry
status :: Status
open :: Bool
toggled :: Bool
depth :: Int
label :: String
status :: MainListElem -> Status
..}) -> IO () -> EventM ClickableName ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName ())
-> IO () -> EventM ClickableName ()
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Running {UTCTime
Async Result
statusAsync :: Status -> Async Result
statusStartTime :: Status -> UTCTime
statusAsync :: Async Result
statusStartTime :: UTCTime
..} -> Async Result -> IO ()
forall a. Async a -> IO ()
cancel Async Result
statusAsync
          Status
_ -> () -> IO ()
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 -> EventM ClickableName () -> EventM ClickableName (Next AppState)
forall n a. EventM n a -> EventM n (Next AppState)
withContinueS (EventM ClickableName () -> EventM ClickableName (Next AppState))
-> EventM ClickableName () -> EventM ClickableName (Next AppState)
forall a b. (a -> b) -> a -> b
$ do
      Bool -> EventM ClickableName () -> EventM ClickableName ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((RunNodeFixed BaseContext -> Bool)
-> [RunNodeFixed BaseContext] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool)
-> (RunNodeFixed BaseContext -> Bool)
-> RunNodeFixed BaseContext
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Bool
isRunning (Status -> Bool)
-> (RunNodeFixed BaseContext -> Status)
-> RunNodeFixed BaseContext
-> 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)
-> (RunNodeFixed BaseContext
    -> RunNodeCommonWithStatus Status (Seq LogEntry) Bool)
-> RunNodeFixed BaseContext
-> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunNodeFixed BaseContext
-> RunNodeCommonWithStatus Status (Seq LogEntry) Bool
forall context s l t.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon) (AppState
s AppState
-> Getting
     [RunNodeFixed BaseContext] AppState [RunNodeFixed BaseContext]
-> [RunNodeFixed BaseContext]
forall s a. s -> Getting a s a -> a
^. Getting
  [RunNodeFixed BaseContext] AppState [RunNodeFixed BaseContext]
Lens' AppState [RunNodeFixed BaseContext]
appRunTree)) (EventM ClickableName () -> EventM ClickableName ())
-> EventM ClickableName () -> EventM ClickableName ()
forall a b. (a -> b) -> a -> b
$ IO () -> EventM ClickableName ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName ())
-> IO () -> EventM ClickableName ()
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)
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
runSelectedKey -> EventM ClickableName () -> EventM ClickableName (Next AppState)
forall n a. EventM n a -> EventM n (Next AppState)
withContinueS (EventM ClickableName () -> EventM ClickableName (Next AppState))
-> EventM ClickableName () -> EventM ClickableName (Next AppState)
forall a b. (a -> b) -> a -> b
$
      Maybe (Int, MainListElem)
-> ((Int, MainListElem) -> EventM ClickableName ())
-> EventM ClickableName ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust (List ClickableName MainListElem -> Maybe (Int, MainListElem)
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s AppState
-> Getting
     (List ClickableName MainListElem)
     AppState
     (List ClickableName MainListElem)
-> List ClickableName MainListElem
forall s a. s -> Getting a s a -> a
^. Getting
  (List ClickableName MainListElem)
  AppState
  (List ClickableName MainListElem)
Lens' AppState (List ClickableName MainListElem)
appMainList)) (((Int, MainListElem) -> EventM ClickableName ())
 -> EventM ClickableName ())
-> ((Int, MainListElem) -> EventM ClickableName ())
-> EventM ClickableName ()
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
ident :: Int
node :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
folderPath :: Maybe String
visibilityLevel :: Int
logs :: Seq LogEntry
status :: Status
open :: Bool
toggled :: Bool
depth :: Int
label :: String
ident :: MainListElem -> Int
node :: MainListElem
-> RunNodeCommonWithStatus
     (Var Status) (Var (Seq LogEntry)) (Var Bool)
folderPath :: MainListElem -> Maybe String
visibilityLevel :: MainListElem -> Int
logs :: MainListElem -> Seq LogEntry
open :: MainListElem -> Bool
toggled :: MainListElem -> Bool
depth :: MainListElem -> Int
label :: MainListElem -> String
status :: MainListElem -> Status
..}) -> case Status
status of
        Running {} -> () -> EventM ClickableName ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Status
_ -> do
          -- Get the set of IDs for only this node's ancestors and children
          let ancestorIds :: Set Int
ancestorIds = [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 (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 -> [RunNodeFixed BaseContext] -> Maybe (Set Int)
forall context. Int -> [RunNodeFixed context] -> Maybe (Set Int)
findRunNodeChildrenById Int
ident (AppState
s AppState
-> Getting
     [RunNodeFixed BaseContext] AppState [RunNodeFixed BaseContext]
-> [RunNodeFixed BaseContext]
forall s a. s -> Getting a s a -> a
^. Getting
  [RunNodeFixed BaseContext] AppState [RunNodeFixed BaseContext]
Lens' AppState [RunNodeFixed BaseContext]
appRunTree) of
            Maybe (Set Int)
Nothing -> () -> EventM ClickableName ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            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 ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName ())
-> IO () -> EventM ClickableName ()
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
              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 :: Maybe (Set Int)
baseContextOnlyRunIds = Set Int -> Maybe (Set Int)
forall a. a -> Maybe a
Just Set Int
allIds }
              EventM ClickableName (Async ()) -> EventM ClickableName ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (EventM ClickableName (Async ()) -> EventM ClickableName ())
-> EventM ClickableName (Async ()) -> EventM ClickableName ()
forall a b. (a -> b) -> a -> b
$ IO (Async ()) -> EventM ClickableName (Async ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Async ()) -> EventM ClickableName (Async ()))
-> IO (Async ()) -> EventM ClickableName (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
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
clearSelectedKey -> EventM ClickableName () -> EventM ClickableName (Next AppState)
forall n a. EventM n a -> EventM n (Next AppState)
withContinueS (EventM ClickableName () -> EventM ClickableName (Next AppState))
-> EventM ClickableName () -> EventM ClickableName (Next AppState)
forall a b. (a -> b) -> a -> b
$ do
      Maybe (Int, MainListElem)
-> ((Int, MainListElem) -> EventM ClickableName ())
-> EventM ClickableName ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust (List ClickableName MainListElem -> Maybe (Int, MainListElem)
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s AppState
-> Getting
     (List ClickableName MainListElem)
     AppState
     (List ClickableName MainListElem)
-> List ClickableName MainListElem
forall s a. s -> Getting a s a -> a
^. Getting
  (List ClickableName MainListElem)
  AppState
  (List ClickableName MainListElem)
Lens' AppState (List ClickableName MainListElem)
appMainList)) (((Int, MainListElem) -> EventM ClickableName ())
 -> EventM ClickableName ())
-> ((Int, MainListElem) -> EventM ClickableName ())
-> EventM ClickableName ()
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
ident :: Int
node :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
folderPath :: Maybe String
visibilityLevel :: Int
logs :: Seq LogEntry
status :: Status
open :: Bool
toggled :: Bool
depth :: Int
label :: String
ident :: MainListElem -> Int
node :: MainListElem
-> RunNodeCommonWithStatus
     (Var Status) (Var (Seq LogEntry)) (Var Bool)
folderPath :: MainListElem -> Maybe String
visibilityLevel :: MainListElem -> Int
logs :: MainListElem -> Seq LogEntry
open :: MainListElem -> Bool
toggled :: MainListElem -> Bool
depth :: MainListElem -> Int
label :: MainListElem -> String
status :: MainListElem -> Status
..}) -> case Status
status of
        Running {} -> () -> EventM ClickableName ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Status
_ -> case Int -> [RunNodeFixed BaseContext] -> Maybe (Set Int)
forall context. Int -> [RunNodeFixed context] -> Maybe (Set Int)
findRunNodeChildrenById Int
ident (AppState
s AppState
-> Getting
     [RunNodeFixed BaseContext] AppState [RunNodeFixed BaseContext]
-> [RunNodeFixed BaseContext]
forall s a. s -> Getting a s a -> a
^. Getting
  [RunNodeFixed BaseContext] AppState [RunNodeFixed BaseContext]
Lens' AppState [RunNodeFixed BaseContext]
appRunTree) of
          Maybe (Set Int)
Nothing -> () -> EventM ClickableName ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just Set Int
childIds -> IO () -> EventM ClickableName ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName ())
-> IO () -> EventM ClickableName ()
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 -> EventM ClickableName () -> EventM ClickableName (Next AppState)
forall n a. EventM n a -> EventM n (Next AppState)
withContinueS (EventM ClickableName () -> EventM ClickableName (Next AppState))
-> EventM ClickableName () -> EventM ClickableName (Next AppState)
forall a b. (a -> b) -> a -> b
$ do
      IO () -> EventM ClickableName ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName ())
-> IO () -> EventM ClickableName ()
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 -> EventM ClickableName () -> EventM ClickableName (Next AppState)
forall n a. EventM n a -> EventM n (Next AppState)
withContinueS (EventM ClickableName () -> EventM ClickableName (Next AppState))
-> EventM ClickableName () -> EventM ClickableName (Next AppState)
forall a b. (a -> b) -> a -> b
$ do
      Maybe (Int, MainListElem)
-> ((Int, MainListElem) -> EventM ClickableName ())
-> EventM ClickableName ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust (List ClickableName MainListElem -> Maybe (Int, MainListElem)
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s AppState
-> Getting
     (List ClickableName MainListElem)
     AppState
     (List ClickableName MainListElem)
-> List ClickableName MainListElem
forall s a. s -> Getting a s a -> a
^. Getting
  (List ClickableName MainListElem)
  AppState
  (List ClickableName MainListElem)
Lens' AppState (List ClickableName MainListElem)
appMainList)) (((Int, MainListElem) -> EventM ClickableName ())
 -> EventM ClickableName ())
-> ((Int, MainListElem) -> EventM ClickableName ())
-> EventM ClickableName ()
forall a b. (a -> b) -> a -> b
$ \(Int
_i, MainListElem {Maybe String
folderPath :: Maybe String
folderPath :: MainListElem -> Maybe String
folderPath}) ->
        Maybe String
-> (String -> EventM ClickableName ()) -> EventM ClickableName ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust Maybe String
folderPath ((String -> EventM ClickableName ()) -> EventM ClickableName ())
-> (String -> EventM ClickableName ()) -> EventM ClickableName ()
forall a b. (a -> b) -> a -> b
$ IO () -> EventM ClickableName ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName ())
-> (String -> IO ()) -> String -> EventM ClickableName ()
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 -> EventM ClickableName () -> EventM ClickableName (Next AppState)
forall n a. EventM n a -> EventM n (Next AppState)
withContinueS (EventM ClickableName () -> EventM ClickableName (Next AppState))
-> EventM ClickableName () -> EventM ClickableName (Next AppState)
forall a b. (a -> b) -> a -> b
$
      Maybe String
-> (String -> EventM ClickableName ()) -> EventM ClickableName ()
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 ()) -> EventM ClickableName ())
-> (String -> EventM ClickableName ()) -> EventM ClickableName ()
forall a b. (a -> b) -> a -> b
$ IO () -> EventM ClickableName ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName ())
-> (String -> IO ()) -> String -> EventM ClickableName ()
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 List ClickableName MainListElem -> Maybe (Int, MainListElem)
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s AppState
-> Getting
     (List ClickableName MainListElem)
     AppState
     (List ClickableName MainListElem)
-> List ClickableName MainListElem
forall s a. s -> Getting a s a -> a
^. Getting
  (List ClickableName MainListElem)
  AppState
  (List ClickableName MainListElem)
Lens' AppState (List ClickableName 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 (Next AppState)
forall n. AppState -> SrcLoc -> EventM n (Next AppState)
openSrcLoc AppState
s SrcLoc
loc
      Maybe (Int, MainListElem)
_ -> AppState -> EventM ClickableName (Next AppState)
forall s n. s -> EventM n (Next s)
continue AppState
s
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
openLogsInEditorKey -> case List ClickableName MainListElem -> Maybe (Int, MainListElem)
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s AppState
-> Getting
     (List ClickableName MainListElem)
     AppState
     (List ClickableName MainListElem)
-> List ClickableName MainListElem
forall s a. s -> Getting a s a -> a
^. Getting
  (List ClickableName MainListElem)
  AppState
  (List ClickableName MainListElem)
Lens' AppState (List ClickableName 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 :: String -> String -> String -> Int -> Int -> Int -> Int -> 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 (Next AppState)
forall s n. IO s -> EventM n (Next 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AppState -> IO AppState
forall (m :: * -> *) a. Monad m => a -> m a
return AppState
s)
      Maybe (Int, MainListElem)
_ -> AppState -> EventM ClickableName (Next AppState)
forall s n. s -> EventM n (Next s)
continue AppState
s
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
openFailureInEditorKey -> do
      case (List ClickableName MainListElem -> Maybe (Int, MainListElem)
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s AppState
-> Getting
     (List ClickableName MainListElem)
     AppState
     (List ClickableName MainListElem)
-> List ClickableName MainListElem
forall s a. s -> Getting a s a -> a
^. Getting
  (List ClickableName MainListElem)
  AppState
  (List ClickableName MainListElem)
Lens' AppState (List ClickableName MainListElem)
appMainList)) of
        Maybe (Int, MainListElem)
Nothing -> AppState -> EventM ClickableName (Next AppState)
forall s n. s -> EventM n (Next s)
continue AppState
s
        Just (Int
_i, MainListElem {Status
status :: Status
status :: MainListElem -> Status
status}) -> case Status
status of
          Done UTCTime
_ UTCTime
_ (Failure (FailureReason -> Maybe CallStack
failureCallStack -> Just (CallStack -> [(String, SrcLoc)]
getCallStack -> ((String
_, SrcLoc
loc):[(String, SrcLoc)]
_)))) -> AppState -> SrcLoc -> EventM ClickableName (Next AppState)
forall n. AppState -> SrcLoc -> EventM n (Next AppState)
openSrcLoc AppState
s SrcLoc
loc
          Status
_ -> AppState -> EventM ClickableName (Next AppState)
forall s n. s -> EventM n (Next s)
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 (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 (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 (Next AppState)
forall s n. s -> EventM n (Next s)
continue (AppState -> EventM ClickableName (Next AppState))
-> AppState -> EventM ClickableName (Next 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 (Next AppState)
forall s n. s -> EventM n (Next s)
continue (AppState -> EventM ClickableName (Next AppState))
-> AppState -> EventM ClickableName (Next 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 (Next AppState)
forall s n. s -> EventM n (Next s)
continue (AppState -> EventM ClickableName (Next AppState))
-> AppState -> EventM ClickableName (Next 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 (Next AppState)
forall s n. s -> EventM n (Next s)
continue (AppState -> EventM ClickableName (Next AppState))
-> AppState -> EventM ClickableName (Next 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 (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 ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName ())
-> IO () -> EventM ClickableName ()
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 Result)
-> EventM ClickableName ()
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 Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> EventM ClickableName Result)
-> (RunNode BaseContext -> IO Result)
-> RunNode BaseContext
-> EventM ClickableName 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 (Next AppState)
forall s n. s -> EventM n (Next s)
halt AppState
s
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
debugKey -> AppState -> EventM ClickableName (Next AppState)
forall s n. s -> EventM n (Next s)
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 (Next AppState)
forall s n. s -> EventM n (Next s)
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 (Next AppState)
forall s n. s -> EventM n (Next s)
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 (Next AppState)
forall s n. s -> EventM n (Next s)
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)

    Event
ev -> AppState
-> Lens' AppState (List ClickableName MainListElem)
-> (Event
    -> List ClickableName MainListElem
    -> EventM ClickableName (List ClickableName MainListElem))
-> Event
-> EventM ClickableName AppState
forall a b e n.
a -> Lens' a b -> (e -> b -> EventM n b) -> e -> EventM n a
handleEventLensed AppState
s Lens' AppState (List ClickableName MainListElem)
appMainList Event
-> List ClickableName MainListElem
-> EventM ClickableName (List ClickableName MainListElem)
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> GenericList n t e -> EventM n (GenericList n t e)
handleListEvent Event
ev EventM ClickableName AppState
-> (AppState -> EventM ClickableName (Next AppState))
-> EventM ClickableName (Next AppState)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= AppState -> EventM ClickableName (Next AppState)
forall s n. s -> EventM n (Next s)
continue

  where withContinueS :: EventM n a -> EventM n (Next AppState)
withContinueS EventM n a
action = EventM n a
action EventM n a -> EventM n (Next AppState) -> EventM n (Next AppState)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AppState -> EventM n (Next AppState)
forall s n. s -> EventM n (Next s)
continue AppState
s
appEvent AppState
s BrickEvent ClickableName AppEvent
_ = AppState -> EventM ClickableName (Next AppState)
forall s n. s -> EventM n (Next s)
continue AppState
s

modifyToggled :: AppState -> (Bool -> Bool) -> EventM n (Next AppState)
modifyToggled AppState
s Bool -> Bool
f = case List ClickableName MainListElem -> Maybe (Int, MainListElem)
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s AppState
-> Getting
     (List ClickableName MainListElem)
     AppState
     (List ClickableName MainListElem)
-> List ClickableName MainListElem
forall s a. s -> Getting a s a -> a
^. Getting
  (List ClickableName MainListElem)
  AppState
  (List ClickableName MainListElem)
Lens' AppState (List ClickableName MainListElem)
appMainList) of
  Maybe (Int, MainListElem)
Nothing -> AppState -> EventM n (Next AppState)
forall s n. s -> EventM n (Next s)
continue AppState
s
  Just (Int
_i, MainListElem {Bool
Int
String
Maybe String
Seq LogEntry
RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
Status
ident :: Int
node :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
folderPath :: Maybe String
visibilityLevel :: Int
logs :: Seq LogEntry
status :: Status
open :: Bool
toggled :: Bool
depth :: Int
label :: String
ident :: MainListElem -> Int
node :: MainListElem
-> RunNodeCommonWithStatus
     (Var Status) (Var (Seq LogEntry)) (Var Bool)
folderPath :: MainListElem -> Maybe String
visibilityLevel :: MainListElem -> Int
logs :: MainListElem -> Seq LogEntry
open :: MainListElem -> Bool
toggled :: MainListElem -> Bool
depth :: MainListElem -> Int
label :: MainListElem -> String
status :: MainListElem -> Status
..}) -> do
    IO () -> EventM n ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM n ()) -> IO () -> EventM n ()
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 n (Next AppState)
forall s n. s -> EventM n (Next s)
continue AppState
s

modifyOpen :: AppState -> (Bool -> Bool) -> EventM n (Next AppState)
modifyOpen AppState
s Bool -> Bool
f = case List ClickableName MainListElem -> Maybe (Int, MainListElem)
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s AppState
-> Getting
     (List ClickableName MainListElem)
     AppState
     (List ClickableName MainListElem)
-> List ClickableName MainListElem
forall s a. s -> Getting a s a -> a
^. Getting
  (List ClickableName MainListElem)
  AppState
  (List ClickableName MainListElem)
Lens' AppState (List ClickableName MainListElem)
appMainList) of
  Maybe (Int, MainListElem)
Nothing -> AppState -> EventM n (Next AppState)
forall s n. s -> EventM n (Next s)
continue AppState
s
  Just (Int
_i, MainListElem {Bool
Int
String
Maybe String
Seq LogEntry
RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
Status
ident :: Int
node :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
folderPath :: Maybe String
visibilityLevel :: Int
logs :: Seq LogEntry
status :: Status
open :: Bool
toggled :: Bool
depth :: Int
label :: String
ident :: MainListElem -> Int
node :: MainListElem
-> RunNodeCommonWithStatus
     (Var Status) (Var (Seq LogEntry)) (Var Bool)
folderPath :: MainListElem -> Maybe String
visibilityLevel :: MainListElem -> Int
logs :: MainListElem -> Seq LogEntry
open :: MainListElem -> Bool
toggled :: MainListElem -> Bool
depth :: MainListElem -> Int
label :: MainListElem -> String
status :: MainListElem -> Status
..}) -> do
    IO () -> EventM n ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM n ()) -> IO () -> EventM n ()
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 n (Next AppState)
forall s n. s -> EventM n (Next s)
continue AppState
s

openIndices :: [RunNode context] -> Seq.Seq Int -> IO ()
openIndices :: [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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Seq Int -> [Int]
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 :: 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
ident :: Int
node :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
folderPath :: Maybe String
visibilityLevel :: Int
logs :: Seq LogEntry
status :: Status
open :: Bool
toggled :: Bool
depth :: Int
label :: String
ident :: MainListElem -> Int
node :: MainListElem
-> RunNodeCommonWithStatus
     (Var Status) (Var (Seq LogEntry)) (Var Bool)
folderPath :: MainListElem -> Maybe String
visibilityLevel :: MainListElem -> Int
logs :: MainListElem -> Seq LogEntry
open :: MainListElem -> Bool
toggled :: MainListElem -> Bool
depth :: MainListElem -> Int
label :: MainListElem -> String
status :: MainListElem -> Status
..}) ->
    if | (Int
depth 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 (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
runTreeLogs :: forall s l t. RunNodeCommonWithStatus s l t -> l
runTreeRecordTime :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeVisible :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeLabel :: forall s l t. RunNodeCommonWithStatus s l t -> String
runTreeLoc :: Maybe SrcLoc
runTreeLogs :: Var (Seq LogEntry)
runTreeRecordTime :: Bool
runTreeVisibilityLevel :: Int
runTreeFolder :: Maybe String
runTreeVisible :: Bool
runTreeStatus :: Var Status
runTreeOpen :: Var Bool
runTreeToggled :: Var Bool
runTreeAncestors :: Seq Int
runTreeId :: Int
runTreeLabel :: String
runTreeOpen :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeToggled :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeFolder :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe String
runTreeLoc :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe SrcLoc
runTreeId :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeStatus :: forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeAncestors :: forall s l t. RunNodeCommonWithStatus s l t -> Seq Int
runTreeVisibilityLevel :: forall s l t. RunNodeCommonWithStatus s l t -> Int
..}) ->
    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
runTreeLoc :: Maybe SrcLoc
runTreeLogs :: Var (Seq LogEntry)
runTreeRecordTime :: Bool
runTreeVisibilityLevel :: Int
runTreeFolder :: Maybe String
runTreeVisible :: Bool
runTreeStatus :: Var Status
runTreeOpen :: Var Bool
runTreeToggled :: Var Bool
runTreeAncestors :: Seq Int
runTreeId :: Int
runTreeLabel :: String
runTreeLogs :: forall s l t. RunNodeCommonWithStatus s l t -> l
runTreeRecordTime :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeVisible :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeLabel :: forall s l t. RunNodeCommonWithStatus s l t -> String
runTreeOpen :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeToggled :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeFolder :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe String
runTreeLoc :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe SrcLoc
runTreeId :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeStatus :: forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeAncestors :: forall s l t. RunNodeCommonWithStatus s l t -> Seq Int
runTreeVisibilityLevel :: forall s l t. RunNodeCommonWithStatus s l t -> Int
..}) ->
    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
& (List ClickableName MainListElem
 -> Identity (List ClickableName MainListElem))
-> AppState -> Identity AppState
Lens' AppState (List ClickableName MainListElem)
appMainList ((List ClickableName MainListElem
  -> Identity (List ClickableName MainListElem))
 -> AppState -> Identity AppState)
-> (List ClickableName MainListElem
    -> List ClickableName MainListElem)
-> AppState
-> AppState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Vector MainListElem
-> Maybe Int
-> List ClickableName MainListElem
-> List ClickableName 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 (List ClickableName MainListElem -> Maybe Int
forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
listSelected (List ClickableName MainListElem -> Maybe Int)
-> List ClickableName MainListElem -> Maybe Int
forall a b. (a -> b) -> a -> b
$ AppState
s AppState
-> Getting
     (List ClickableName MainListElem)
     AppState
     (List ClickableName MainListElem)
-> List ClickableName MainListElem
forall s a. s -> Getting a s a -> a
^. Getting
  (List ClickableName MainListElem)
  AppState
  (List ClickableName MainListElem)
Lens' AppState (List ClickableName MainListElem)
appMainList)
  where filteredTree :: [RunNodeFixed BaseContext]
filteredTree = Int -> [RunNodeFixed BaseContext] -> [RunNodeFixed BaseContext]
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
     [RunNodeFixed BaseContext] AppState [RunNodeFixed BaseContext]
-> [RunNodeFixed BaseContext]
forall s a. s -> Getting a s a -> a
^. Getting
  [RunNodeFixed BaseContext] AppState [RunNodeFixed BaseContext]
Lens' AppState [RunNodeFixed BaseContext]
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
$ ((RunNodeFixed BaseContext, RunNode BaseContext) -> [MainListElem])
-> [(RunNodeFixed BaseContext, RunNode BaseContext)]
-> [MainListElem]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (RunNodeFixed BaseContext, RunNode BaseContext) -> [MainListElem]
forall context.
(RunNodeFixed context, RunNode context) -> [MainListElem]
treeToList ([RunNodeFixed BaseContext]
-> [RunNode BaseContext]
-> [(RunNodeFixed BaseContext, RunNode BaseContext)]
forall a b. [a] -> [b] -> [(a, b)]
zip [RunNodeFixed BaseContext]
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 :: 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 :: (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
runTreeLoc :: Maybe SrcLoc
runTreeLogs :: Var (Seq LogEntry)
runTreeRecordTime :: Bool
runTreeVisibilityLevel :: Int
runTreeFolder :: Maybe String
runTreeVisible :: Bool
runTreeStatus :: Var Status
runTreeOpen :: Var Bool
runTreeToggled :: Var Bool
runTreeAncestors :: Seq Int
runTreeId :: Int
runTreeLabel :: String
runTreeLogs :: forall s l t. RunNodeCommonWithStatus s l t -> l
runTreeRecordTime :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeVisible :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeLabel :: forall s l t. RunNodeCommonWithStatus s l t -> String
runTreeOpen :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeToggled :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeFolder :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe String
runTreeLoc :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe SrcLoc
runTreeId :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeStatus :: forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeAncestors :: forall s l t. RunNodeCommonWithStatus s l t -> Seq Int
runTreeVisibilityLevel :: forall s l t. RunNodeCommonWithStatus s l t -> Int
..}) = do
  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 :: 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' :: 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 context s l t.
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 context s l t.
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 ()
runNodeCleanup :: ()
runNodeAlloc :: ()
runNodeChildrenAugmented :: ()
runNodeCleanup :: intro -> ExampleT context IO ()
runNodeAlloc :: ExampleT context IO intro
runNodeChildrenAugmented :: [RunNodeWithStatus
   (LabelValue lab intro :> context) Status (Seq LogEntry) Bool]
runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeCommon :: forall context s l t.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
..}) = 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 ()
runNodeIntroduceAction :: ()
runNodeIntroduceAction :: (intro -> ExampleT context IO [Result]) -> ExampleT context IO ()
runNodeChildrenAugmented :: [RunNodeWithStatus
   (LabelValue lab intro :> context) Status (Seq LogEntry) Bool]
runNodeCommon :: RunNodeCommonWithStatus Status (Seq LogEntry) Bool
runNodeChildrenAugmented :: ()
runNodeCommon :: forall context s l t.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
..}) = 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 context s l t.
RunNodeWithStatus context s l t
-> [RunNodeWithStatus context s l t]
runNodeChildren RunNodeFixed context
node)

withScroll :: AppState
-> (ViewportScroll ClickableName -> EventM n ())
-> EventM n (Next AppState)
withScroll AppState
s ViewportScroll ClickableName -> EventM n ()
action = do
  case List ClickableName MainListElem -> Maybe (Int, MainListElem)
forall (t :: * -> *) n e.
(Splittable t, Foldable t) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s AppState
-> Getting
     (List ClickableName MainListElem)
     AppState
     (List ClickableName MainListElem)
-> List ClickableName MainListElem
forall s a. s -> Getting a s a -> a
^. Getting
  (List ClickableName MainListElem)
  AppState
  (List ClickableName MainListElem)
Lens' AppState (List ClickableName MainListElem)
appMainList) of
    Maybe (Int, MainListElem)
Nothing -> () -> EventM n ()
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
ident :: Int
node :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
folderPath :: Maybe String
visibilityLevel :: Int
logs :: Seq LogEntry
status :: Status
open :: Bool
toggled :: Bool
depth :: Int
label :: String
ident :: MainListElem -> Int
node :: MainListElem
-> RunNodeCommonWithStatus
     (Var Status) (Var (Seq LogEntry)) (Var Bool)
folderPath :: MainListElem -> Maybe String
visibilityLevel :: MainListElem -> Int
logs :: MainListElem -> Seq LogEntry
open :: MainListElem -> Bool
toggled :: MainListElem -> Bool
depth :: MainListElem -> Int
label :: MainListElem -> String
status :: MainListElem -> Status
..}) -> do
      let scroll :: ViewportScroll ClickableName
scroll = ClickableName -> ViewportScroll ClickableName
forall n. n -> ViewportScroll n
viewportScroll (Text -> ClickableName
InnerViewport [i|viewport_#{ident}|])
      ViewportScroll ClickableName -> EventM n ()
action ViewportScroll ClickableName
scroll

  AppState -> EventM n (Next AppState)
forall s n. s -> EventM n (Next s)
continue AppState
s

openSrcLoc :: AppState -> SrcLoc -> EventM n (Next 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 SrcLoc
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 SrcLoc
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcLoc -> EventM n SrcLoc) -> SrcLoc -> EventM n SrcLoc
forall a b. (a -> b) -> a -> b
$ SrcLoc
loc' { srcLocFile :: String
srcLocFile = String
d String -> String -> String
</> (SrcLoc -> String
srcLocFile SrcLoc
loc') }
        Maybe String
Nothing -> SrcLoc -> EventM n SrcLoc
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 (Next AppState)
forall s n. IO s -> EventM n (Next 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AppState -> IO AppState
forall (m :: * -> *) a. Monad m => a -> m a
return AppState
s)