{-# 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 UI refreshes. Defaults to 100ms. 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
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)

-- | 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 = 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]
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 {})) = [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))