{-# 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
  -- ^ The initial visibility threshold to use when the formatter starts.
  , TerminalUIFormatter -> InitialFolding
terminalUIInitialFolding :: InitialFolding
  -- ^ The initial folding settings to use when the formatter starts.
  , TerminalUIFormatter -> Bool
terminalUIShowRunTimes :: Bool
  -- ^ Whether to show or hide run times.
  , TerminalUIFormatter -> Bool
terminalUIShowFileLocations :: Bool
  -- ^ Whether to show or hide the files in which tests are defined.
  , TerminalUIFormatter -> Bool
terminalUIShowVisibilityThresholds :: Bool
  -- ^ Whether to show or hide visibility thresholds next to nodes.
  , TerminalUIFormatter -> Maybe LogLevel
terminalUILogLevel :: Maybe LogLevel
  -- ^ Log level for test log displays.
  , TerminalUIFormatter -> Int
terminalUIRefreshPeriod :: Int
  -- ^ Time in microseconds between test tree renders. Defaults to 100ms. Can be increased if CPU usage of the UI is too high.
  , TerminalUIFormatter -> Maybe Int
terminalUIClockUpdatePeriod :: Maybe Int
  -- ^ Time in microseconds between clock ticks. This causes the app's current time to be updated, which powers the
  -- run time displays and the overall app uptime displayed at the top. Defaults to Just 1s. If Nothing, the clock timer is disabled.
  -- Can be increased if CPU usage of the UI is too high.
  , TerminalUIFormatter -> Maybe String
terminalUIDefaultEditor :: Maybe String
  -- ^ Default value to use for the EDITOR environment variable when one is not provided.
  -- If 'Nothing' and EDITOR can't be found, edit commands will do nothing.
  --
  -- Here are some recommended values, depending on your preferred editor:
  --
  -- * Emacs: @export EDITOR="emacsclient --eval '(progn (find-file FILE) (goto-line LINE) (forward-char (- COLUMN 1)) (recenter))'"@
  -- * Terminal Emacs: @export EDITOR="emacsclient -nw --eval '(progn (find-file FILE) (goto-line LINE) (forward-char (- COLUMN 1)) (recenter))'"@
  -- * Vim: @export EDITOR="vim +LINE"@
  , TerminalUIFormatter
-> Maybe String -> (Text -> IO ()) -> SrcLoc -> IO ()
terminalUIOpenInEditor :: Maybe String -> (T.Text -> IO ()) -> SrcLoc -> IO ()
  -- ^ Callback to open a source location in your editor. By default, finds the command in the EDITOR environment variable
  -- and invokes it with the strings LINE, COLUMN, and FILE replaced with the line number, column, and file path.
  -- If FILE is not found in the string, it will be appended to the command after a space.
  -- It's also passed a debug callback that accepts a 'T.Text'; messages logged with this function will go into the formatter logs.
  , TerminalUIFormatter -> CustomExceptionFormatters
terminalUICustomExceptionFormatters :: CustomExceptionFormatters
  -- ^ Custom exception formatters, used to nicely format custom exception types.
  }

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
(Int -> InitialFolding -> ShowS)
-> (InitialFolding -> String)
-> ([InitialFolding] -> ShowS)
-> Show InitialFolding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InitialFolding -> ShowS
showsPrec :: Int -> InitialFolding -> ShowS
$cshow :: InitialFolding -> String
show :: InitialFolding -> String
$cshowList :: [InitialFolding] -> ShowS
showList :: [InitialFolding] -> ShowS
Show, InitialFolding -> InitialFolding -> Bool
(InitialFolding -> InitialFolding -> Bool)
-> (InitialFolding -> InitialFolding -> Bool) -> Eq InitialFolding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InitialFolding -> InitialFolding -> Bool
== :: InitialFolding -> InitialFolding -> Bool
$c/= :: InitialFolding -> InitialFolding -> Bool
/= :: InitialFolding -> InitialFolding -> Bool
Eq)

-- | Default settings for the terminal UI formatter.
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 = LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LevelWarn
  , terminalUIRefreshPeriod :: Int
terminalUIRefreshPeriod = Int
100000
  , terminalUIClockUpdatePeriod :: Maybe Int
terminalUIClockUpdatePeriod = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1000000
  , terminalUIDefaultEditor :: Maybe String
terminalUIDefaultEditor = String -> Maybe String
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)

data AppEvent =
  RunTreeUpdated { AppEvent -> [RunNodeFixed BaseContext]
runTreeUpdateTree :: [RunNodeFixed BaseContext]
                 , AppEvent -> Bool
runTreeUpdateSomethingRunning :: Bool }
  | CurrentTimeUpdated { AppEvent -> UTCTime
currentTimeUpdatedTs :: UTCTime}

instance Show AppEvent where
  show :: AppEvent -> String
show (RunTreeUpdated {}) = String
"<RunTreeUpdated>"
  show (CurrentTimeUpdated {}) = String
