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

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

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

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

  -- * Util
  , isTuiFormatterSupported
  ) where

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


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

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

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

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

  [RunNodeFixed BaseContext]
rtsFixed <- IO [RunNodeFixed BaseContext] -> m [RunNodeFixed BaseContext]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [RunNodeFixed BaseContext] -> m [RunNodeFixed BaseContext])
-> IO [RunNodeFixed BaseContext] -> m [RunNodeFixed BaseContext]
forall a b. (a -> b) -> a -> b
$ 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 ())
-> CustomExceptionFormatters
-> 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 ())
          , _appCustomExceptionFormatters :: CustomExceptionFormatters
_appCustomExceptionFormatters = CustomExceptionFormatters
terminalUICustomExceptionFormatters
        }

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

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

  TVar [RunNodeFixed BaseContext]
currentFixedTree <- IO (TVar [RunNodeFixed BaseContext])
-> m (TVar [RunNodeFixed BaseContext])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TVar [RunNodeFixed BaseContext])
 -> m (TVar [RunNodeFixed BaseContext]))
-> IO (TVar [RunNodeFixed BaseContext])
-> m (TVar [RunNodeFixed BaseContext])
forall a b. (a -> b) -> a -> b
$ [RunNodeFixed BaseContext] -> IO (TVar [RunNodeFixed BaseContext])
forall a. a -> IO (TVar a)
newTVarIO [RunNodeFixed BaseContext]
rtsFixed
  Async Any
eventAsync <- IO (Async Any) -> m (Async Any)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Async Any) -> m (Async Any))
-> IO (Async Any) -> m (Async Any)
forall a b. (a -> b) -> a -> b
$ IO Any -> IO (Async Any)
forall a. IO a -> IO (Async a)
async (IO Any -> IO (Async Any)) -> IO Any -> IO (Async Any)
forall a b. (a -> b) -> a -> b
$
    IO () -> IO Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO Any) -> IO () -> IO Any
forall a b. (a -> b) -> a -> b
$ do
      (SomeException -> IO ()) -> IO () -> IO ()
