{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE StrictData        #-}

{-|
Module      : Headroom.UI.Progress
Description : UI component for displaying progress
Copyright   : (c) 2019-2021 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

This component displays progress in format @[CURR of TOTAL]@.
-}

module Headroom.UI.Progress
  ( Progress(..)
  , zipWithProgress
  )
where

import           RIO
import qualified RIO.Text                           as T
import           Text.Printf                         ( printf )


-- | Progress indication. First argument is current progress, second the maximum
-- value.
data Progress = Progress Int Int
  deriving (Progress -> Progress -> Bool
(Progress -> Progress -> Bool)
-> (Progress -> Progress -> Bool) -> Eq Progress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Progress -> Progress -> Bool
$c/= :: Progress -> Progress -> Bool
== :: Progress -> Progress -> Bool
$c== :: Progress -> Progress -> Bool
Eq, Int -> Progress -> ShowS
[Progress] -> ShowS
Progress -> String
(Int -> Progress -> ShowS)
-> (Progress -> String) -> ([Progress] -> ShowS) -> Show Progress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Progress] -> ShowS
$cshowList :: [Progress] -> ShowS
show :: Progress -> String
$cshow :: Progress -> String
showsPrec :: Int -> Progress -> ShowS
$cshowsPrec :: Int -> Progress -> ShowS
Show)


instance Display Progress where
  textDisplay :: Progress -> Text
textDisplay (Progress Int
current Int
total) = String -> Text
T.pack
    (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String
"[", String
currentS, String
" of ", String
totalS, String
"]"]
   where
    format :: String
format   = String
"%" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (String -> Int) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
totalS) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"d"
    currentS :: String
currentS = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
format Int
current
    totalS :: String
totalS   = Int -> String
forall a. Show a => a -> String
show Int
total


-- | Zips given list with the progress info.
--
-- >>> zipWithProgress ["a", "b"]
-- [(Progress 1 2,"a"),(Progress 2 2,"b")]
zipWithProgress :: [a]
                -- ^ list to zip with progress
                -> [(Progress, a)]
                -- ^ zipped result
zipWithProgress :: [a] -> [(Progress, a)]
zipWithProgress [a]
list = [Progress] -> [a] -> [(Progress, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Progress]
progresses [a]
list
 where
  listLength :: Int
listLength = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
list
  progresses :: [Progress]
progresses = (Int -> Progress) -> [Int] -> [Progress]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Progress
`Progress` Int
listLength) [Int
1 .. Int
listLength]