"<CurrentTimeUpdated>"

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
(Int -> ClickableName -> ShowS)
-> (ClickableName -> String)
-> ([ClickableName] -> ShowS)
-> Show ClickableName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClickableName -> ShowS
showsPrec :: Int -> ClickableName -> ShowS
$cshow :: ClickableName -> String
show :: ClickableName -> String
$cshowList :: [ClickableName] -> ShowS
showList :: [ClickableName] -> ShowS
Show, Eq ClickableName
Eq ClickableName =>
(ClickableName -> ClickableName -> Ordering)
-> (ClickableName -> ClickableName -> Bool)
-> (ClickableName -> ClickableName -> Bool)
-> (ClickableName -> ClickableName -> Bool)
-> (ClickableName -> ClickableName -> Bool)
-> (ClickableName -> ClickableName -> ClickableName)
-> (ClickableName -> ClickableName -> ClickableName)
-> Ord 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
$ccompare :: ClickableName -> ClickableName -> Ordering
compare :: ClickableName -> ClickableName -> Ordering
$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
>= :: ClickableName -> ClickableName -> Bool
$cmax :: ClickableName -> ClickableName -> ClickableName
max :: ClickableName -> ClickableName -> ClickableName
$cmin :: ClickableName -> ClickableName -> ClickableName
min :: ClickableName -> ClickableName -> ClickableName
Ord, ClickableName -> ClickableName -> Bool
(ClickableName -> ClickableName -> Bool)
-> (ClickableName -> ClickableName -> Bool) -> Eq ClickableName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClickableName -> ClickableName -> Bool
== :: ClickableName -> ClickableName -> Bool
$c/= :: ClickableName -> ClickableName -> Bool
/= :: 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

  -- | Set at formatter initialization and never changed
  , AppState -> UTCTime
_appStartTime :: UTCTime
  -- | Only incremented when some test is running
  , AppState -> UTCTime
_appCurrentTime :: UTCTime
  , AppState -> Bool
_appSomethingRunning :: Bool

  , 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]
extractValues' :: forall a.
(forall context s l t. RunNodeWithStatus context s l t -> a)
-> SomeRunNode -> [a]
extractValues' forall context s l t. RunNodeWithStatus context s l t -> a
f (SomeRunNode n :: RunNodeWithStatus context s l t
n@(RunNodeIt {})) = [RunNodeWithStatus context s l t -> a
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 :: [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented :: ()
runNodeChildrenAugmented})) = (RunNodeWithStatus context s l t -> a
forall context s l t. RunNodeWithStatus context s l t -> a
f RunNodeWithStatus context s l t
n) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ((RunNodeWithStatus (LabelValue lab intro :> context) s l t -> [a])
-> [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
-> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((forall ctx. RunNodeWithStatus ctx s l t -> a)
-> RunNodeWithStatus (LabelValue lab intro :> context) s l t -> [a]
forall s l t a context.
(forall ctx. RunNodeWithStatus ctx s l t -> a)
-> RunNodeWithStatus context s l t -> [a]
extractValues RunNodeWithStatus ctx s l t -> a
forall ctx. RunNodeWithStatus ctx s l t -> a
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 :: ()
runNodeChildrenAugmented :: [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
runNodeChildrenAugmented})) = (RunNodeWithStatus context s l t -> a
forall context s l t. RunNodeWithStatus context s l t -> a
f RunNodeWithStatus context s l t
n) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ((RunNodeWithStatus (LabelValue lab intro :> context) s l t -> [a])
-> [RunNodeWithStatus (LabelValue lab intro :> context) s l t]
-> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((forall ctx. RunNodeWithStatus ctx s l t -> a)
-> RunNodeWithStatus (LabelValue lab intro :> context) s l t -> [a]
forall s l t a context.
(forall ctx. RunNodeWithStatus ctx s l t -> a)
-> RunNodeWithStatus context s l t -> [a]
extractValues RunNodeWithStatus ctx s l t -> a
forall ctx. RunNodeWithStatus ctx s l t -> a
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) = (RunNodeWithStatus context s l t -> a
forall context s l t. RunNodeWithStatus context s l t -> a
f RunNodeWithStatus context s l t
n) a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ((RunNodeWithStatus context s l t -> [a])
-> [RunNodeWithStatus context s l t] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((forall ctx. RunNodeWithStatus ctx s l t -> a)
-> RunNodeWithStatus context s l t -> [a]
forall s l t a context.
(forall ctx. RunNodeWithStatus ctx s l t -> a)
-> RunNodeWithStatus context s l t -> [a]
extractValues RunNodeWithStatus ctx s l t -> a
forall ctx. RunNodeWithStatus ctx s l t -> a
forall context s l t. RunNodeWithStatus context s l t -> a
f) (RunNodeWithStatus context s l t
-> [RunNodeWithStatus context s l t]
forall s l t context.
RunNodeWithStatus context s l t
-> [RunNodeWithStatus context s l t]
runNodeChildren RunNodeWithStatus context s l t
n))