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

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

import Brick
import Data.Foldable
import Data.Ord (comparing)
import Data.String.Interpolate
import GHC.Stack
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 forall a. a -> [a] -> [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 forall a. Eq a => a -> a -> Bool
== Rational
needed -> (Chunk a
chunkSoFar forall a. Semigroup a => a -> a -> a
<> [(Rational
amount, a
val)], Chunk a
xs)
         | Rational
amount forall a. Ord a => a -> a -> Bool
< Rational
needed -> Chunk a -> Rational -> Chunk a -> (Chunk a, Chunk a)
go (Chunk a
chunkSoFar forall a. Semigroup a => a -> a -> a
<> [(Rational
amount, a
val)]) (Rational
needed forall a. Num a => a -> a -> a
- Rational
amount) Chunk a
xs
         | Rational
amount forall a. Ord a => a -> a -> Bool
> Rational
needed -> (Chunk a
chunkSoFar forall a. Semigroup a => a -> a -> a
<> [(Rational
needed, a
val)], (Rational
amount forall a. Num a => a -> a -> a
- Rational
needed, a
val)forall a. a -> [a] -> [a]
:Chunk a
xs)
         | Bool
otherwise -> forall a. HasCallStack => [Char] -> a
error [Char]
"impossible"
    go Chunk a
chunkSoFar Rational
needed [] = 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 = forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
attrToUse (forall n. [Char] -> Widget n
str [Char]
full_five_eighth_height)
  where ChunkSum {Rational
_failure :: Rational
_success :: Rational
_pending :: Rational
_notStarted :: Rational
_running :: Rational
_failure :: ChunkSum -> Rational
_success :: ChunkSum -> Rational
_pending :: ChunkSum -> Rational
_notStarted :: ChunkSum -> Rational
_running :: ChunkSum -> Rational
..} = [(Rational, Status)] -> ChunkSum
sumChunk [(Rational, Status)]
chunk
        (Rational
_, AttrName
attrToUse) = forall (t :: * -> *) a b.
(Foldable t, Ord a) =>
(b -> a) -> t b -> b
maxBy 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 = 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 forall a b. a -> (a -> b) -> b
& (forall {f :: * -> *}.
Functor f =>
Status -> (Rational -> f Rational) -> ChunkSum -> f ChunkSum
lensForStatus Status
status) forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Num a => a -> a -> a
+ Rational
amount)

        lensForStatus :: Status -> (Rational -> f Rational) -> ChunkSum -> f ChunkSum
lensForStatus Status
NotStarted = Lens' ChunkSum Rational
notStarted
        lensForStatus (Running {}) = Lens' ChunkSum Rational
running
        lensForStatus (Done {statusResult :: Status -> Result
statusResult=Result
Success}) = Lens' ChunkSum Rational
success
        lensForStatus (Done {statusResult :: Status -> Result
statusResult=(Failure (Pending {}))}) = Lens' ChunkSum Rational
pending
        lensForStatus (Done {statusResult :: Status -> Result
statusResult=(Failure FailureReason
_)}) = Lens' ChunkSum Rational
failure
        lensForStatus (Done {statusResult :: Status -> Result
statusResult=Result
DryRun}) = Lens' ChunkSum Rational
notStarted
        lensForStatus (Done {statusResult :: Status -> Result
statusResult=Result
Cancelled}) = 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 = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: [Char]
full_five_eighth_height = [Char]
"▆"

-- * Exports

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

bottomProgressBarColoredWidth :: AppState -> p -> Widget n
bottomProgressBarColoredWidth AppState
app p
width = forall n. [Widget n] -> Widget n
hBox [forall n. [(Rational, Status)] -> Widget n
getCharForChunk [(Rational, Status)]
chunk | [(Rational, Status)]
chunk <- [[(Rational, Status)]]
chunks]
  where
    statuses :: [Status]
statuses = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall context a l t.
HasCallStack =>
RunNodeWithStatus context a l t -> [a]
getStatuses (AppState
app forall s a. s -> Getting a s a -> a
^. 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 = forall a.
Show a =>
Rational -> [(Rational, a)] -> [[(Rational, a)]]
splitIntoChunks Rational
1 [(Rational, Status)]
statusesWithAmounts

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

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