{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ExistentialQuantification #-}
module Test.Sandwich.Formatters.TerminalUI.Types where
import qualified Brick as B
import qualified Brick.Widgets.List as L
import Control.Exception
import Control.Monad.Logger
import Data.Sequence
import qualified Data.Text as T
import Data.Time
import GHC.Stack
import Lens.Micro.TH
import Test.Sandwich.Formatters.TerminalUI.OpenInEditor
import Test.Sandwich.RunTree
import Test.Sandwich.Types.RunTree
data TerminalUIFormatter = TerminalUIFormatter {
TerminalUIFormatter -> Int
terminalUIVisibilityThreshold :: Int
, TerminalUIFormatter -> InitialFolding
terminalUIInitialFolding :: InitialFolding
, TerminalUIFormatter -> Bool
terminalUIShowRunTimes :: Bool
, TerminalUIFormatter -> Bool
terminalUIShowFileLocations :: Bool
, TerminalUIFormatter -> Bool
terminalUIShowVisibilityThresholds :: Bool
, TerminalUIFormatter -> Maybe LogLevel
terminalUILogLevel :: Maybe LogLevel
, TerminalUIFormatter -> Int
terminalUIRefreshPeriod :: Int
, TerminalUIFormatter -> Maybe String
terminalUIDefaultEditor :: Maybe String
, TerminalUIFormatter
-> Maybe String -> (Text -> IO ()) -> SrcLoc -> IO ()
terminalUIOpenInEditor :: Maybe String -> (T.Text -> IO ()) -> SrcLoc -> IO ()
, TerminalUIFormatter -> CustomExceptionFormatters
terminalUICustomExceptionFormatters :: CustomExceptionFormatters
}
instance Show TerminalUIFormatter where
show :: TerminalUIFormatter -> String
show (TerminalUIFormatter {}) = String
"<TerminalUIFormatter>"
data InitialFolding =
InitialFoldingAllOpen
| InitialFoldingAllClosed
| InitialFoldingTopNOpen Int
deriving (Int -> InitialFolding -> ShowS
[InitialFolding] -> ShowS
InitialFolding -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitialFolding] -> ShowS
$cshowList :: [InitialFolding] -> ShowS
show :: InitialFolding -> String
$cshow :: InitialFolding -> String
showsPrec :: Int -> InitialFolding -> ShowS
$cshowsPrec :: Int -> InitialFolding -> ShowS
Show, InitialFolding -> InitialFolding -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitialFolding -> InitialFolding -> Bool
$c/= :: InitialFolding -> InitialFolding -> Bool
== :: InitialFolding -> InitialFolding -> Bool
$c== :: InitialFolding -> InitialFolding -> Bool
Eq)
defaultTerminalUIFormatter :: TerminalUIFormatter
defaultTerminalUIFormatter :: TerminalUIFormatter
defaultTerminalUIFormatter = TerminalUIFormatter {
terminalUIVisibilityThreshold :: Int
terminalUIVisibilityThreshold = Int
50
, terminalUIInitialFolding :: InitialFolding
terminalUIInitialFolding = InitialFolding
InitialFoldingAllOpen
, terminalUIShowRunTimes :: Bool
terminalUIShowRunTimes = Bool
True
, terminalUIShowFileLocations :: Bool
terminalUIShowFileLocations = Bool
False
, terminalUIShowVisibilityThresholds :: Bool
terminalUIShowVisibilityThresholds = Bool
False
, terminalUILogLevel :: Maybe LogLevel
terminalUILogLevel = forall a. a -> Maybe a
Just LogLevel
LevelWarn
, terminalUIRefreshPeriod :: Int
terminalUIRefreshPeriod = Int
100000
, terminalUIDefaultEditor :: Maybe String
terminalUIDefaultEditor = forall a. a -> Maybe a
Just String
"emacsclient +$((LINE+1)):COLUMN --no-wait"
, terminalUIOpenInEditor :: Maybe String -> (Text -> IO ()) -> SrcLoc -> IO ()
terminalUIOpenInEditor = Maybe String -> (Text -> IO ()) -> SrcLoc -> IO ()
autoOpenInEditor
, terminalUICustomExceptionFormatters :: CustomExceptionFormatters
terminalUICustomExceptionFormatters = []
}
type CustomExceptionFormatters = [SomeException -> Maybe CustomTUIException]
data CustomTUIException = CustomTUIExceptionMessageAndCallStack T.Text (Maybe CallStack)
| CustomTUIExceptionBrick (forall n. B.Widget n)
newtype AppEvent = RunTreeUpdated [RunNodeFixed BaseContext]
instance Show AppEvent where
show :: AppEvent -> String
show (RunTreeUpdated {}) = String
"<RunTreeUpdated>"
data MainListElem = MainListElem {
MainListElem -> String
label :: String
, MainListElem -> Int
depth :: Int
, MainListElem -> Bool
toggled :: Bool
, MainListElem -> Bool
open :: Bool
, MainListElem -> Status
status :: Status
, MainListElem -> Seq LogEntry
logs :: Seq LogEntry
, MainListElem -> Int
visibilityLevel :: Int
, MainListElem -> Maybe String
folderPath :: Maybe FilePath
, MainListElem -> RunNodeCommon
node :: RunNodeCommon
, MainListElem -> Int
ident :: Int
}
data SomeRunNode = forall context s l t. SomeRunNode { ()
unSomeRunNode :: RunNodeWithStatus context s l t }
data ClickableName = ColorBar | ListRow Int | MainList | InnerViewport T.Text
deriving (Int -> ClickableName -> ShowS
[ClickableName] -> ShowS
ClickableName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClickableName] -> ShowS
$cshowList :: [ClickableName] -> ShowS
show :: ClickableName -> String
$cshow :: ClickableName -> String
showsPrec :: Int -> ClickableName -> ShowS
$cshowsPrec :: Int -> ClickableName -> ShowS
Show, Eq ClickableName
ClickableName -> ClickableName -> Bool
ClickableName -> ClickableName -> Ordering
ClickableName -> ClickableName -> ClickableName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ClickableName -> ClickableName -> ClickableName
$cmin :: ClickableName -> ClickableName -> ClickableName
max :: ClickableName -> ClickableName -> ClickableName
$cmax :: ClickableName -> ClickableName -> ClickableName
>= :: ClickableName -> ClickableName -> Bool
$c>= :: ClickableName -> ClickableName -> Bool
> :: ClickableName -> ClickableName -> Bool
$c> :: ClickableName -> ClickableName -> Bool
<= :: ClickableName -> ClickableName -> Bool
$c<= :: ClickableName -> ClickableName -> Bool
< :: ClickableName -> ClickableName -> Bool
$c< :: ClickableName -> ClickableName -> Bool
compare :: ClickableName -> ClickableName -> Ordering
$ccompare :: ClickableName -> ClickableName -> Ordering
Ord, ClickableName -> ClickableName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClickableName -> ClickableName -> Bool
$c/= :: ClickableName -> ClickableName -> Bool
== :: ClickableName -> ClickableName -> Bool
$c== :: ClickableName -> ClickableName -> Bool
Eq)
data AppState = AppState {
AppState -> [RunNode BaseContext]
_appRunTreeBase :: [RunNode BaseContext]
, AppState -> [RunNodeFixed BaseContext]
_appRunTree :: [RunNodeFixed BaseContext]
, AppState -> List ClickableName MainListElem
_appMainList :: L.List ClickableName MainListElem
, AppState -> BaseContext
_appBaseContext :: BaseContext
, AppState -> UTCTime
_appStartTime :: UTCTime
, AppState -> NominalDiffTime
_appTimeSinceStart :: NominalDiffTime
, AppState -> [Int]
_appVisibilityThresholdSteps :: [Int]
, AppState -> Int
_appVisibilityThreshold :: Int
, AppState -> Maybe LogLevel
_appLogLevel :: Maybe LogLevel
, AppState -> Bool
_appShowRunTimes :: Bool
, AppState -> Bool
_appShowFileLocations :: Bool
, AppState -> Bool
_appShowVisibilityThresholds :: Bool
, AppState -> SrcLoc -> IO ()
_appOpenInEditor :: SrcLoc -> IO ()
, AppState -> Text -> IO ()
_appDebug :: T.Text -> IO ()
, AppState -> CustomExceptionFormatters
_appCustomExceptionFormatters :: CustomExceptionFormatters
}
makeLenses ''AppState
extractValues' :: (forall context s l t. RunNodeWithStatus context s l t -> a) -> SomeRunNode -> [a]
forall context s l t. RunNodeWithStatus context s l t -> a
f (SomeRunNode n :: RunNodeWithStatus context s l t
n@(RunNodeIt {})) = [forall context s l t. RunNodeWithStatus context s l t -> a
f RunNodeWithStatus context s l t
n]
extractValues' forall context s l t. RunNodeWithStatus context s l t -> a
f (SomeRunNode n :: RunNodeWithStatus context s l t
n@(RunNodeIntroduce {[RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented :: ()
runNodeChildrenAugmented :: [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented})) = (forall context s l t. RunNodeWithStatus context s l t -> a
f RunNodeWithStatus context s l t
n) forall a. a -> [a] -> [a]
: (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall s l t a context.
(forall context1. RunNodeWithStatus context1 s l t -> a)
-> RunNodeWithStatus context s l t -> [a]
extractValues forall context s l t. RunNodeWithStatus context s l t -> a
f) [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented)
extractValues' forall context s l t. RunNodeWithStatus context s l t -> a
f (SomeRunNode n :: RunNodeWithStatus context s l t
n@(RunNodeIntroduceWith {[RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented :: [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented :: ()
runNodeChildrenAugmented})) = (forall context s l t. RunNodeWithStatus context s l t -> a
f RunNodeWithStatus context s l t
n) forall a. a -> [a] -> [a]
: (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall s l t a context.
(forall context1. RunNodeWithStatus context1 s l t -> a)
-> RunNodeWithStatus context s l t -> [a]
extractValues forall context s l t. RunNodeWithStatus context s l t -> a
f) [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented)
extractValues' forall context s l t. RunNodeWithStatus context s l t -> a
f (SomeRunNode RunNodeWithStatus context s l t
n) = (forall context s l t. RunNodeWithStatus context s l t -> a
f RunNodeWithStatus context s l t
n) forall a. a -> [a] -> [a]
: (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall s l t a context.
(forall context1. RunNodeWithStatus context1 s l t -> a)
-> RunNodeWithStatus context s l t -> [a]
extractValues forall context s l t. RunNodeWithStatus context s l t -> a
f) (forall s l t context.
RunNodeWithStatus context s l t
-> [RunNodeWithStatus context s l t]
runNodeChildren RunNodeWithStatus context s l t
n))