{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TemplateHaskell #-}

module Test.Sandwich.Formatters.TerminalUI.Draw.ColorProgressBar (
  bottomProgressBarColored
  ) where

import Brick
import Data.Foldable
import Data.Ord (comparing)
import Data.String.Interpolate
import Lens.Micro
import Lens.Micro.TH
import Test.Sandwich.Formatters.TerminalUI.AttrMap
import Test.Sandwich.Formatters.TerminalUI.Types
import Test.Sandwich.RunTree
import Test.Sandwich.Types.RunTree
import Test.Sandwich.Types.Spec

type Chunk a = [(Rational, a)]

data ChunkSum = ChunkSum { ChunkSum -> Rational
_running :: Rational
                         , ChunkSum -> Rational
_notStarted :: Rational
                         , ChunkSum -> Rational
_pending :: Rational
                         , ChunkSum -> Rational
_success :: Rational
                         , ChunkSum -> Rational
_failure :: Rational }

zeroChunkSum :: ChunkSum
zeroChunkSum :: ChunkSum
zeroChunkSum = Rational
-> Rational -> Rational -> Rational -> Rational -> ChunkSum
ChunkSum Rational
0 Rational
0 Rational
0 Rational
0 Rational
0

makeLenses ''ChunkSum

splitIntoChunks :: forall a. (Show a) => Rational -> [(Rational, a)] -> [[(Rational, a)]]
splitIntoChunks :: forall a.
Show a =>
Rational -> [(Rational, a)] -> [[(Rational, a)]]
splitIntoChunks Rational
_ [] = []
splitIntoChunks Rational
chunkSize Chunk a
remaining = Chunk a
chunk Chunk a -> [Chunk a] -> [Chunk a]
forall a. a -> [a] -> [a]
: (Rational -> Chunk a -> [Chunk a]
forall a.
Show a =>
Rational -> [(Rational, a)] -> [[(Rational, a)]]
splitIntoChunks Rational
chunkSize Chunk a
remaining')
  where
    (Chunk a
chunk, Chunk a
remaining') = Chunk a -> Rational -> Chunk a -> (Chunk a, Chunk a)
go [] Rational
chunkSize Chunk a
remaining

    go :: Chunk a -> Rational -> [(Rational, a)] -> (Chunk a, [(Rational, a)])
    go :: Chunk a -> Rational -> Chunk a -> (Chunk a, Chunk a)
go Chunk a
chunkSoFar Rational
needed ((Rational
amount, a
val):Chunk a
xs) =
      if | Rational
amount Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
needed -> (Chunk a
chunkSoFar Chunk a -> Chunk a -> Chunk a
forall a. Semigroup a => a -> a -> a
<> [(Rational
amount, a
val)], Chunk a
xs)
         | Rational
amount Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
needed -> Chunk a -> Rational -> Chunk a -> (Chunk a, Chunk a)
go (Chunk a
chunkSoFar Chunk a -> Chunk a -> Chunk a
forall a. Semigroup a => a -> a -> a
<> [(Rational
amount, a
val)]) (Rational
needed Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
amount) Chunk a
xs
         | Rational
amount Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
needed -> (Chunk a
chunkSoFar Chunk a -> Chunk a -> Chunk a
forall a. Semigroup a => a -> a -> a
<> [(Rational
needed, a
val)], (Rational
amount Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
needed, a
val)(Rational, a) -> Chunk a -> Chunk a
forall a. a -> [a] -> [a]
:Chunk a
xs)
         | Bool
otherwise -> [Char] -> (Chunk a, Chunk a)
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"
    go Chunk a
chunkSoFar Rational
needed [] = [Char] -> (Chunk a, Chunk a)
forall a. HasCallStack => [Char] -> a
error [i|Bottomed out in go: #{chunkSoFar}, #{needed}|]

-- TODO: improve this to use block chars
getCharForChunk :: [(Rational, Status)] -> Widget n
getCharForChunk :: forall n. [(Rational, Status)] -> Widget n
getCharForChunk [(Rational, Status)]
chunk = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
attrToUse ([Char] -> Widget n
forall n. [Char] -> Widget n
str [Char]
full_five_eighth_height)
  where ChunkSum {Rational
_running :: ChunkSum -> Rational
_notStarted :: ChunkSum -> Rational
_pending :: ChunkSum -> Rational
_success :: ChunkSum -> Rational
_failure :: ChunkSum -> Rational
_running :: Rational
_notStarted :: Rational
_pending :: Rational
_success :: Rational
_failure :: Rational
..} = [(Rational, Status)] -> ChunkSum
sumChunk [(Rational, Status)]
chunk
        (Rational
_, AttrName
attrToUse) = ((Rational, AttrName) -> Rational)
-> [(Rational, AttrName)] -> (Rational, AttrName)
forall (t :: * -> *) a b.
(Foldable t, Ord a) =>
(b -> a) -> t b -> b
maxBy (Rational, AttrName) -> Rational
forall a b. (a, b) -> a
fst [(Rational
_running, AttrName
runningAttr)
                                   , (Rational
_notStarted, AttrName
notStartedAttr)
                                   , (Rational
_pending, AttrName
pendingAttr)
                                   , (Rational
_success, AttrName
successAttr)
                                   , (Rational
_failure, AttrName
failureAttr)
                                   ]

sumChunk :: Chunk Status -> ChunkSum
sumChunk :: [(Rational, Status)] -> ChunkSum
sumChunk = (ChunkSum -> (Rational, Status) -> ChunkSum)
-> ChunkSum -> [(Rational, Status)] -> ChunkSum
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ChunkSum -> (Rational, Status) -> ChunkSum
combine ChunkSum
zeroChunkSum
  where combine :: ChunkSum -> (Rational, Status) -> ChunkSum
combine ChunkSum
chunkSum (Rational
amount, Status
status) = ChunkSum
chunkSum ChunkSum -> (ChunkSum -> ChunkSum) -> ChunkSum
forall a b. a -> (a -> b) -> b
& (Status
-> (Rational -> Identity Rational) -> ChunkSum -> Identity ChunkSum
forall {f :: * -> *}.
Functor f =>
Status -> (Rational -> f Rational) -> ChunkSum -> f ChunkSum
lensForStatus Status
status) ((Rational -> Identity Rational) -> ChunkSum -> Identity ChunkSum)
-> (Rational -> Rational) -> ChunkSum -> ChunkSum
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
amount)

        lensForStatus :: Status -> (Rational -> f Rational) -> ChunkSum -> f ChunkSum
lensForStatus Status
NotStarted = (Rational -> f Rational) -> ChunkSum -> f ChunkSum
Lens' ChunkSum Rational
notStarted
        lensForStatus (Running {}) = (Rational -> f Rational) -> ChunkSum -> f ChunkSum
Lens' ChunkSum Rational
running
        lensForStatus (Done {statusResult :: Status -> Result
statusResult=Result
Success}) = (Rational -> f Rational) -> ChunkSum -> f ChunkSum
Lens' ChunkSum Rational
success
        lensForStatus (Done {statusResult :: Status -> Result
statusResult=(Failure (Pending {}))}) = (Rational -> f Rational) -> ChunkSum -> f ChunkSum
Lens' ChunkSum Rational
pending
        lensForStatus (Done {statusResult :: Status -> Result
statusResult=(Failure FailureReason
_)}) = (Rational -> f Rational) -> ChunkSum -> f ChunkSum
Lens' ChunkSum Rational
failure
        lensForStatus (Done {statusResult :: Status -> Result
statusResult=Result
DryRun}) = (Rational -> f Rational) -> ChunkSum -> f ChunkSum
Lens' ChunkSum Rational
notStarted
        lensForStatus (Done {statusResult :: Status -> Result
statusResult=Result
Cancelled}) = (Rational -> f Rational) -> ChunkSum -> f ChunkSum
Lens' ChunkSum Rational
failure

maxBy :: (Foldable t, Ord a) => (b -> a) -> t b -> b
maxBy :: forall (t :: * -> *) a b.
(Foldable t, Ord a) =>
(b -> a) -> t b -> b
maxBy = (b -> b -> Ordering) -> t b -> b
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy ((b -> b -> Ordering) -> t b -> b)
-> ((b -> a) -> b -> b -> Ordering) -> (b -> a) -> t b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> a) -> b -> b -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing

-- * Block elems

-- full = "█"
-- seven_eighth = "▉"
-- six_eighth = "▊"
-- five_eighth = "▋"
-- four_eighth = "▌"
-- three_eighth = "▍"
-- two_eighth = "▎"
-- one_eighth = "▏"

full_five_eighth_height :: String
full_five_eighth_height :: [Char]
full_five_eighth_height = [Char]
"▆"

-- * Exports

bottomProgressBarColored :: AppState -> Widget n
bottomProgressBarColored :: forall n. AppState -> Widget n
bottomProgressBarColored AppState
app = Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Fixed (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
  Context n
c <- RenderM n (Context n)
forall n. RenderM n (Context n)
getContext
  Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ AppState -> Int -> Widget n
forall p n. Integral p => AppState -> p -> Widget n
bottomProgressBarColoredWidth AppState
app (Context n
c Context n -> Getting Int (Context n) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Context n) Int
forall n (f :: * -> *).
Functor f =>
(Int -> f Int) -> Context n -> f (Context n)
availWidthL)

bottomProgressBarColoredWidth :: Integral p => AppState -> p -> Widget n
bottomProgressBarColoredWidth :: forall p n. Integral p => AppState -> p -> Widget n
bottomProgressBarColoredWidth AppState
app p
width = [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
hBox [[(Rational, Status)] -> Widget n
forall n. [(Rational, Status)] -> Widget n
getCharForChunk [(Rational, Status)]
chunk | [(Rational, Status)]
chunk <- [[(Rational, Status)]]
chunks]
  where
    statuses :: [Status]
statuses = (RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool
 -> [Status])
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> [Status]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool
-> [Status]
forall context a l t. RunNodeWithStatus context a l t -> [a]
getStatuses (AppState
app AppState
-> Getting
     [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
     AppState
     [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
-> [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
forall s a. s -> Getting a s a -> a
^. Getting
  [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
  AppState
  [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
Lens'
  AppState [RunNodeWithStatus BaseContext Status (Seq LogEntry) Bool]
appRunTree)
    statusesWithAmounts :: [(Rational, Status)]
statusesWithAmounts = [(Rational
testsPerChar, Status
x) | Status
x <- [Status]
statuses]

    chunks :: [[(Rational, Status)]]
chunks = Rational -> [(Rational, Status)] -> [[(Rational, Status)]]
forall a.
Show a =>
Rational -> [(Rational, a)] -> [[(Rational, a)]]
splitIntoChunks Rational
1 [(Rational, Status)]
statusesWithAmounts

    Rational
testsPerChar :: Rational = p -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
width Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Status] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Status]
statuses)

    getStatuses :: RunNodeWithStatus context a l t -> [a]
    getStatuses :: forall context a l t. RunNodeWithStatus context a l t -> [a]
getStatuses = (forall ctx. RunNodeWithStatus ctx a l t -> a)
-> RunNodeWithStatus context a l t -> [a]
forall s l t a context.
(forall ctx. RunNodeWithStatus ctx s l t -> a)
-> RunNodeWithStatus context s l t -> [a]
extractValues (RunNodeCommonWithStatus a l t -> a
forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeStatus (RunNodeCommonWithStatus a l t -> a)
-> (RunNodeWithStatus ctx a l t -> RunNodeCommonWithStatus a l t)
-> RunNodeWithStatus ctx a l t
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunNodeWithStatus ctx a l t -> RunNodeCommonWithStatus a l t
forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon)