{-# LANGUAGE MultiWayIf #-}

module Test.Sandwich.Formatters.TerminalUI.Draw.RunTimes (
  getRunTimes
  ) where

import Brick
import Data.Maybe
import Data.String.Interpolate
import Data.Time.Clock
import qualified Graphics.Vty as V
import Lens.Micro
import Test.Sandwich.Formatters.Common.Util
import Test.Sandwich.Formatters.TerminalUI.AttrMap
import Test.Sandwich.Formatters.TerminalUI.Types


minGray, maxGray :: Int
minGray :: Int
minGray = Int
50
maxGray :: Int
maxGray = Int
255

data Mode =
  NothingRunning
  | SetupRunning
  | WorkRunning
  | TeardownRunning
  deriving (Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
/= :: Mode -> Mode -> Bool
Eq)

getRunTimes :: AppState -> UTCTime -> Maybe UTCTime -> Maybe UTCTime -> UTCTime -> Bool -> Widget n
getRunTimes :: forall n.
AppState
-> UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> UTCTime
-> Bool
-> Widget n
getRunTimes AppState
app UTCTime
startTime Maybe UTCTime
statusSetupFinishTime Maybe UTCTime
statusTeardownStartTime UTCTime
endTime Bool
showEllipses = Image -> Widget n
forall n. Image -> Widget n
raw Image
setupWork Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Image -> Widget n
forall n. Image -> Widget n
raw Image
actualWork Widget n -> Widget n -> Widget n
forall n. Widget n -> Widget n -> Widget n
<+> Image -> Widget n
forall n. Image -> Widget n
raw Image
teardownWork
  where
    totalElapsed :: NominalDiffTime
totalElapsed = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime (AppState
app AppState -> Getting UTCTime AppState UTCTime -> UTCTime
forall s a. s -> Getting a s a -> a
^. Getting UTCTime AppState UTCTime
Lens' AppState UTCTime
appCurrentTime) (AppState
app AppState -> Getting UTCTime AppState UTCTime -> UTCTime
forall s a. s -> Getting a s a -> a
^. Getting UTCTime AppState UTCTime
Lens' AppState UTCTime
appStartTime)

    setupTime :: Maybe NominalDiffTime
setupTime = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime (UTCTime -> UTCTime -> NominalDiffTime)
-> Maybe UTCTime -> Maybe (UTCTime -> NominalDiffTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
statusSetupFinishTime Maybe (UTCTime -> NominalDiffTime)
-> Maybe UTCTime -> Maybe NominalDiffTime
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UTCTime
startTime
    teardownTime :: Maybe NominalDiffTime
teardownTime = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime (UTCTime -> UTCTime -> NominalDiffTime)
-> Maybe UTCTime -> Maybe (UTCTime -> NominalDiffTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UTCTime
endTime Maybe (UTCTime -> NominalDiffTime)
-> Maybe UTCTime -> Maybe NominalDiffTime
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe UTCTime
statusTeardownStartTime

    actualWorkTime :: NominalDiffTime
actualWorkTime = (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
endTime UTCTime
startTime) NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
- (NominalDiffTime -> Maybe NominalDiffTime -> NominalDiffTime
forall a. a -> Maybe a -> a
fromMaybe NominalDiffTime
0 Maybe NominalDiffTime
setupTime) NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
- (NominalDiffTime -> Maybe NominalDiffTime -> NominalDiffTime
forall a. a -> Maybe a -> a
fromMaybe NominalDiffTime
0 Maybe NominalDiffTime
teardownTime)

    mode :: Mode
mode = if
      | Bool -> Bool
not Bool
showEllipses -> Mode
NothingRunning
      | Maybe UTCTime -> Bool
forall a. Maybe a -> Bool
isJust Maybe UTCTime
statusTeardownStartTime -> Mode
TeardownRunning
      | Maybe UTCTime -> Bool
forall a. Maybe a -> Bool
isJust Maybe UTCTime
statusSetupFinishTime -> Mode
WorkRunning
      | Bool
otherwise -> Mode
SetupRunning

    setupWork :: Image
setupWork = Image
-> (NominalDiffTime -> Image) -> Maybe NominalDiffTime -> Image
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Image
forall a. Monoid a => a
mempty (\NominalDiffTime
dt -> Attr -> String -> Image
V.string (NominalDiffTime -> NominalDiffTime -> Bool -> Attr
getAttr NominalDiffTime
totalElapsed NominalDiffTime
dt (Mode
mode Mode -> Mode -> Bool
forall a. Eq a => a -> a -> Bool
== Mode
SetupRunning)) [i|(#{formatNominalDiffTime dt}) + |]) Maybe NominalDiffTime
setupTime
    actualWork :: Image
actualWork = Attr -> String -> Image
V.string (NominalDiffTime -> NominalDiffTime -> Bool -> Attr
getAttr NominalDiffTime
totalElapsed NominalDiffTime
actualWorkTime (Mode
mode Mode -> Mode -> Bool
forall a. Eq a => a -> a -> Bool
== Mode
WorkRunning)) (NominalDiffTime -> String
formatNominalDiffTime NominalDiffTime
actualWorkTime)
    teardownWork :: Image
teardownWork = Image
-> (NominalDiffTime -> Image) -> Maybe NominalDiffTime -> Image
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Image
forall a. Monoid a => a
mempty (\NominalDiffTime
dt -> Attr -> String -> Image
V.string (NominalDiffTime -> NominalDiffTime -> Bool -> Attr
getAttr NominalDiffTime
totalElapsed NominalDiffTime
dt (Mode
mode Mode -> Mode -> Bool
forall a. Eq a => a -> a -> Bool
== Mode
TeardownRunning)) [i| + (#{formatNominalDiffTime dt})|]) Maybe NominalDiffTime
teardownTime

getAttr :: NominalDiffTime -> NominalDiffTime -> Bool -> V.Attr
getAttr :: NominalDiffTime -> NominalDiffTime -> Bool -> Attr
getAttr NominalDiffTime
totalElapsed NominalDiffTime
dt Bool
bold = V.Attr {
  attrStyle :: MaybeDefault Style
V.attrStyle = if Bool
bold then (Style -> MaybeDefault Style
forall v. v -> MaybeDefault v
V.SetTo Style
V.bold) else MaybeDefault Style
forall v. MaybeDefault v
V.Default
  , attrForeColor :: MaybeDefault Color
V.attrForeColor = Color -> MaybeDefault Color
forall v. v -> MaybeDefault v
V.SetTo (Color -> MaybeDefault Color) -> Color -> MaybeDefault Color
forall a b. (a -> b) -> a -> b
$ Int -> Color
forall {i}. Integral i => i -> Color
grayAt (Int -> Color) -> Int -> Color
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Int
getLevel (NominalDiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
totalElapsed) (NominalDiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
dt)
  , attrBackColor :: MaybeDefault Color
V.attrBackColor = MaybeDefault Color
forall v. MaybeDefault v
V.Default
  , attrURL :: MaybeDefault Text
V.attrURL = MaybeDefault Text
forall v. MaybeDefault v
V.Default
  }

getLevel :: Double -> Double -> Int
getLevel :: Double -> Double -> Int
getLevel Double
totalElapsed Double
duration = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
maxGray (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
minGray (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minGray Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
intensity Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
maxGray Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
minGray))))
  where
    Double
intensity :: Double = Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase (Double
totalElapsed Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1) (Double
duration Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1)