forall (m :: * -> *) a.
MonadCatch m =>
(SomeException -> m a) -> m a -> m a
handleAny (\SomeException
e -> (LoggingT IO ()
 -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> IO ())
-> (Loc -> Text -> LogLevel -> LogStr -> IO ())
-> LoggingT IO ()
-> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip LoggingT IO ()
-> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> IO ()
forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT Loc -> Text -> LogLevel -> LogStr -> IO ()
logFn (Text -> LoggingT IO ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logError [i|Got exception in event async: #{e}|]) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO ()
threadDelay Int
terminalUIRefreshPeriod) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        [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 -> m Vty
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Vty
buildVty
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ (IO () -> IO () -> IO ()) -> IO () -> IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO () -> IO () -> IO ()
forall (m :: * -> *) a b. 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))
-> (BrickEvent n e -> EventM n 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
#if MIN_VERSION_brick(1,0,0)
  , appHandleEvent :: BrickEvent ClickableName AppEvent
-> EventM ClickableName AppState ()
appHandleEvent = \BrickEvent ClickableName AppEvent
event -> EventM ClickableName AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get EventM ClickableName AppState AppState
-> (AppState -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \AppState
s -> AppState
-> BrickEvent ClickableName AppEvent
-> EventM ClickableName AppState ()
appEvent AppState
s BrickEvent ClickableName AppEvent
event
  , appStartEvent :: EventM ClickableName AppState ()
appStartEvent = () -> EventM ClickableName AppState ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#else
  , appHandleEvent = appEvent
  , appStartEvent = return
#endif
  , appAttrMap :: AppState -> AttrMap
appAttrMap = AttrMap -> AppState -> AttrMap
forall a b. a -> b -> a
const AttrMap
mainAttrMap
  }

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

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

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

doHalt = halt
#endif

#if MIN_VERSION_brick(1,0,0)
appEvent :: AppState -> BrickEvent ClickableName AppEvent -> EventM ClickableName AppState ()
#else
appEvent :: AppState -> BrickEvent ClickableName AppEvent -> EventM ClickableName (Next AppState)
#endif
appEvent :: AppState
-> BrickEvent ClickableName AppEvent
-> EventM ClickableName AppState ()
appEvent AppState
s (AppEvent (RunTreeUpdated [RunNodeFixed BaseContext]
newTree)) = do
  UTCTime
now <- IO UTCTime -> EventM ClickableName AppState UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  AppState -> EventM ClickableName AppState ()
continue (AppState -> EventM ClickableName AppState ())
-> AppState -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState
s
    AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& ([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 AppState (Maybe (Extent ClickableName))
forall n s. Eq n => n -> EventM n s (Maybe (Extent n))
lookupExtent ClickableName
ColorBar EventM ClickableName AppState (Maybe (Extent ClickableName))
-> (Maybe (Extent ClickableName)
    -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Extent ClickableName)
Nothing -> AppState -> EventM ClickableName AppState ()
continue AppState
s
    Just (Extent {extentSize :: forall n. Extent n -> (Int, Int)
extentSize=(Int
w, Int
_), extentUpperLeft :: forall n. Extent n -> Location
extentUpperLeft=(B.Location (Int
l, Int
_))}) -> do
      let Double
percent :: Double = (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w)
      let allCommons :: [RunNodeCommonWithStatus Status (Seq LogEntry) Bool]
allCommons = (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 AppState ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> IO () -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ [RunNode BaseContext] -> Seq Int -> IO ()
forall context. [RunNode context] -> Seq Int -> IO ()
openIndices (AppState
s AppState
-> Getting [RunNode BaseContext] AppState [RunNode BaseContext]
-> [RunNode BaseContext]
forall s a. s -> Getting a s a -> a
^. Getting [RunNode BaseContext] AppState [RunNode BaseContext]
Lens' AppState [RunNode BaseContext]
appRunTreeBase) (RunNodeCommonWithStatus Status (Seq LogEntry) Bool -> Seq Int
forall s l t. RunNodeCommonWithStatus s l t -> Seq Int
runTreeAncestors (RunNodeCommonWithStatus Status (Seq LogEntry) Bool -> Seq Int)
-> RunNodeCommonWithStatus Status (Seq LogEntry) Bool -> Seq Int
forall a b. (a -> b) -> a -> b
$ [RunNodeCommonWithStatus Status (Seq LogEntry) Bool]
allCommons [RunNodeCommonWithStatus Status (Seq LogEntry) Bool]
-> Int -> RunNodeCommonWithStatus Status (Seq LogEntry) Bool
forall a. [a] -> Int -> a
!! Int
index)
      AppState -> EventM ClickableName AppState ()
continue (AppState -> EventM ClickableName AppState ())
-> AppState -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ AppState
s
        AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (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 AppState ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (ClickableName -> ViewportScroll ClickableName
forall n. n -> ViewportScroll n
viewportScroll ClickableName
MainList) (-Int
1)
  AppState -> EventM ClickableName AppState ()
continueNoChange AppState
s
appEvent AppState
s (MouseDown (ListRow Int
_i) Button
V.BScrollDown [Modifier]
_ Location
_) = do
  ViewportScroll ClickableName
-> Int -> EventM ClickableName AppState ()
forall n. ViewportScroll n -> forall s. Int -> EventM n s ()
vScrollBy (ClickableName -> ViewportScroll ClickableName
forall n. n -> ViewportScroll n
viewportScroll ClickableName
MainList) Int
1
  AppState -> EventM ClickableName AppState ()
continueNoChange AppState
s
appEvent AppState
s (MouseDown (ListRow Int
i) Button
V.BLeft [Modifier]
_ Location
_) = do
  AppState -> EventM ClickableName AppState ()
continue (AppState
s AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (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 AppState ()
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 AppState ()
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 :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
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 AppState ()
continue AppState
s
        Just (Int
i', MainListElem
_) -> AppState -> EventM ClickableName AppState ()
continue (AppState
s AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (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 :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
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 AppState ()
continue AppState
s
        Just (Int
i', MainListElem
_) -> AppState -> EventM ClickableName AppState ()
continue (AppState
s AppState -> (AppState -> AppState) -> AppState
forall a b. a -> (a -> b) -> b
& (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 AppState ()
modifyOpen AppState
s (Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
False)
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
openNodeKey -> AppState -> (Bool -> Bool) -> EventM ClickableName AppState ()
modifyOpen AppState
s (Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
True)
    V.EvKey c :: Key
c@(V.KChar Char
ch) [Modifier
V.MMeta] | Key
c Key -> [Key] -> Bool
forall (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 AppState ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> IO () -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ Vector MainListElem -> Int -> IO ()
forall (t :: * -> *). Foldable t => t MainListElem -> Int -> IO ()
openToDepth (AppState
s AppState
-> Getting (Vector MainListElem) AppState (Vector MainListElem)
-> Vector MainListElem
forall s a. s -> Getting a s a -> a
^. ((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 AppState ()
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 AppState ()
modifyToggled AppState
s Bool -> Bool
not

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

    -- Column 2
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
cancelAllKey -> do
      IO () -> EventM ClickableName AppState ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> IO () -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ (RunNode BaseContext -> IO ()) -> [RunNode BaseContext] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RunNode BaseContext -> IO ()
forall context. RunNode context -> IO ()
cancelNode (AppState
s AppState
-> Getting [RunNode BaseContext] AppState [RunNode BaseContext]
-> [RunNode BaseContext]
forall s a. s -> Getting a s a -> a
^. Getting [RunNode BaseContext] AppState [RunNode BaseContext]
Lens' AppState [RunNode BaseContext]
appRunTreeBase)
      AppState -> EventM ClickableName AppState ()
continue AppState
s
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
cancelSelectedKey -> AppState
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall a.
AppState
-> EventM ClickableName AppState a
-> EventM ClickableName AppState ()
withContinueS AppState
s (EventM ClickableName AppState ()
 -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ do
      Maybe (Int, MainListElem)
-> ((Int, MainListElem) -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust (List ClickableName MainListElem -> Maybe (Int, MainListElem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s AppState
-> Getting
     (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 AppState ())
 -> EventM ClickableName AppState ())
-> ((Int, MainListElem) -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ \(Int
_, MainListElem {Bool
Int
String
Maybe String
Seq LogEntry
RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
Status
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 AppState ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> IO () -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$
        (Var Status -> IO Status
forall a. TVar a -> IO a
readTVarIO (Var Status -> IO Status) -> Var Status -> IO Status
forall a b. (a -> b) -> a -> b
$ RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> Var Status
forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeStatus RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
node) IO Status -> (Status -> IO ()) -> IO ()
forall (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 -> AppState
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall a.
AppState
-> EventM ClickableName AppState a
-> EventM ClickableName AppState ()
withContinueS AppState
s (EventM ClickableName AppState ()
 -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ do
      Bool
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
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 AppState ()
 -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ IO () -> EventM ClickableName AppState ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> IO () -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ do
        (RunNode BaseContext -> IO ()) -> [RunNode BaseContext] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RunNode BaseContext -> IO ()
forall context. RunNode context -> IO ()
clearRecursively (AppState
s AppState
-> Getting [RunNode BaseContext] AppState [RunNode BaseContext]
-> [RunNode BaseContext]
forall s a. s -> Getting a s a -> a
^. Getting [RunNode BaseContext] AppState [RunNode BaseContext]
Lens' AppState [RunNode BaseContext]
appRunTreeBase)
        IO (Async ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Async ()) -> IO ()) -> IO (Async ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ IO [Result] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [Result] -> IO ()) -> IO [Result] -> IO ()
forall a b. (a -> b) -> a -> b
$ [RunNode BaseContext] -> BaseContext -> IO [Result]
forall context.
HasBaseContext context =>
[RunNode context] -> context -> IO [Result]
runNodesSequentially (AppState
s AppState
-> Getting [RunNode BaseContext] AppState [RunNode BaseContext]
-> [RunNode BaseContext]
forall s a. s -> Getting a s a -> a
^. Getting [RunNode BaseContext] AppState [RunNode BaseContext]
Lens' AppState [RunNode BaseContext]
appRunTreeBase) (AppState
s AppState -> Getting BaseContext AppState BaseContext -> BaseContext
forall s a. s -> Getting a s a -> a
^. Getting BaseContext AppState BaseContext
Lens' AppState BaseContext
appBaseContext)
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
runSelectedKey -> AppState
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall a.
AppState
-> EventM ClickableName AppState a
-> EventM ClickableName AppState ()
withContinueS AppState
s (EventM ClickableName AppState ()
 -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$
      Maybe (Int, MainListElem)
-> ((Int, MainListElem) -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust (List ClickableName MainListElem -> Maybe (Int, MainListElem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s AppState
-> Getting
     (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 AppState ())
 -> EventM ClickableName AppState ())
-> ((Int, MainListElem) -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ \(Int
_, MainListElem {Bool
Int
String
Maybe String
Seq LogEntry
RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
Status
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 AppState ()
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 AppState ()
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 AppState ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> IO () -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ (RunNode BaseContext -> IO ()) -> [RunNode BaseContext] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((RunNodeCommonWithStatus
   (Var Status) (Var (Seq LogEntry)) (Var Bool)
 -> Bool)
-> RunNode BaseContext -> IO ()
forall context.
(RunNodeCommonWithStatus
   (Var Status) (Var (Seq LogEntry)) (Var Bool)
 -> Bool)
-> RunNode context -> IO ()
clearRecursivelyWhere (\RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
x -> RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> Int
forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeId RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
x Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Int
allIds)) (AppState
s AppState
-> Getting [RunNode BaseContext] AppState [RunNode BaseContext]
-> [RunNode BaseContext]
forall s a. s -> Getting a s a -> a
^. Getting [RunNode BaseContext] AppState [RunNode BaseContext]
Lens' AppState [RunNode BaseContext]
appRunTreeBase)
              -- Start a run for all affected nodes
              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 AppState (Async ())
-> EventM ClickableName AppState ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (EventM ClickableName AppState (Async ())
 -> EventM ClickableName AppState ())
-> EventM ClickableName AppState (Async ())
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ IO (Async ()) -> EventM ClickableName AppState (Async ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Async ()) -> EventM ClickableName AppState (Async ()))
-> IO (Async ()) -> EventM ClickableName AppState (Async ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ IO [Result] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [Result] -> IO ()) -> IO [Result] -> IO ()
forall a b. (a -> b) -> a -> b
$ [RunNode BaseContext] -> BaseContext -> IO [Result]
forall context.
HasBaseContext context =>
[RunNode context] -> context -> IO [Result]
runNodesSequentially (AppState
s AppState
-> Getting [RunNode BaseContext] AppState [RunNode BaseContext]
-> [RunNode BaseContext]
forall s a. s -> Getting a s a -> a
^. Getting [RunNode BaseContext] AppState [RunNode BaseContext]
Lens' AppState [RunNode BaseContext]
appRunTreeBase) BaseContext
bc
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
clearSelectedKey -> AppState
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall a.
AppState
-> EventM ClickableName AppState a
-> EventM ClickableName AppState ()
withContinueS AppState
s (EventM ClickableName AppState ()
 -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ do
      Maybe (Int, MainListElem)
-> ((Int, MainListElem) -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust (List ClickableName MainListElem -> Maybe (Int, MainListElem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s AppState
-> Getting
     (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 AppState ())
 -> EventM ClickableName AppState ())
-> ((Int, MainListElem) -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ \(Int
_, MainListElem {Bool
Int
String
Maybe String
Seq LogEntry
RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
Status
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 AppState ()
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 AppState ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just Set Int
childIds -> IO () -> EventM ClickableName AppState ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> IO () -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ (RunNode BaseContext -> IO ()) -> [RunNode BaseContext] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((RunNodeCommonWithStatus
   (Var Status) (Var (Seq LogEntry)) (Var Bool)
 -> Bool)
-> RunNode BaseContext -> IO ()
forall context.
(RunNodeCommonWithStatus
   (Var Status) (Var (Seq LogEntry)) (Var Bool)
 -> Bool)
-> RunNode context -> IO ()
clearRecursivelyWhere (\RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
x -> RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> Int
forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeId RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
x Int -> Set Int -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Int
childIds)) (AppState
s AppState
-> Getting [RunNode BaseContext] AppState [RunNode BaseContext]
-> [RunNode BaseContext]
forall s a. s -> Getting a s a -> a
^. Getting [RunNode BaseContext] AppState [RunNode BaseContext]
Lens' AppState [RunNode BaseContext]
appRunTreeBase)
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
clearAllKey -> AppState
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall a.
AppState
-> EventM ClickableName AppState a
-> EventM ClickableName AppState ()
withContinueS AppState
s (EventM ClickableName AppState ()
 -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ do
      IO () -> EventM ClickableName AppState ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> IO () -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ (RunNode BaseContext -> IO ()) -> [RunNode BaseContext] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RunNode BaseContext -> IO ()
forall context. RunNode context -> IO ()
clearRecursively (AppState
s AppState
-> Getting [RunNode BaseContext] AppState [RunNode BaseContext]
-> [RunNode BaseContext]
forall s a. s -> Getting a s a -> a
^. Getting [RunNode BaseContext] AppState [RunNode BaseContext]
Lens' AppState [RunNode BaseContext]
appRunTreeBase)
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
openSelectedFolderInFileExplorer -> AppState
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall a.
AppState
-> EventM ClickableName AppState a
-> EventM ClickableName AppState ()
withContinueS AppState
s (EventM ClickableName AppState ()
 -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ do
      Maybe (Int, MainListElem)
-> ((Int, MainListElem) -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust (List ClickableName MainListElem -> Maybe (Int, MainListElem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s AppState
-> Getting
     (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 AppState ())
 -> EventM ClickableName AppState ())
-> ((Int, MainListElem) -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ \(Int
_i, MainListElem {Maybe String
folderPath :: Maybe String
folderPath :: MainListElem -> Maybe String
folderPath}) ->
        Maybe String
-> (String -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust Maybe String
folderPath ((String -> EventM ClickableName AppState ())
 -> EventM ClickableName AppState ())
-> (String -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ IO () -> EventM ClickableName AppState ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> (String -> IO ()) -> String -> EventM ClickableName AppState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
openFileExplorerFolderPortable
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
openTestRootKey -> AppState
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall a.
AppState
-> EventM ClickableName AppState a
-> EventM ClickableName AppState ()
withContinueS AppState
s (EventM ClickableName AppState ()
 -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$
      Maybe String
-> (String -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust (BaseContext -> Maybe String
baseContextRunRoot (AppState
s AppState -> Getting BaseContext AppState BaseContext -> BaseContext
forall s a. s -> Getting a s a -> a
^. Getting BaseContext AppState BaseContext
Lens' AppState BaseContext
appBaseContext)) ((String -> EventM ClickableName AppState ())
 -> EventM ClickableName AppState ())
-> (String -> EventM ClickableName AppState ())
-> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ IO () -> EventM ClickableName AppState ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> (String -> IO ()) -> String -> EventM ClickableName AppState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
openFileExplorerFolderPortable
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
openTestInEditorKey -> case List ClickableName MainListElem -> Maybe (Int, MainListElem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s AppState
-> Getting
     (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 AppState ()
forall n. Ord n => AppState -> SrcLoc -> EventM n AppState ()
openSrcLoc AppState
s SrcLoc
loc
      Maybe (Int, MainListElem)
_ -> AppState -> EventM ClickableName AppState ()
continue AppState
s
    V.EvKey Key
c [] | Key
c Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
openLogsInEditorKey -> case List ClickableName MainListElem -> Maybe (Int, MainListElem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s AppState
-> Getting
     (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 AppState ()
forall n s. Ord n => IO s -> EventM n s ()
suspendAndResume ((AppState
s AppState
-> Getting (SrcLoc -> IO ()) AppState (SrcLoc -> IO ())
-> SrcLoc
-> IO ()
forall s a. s -> Getting a s a -> a
^. Getting (SrcLoc -> IO ()) AppState (SrcLoc -> IO ())
Lens' AppState (SrcLoc -> IO ())
appOpenInEditor) SrcLoc
srcLoc IO () -> IO AppState -> IO AppState
forall (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 AppState ()
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 :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
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 AppState ()
continue AppState
s
        Just (Int
_i, MainListElem {Status
status :: Status
status :: MainListElem -> Status
status}) -> case Status
status of
          Done UTCTime
_ UTCTime
_ (Failure (FailureReason -> Maybe CallStack
failureCallStack -> Just (CallStack -> [(String, SrcLoc)]
getCallStack -> ((String
_, SrcLoc
loc):[(String, SrcLoc)]
_)))) -> AppState -> SrcLoc -> EventM ClickableName AppState ()
forall n. Ord n => AppState -> SrcLoc -> EventM n AppState ()
openSrcLoc AppState
s SrcLoc
loc
          Status
_ -> AppState -> EventM ClickableName AppState ()
continue AppState
s

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

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

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

modifyToggled :: AppState -> (Bool -> Bool) -> EventM ClickableName AppState ()
modifyToggled AppState
s Bool -> Bool
f = case List ClickableName MainListElem -> Maybe (Int, MainListElem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s AppState
-> Getting
     (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 AppState ()
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 ClickableName AppState ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> IO () -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ Var Bool -> (Bool -> Bool) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> Var Bool
forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeToggled RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
node) Bool -> Bool
f
    AppState -> EventM ClickableName AppState ()
continue AppState
s

modifyOpen :: AppState -> (Bool -> Bool) -> EventM ClickableName AppState ()
modifyOpen AppState
s Bool -> Bool
f = case List ClickableName MainListElem -> Maybe (Int, MainListElem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s AppState
-> Getting
     (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 AppState ()
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 ClickableName AppState ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM ClickableName AppState ())
-> IO () -> EventM ClickableName AppState ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ Var Bool -> (Bool -> Bool) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> Var Bool
forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeOpen RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
node) Bool -> Bool
f
    AppState -> EventM ClickableName AppState ()
continue AppState
s

openIndices :: [RunNode context] -> Seq.Seq Int -> IO ()
openIndices :: [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)

#if MIN_VERSION_brick(1,0,0)
withScroll :: AppState -> (forall s. ViewportScroll ClickableName -> EventM n s ()) -> EventM n AppState ()
#else
withScroll :: AppState -> (ViewportScroll ClickableName -> EventM n ()) -> EventM n (Next AppState)
#endif
withScroll :: AppState
-> (forall s. ViewportScroll ClickableName -> EventM n s ())
-> EventM n AppState ()
withScroll AppState
s forall s. ViewportScroll ClickableName -> EventM n s ()
action = do
  case List ClickableName MainListElem -> Maybe (Int, MainListElem)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement (AppState
s AppState
-> Getting
     (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 AppState ()
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 AppState ()
forall s. ViewportScroll ClickableName -> EventM n s ()
action ViewportScroll ClickableName
scroll

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

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