module ProgressBar where
import Control.Exception.Base
import Control.Monad
import Control.Concurrent
type Progress = Rational
data ProgressBar = ProgressBar { width :: Int
, fillChar :: Char
, emptyChar :: Char
, delim :: (Char, Char)}
inbounds :: Progress -> Bool
inbounds prog = prog >= 0 && prog < 1
clamp :: (Ord a) => a -> a -> a -> a
clamp mn mx = max mn . min mx
-- Represent a ProgressBar with a given progress (0 to 1)
representProgressBar :: ProgressBar -> Progress -> String
representProgressBar ProgressBar{ width=w
, fillChar=fc
, emptyChar=ec
, delim=(start, end)} progress =
start : progStr ++ padStr ++ [end]
-- Get the length of the bar using progress, and clamp it to fit the bounds
where clamped = clamp 0 1 progress
len = (floor $ clamped * fromIntegral w) :: Int
progStr = replicate len fc
padStr = replicate (w - len) ec
defaultProgressBar :: ProgressBar
defaultProgressBar = ProgressBar 50 '#' '.' ('[', ']')
-- Purely print the ProgressBar
displayProgressBar :: ProgressBar -> Progress -> IO ()
displayProgressBar pb progress =
putStr $ '\r' : representProgressBar pb progress
type Pollable a = Progress -> IO a
pollProgressBar' :: Progress -> Pollable Progress -> ProgressBar -> IO ()
pollProgressBar' previous pollable pb = do
progressPoll <- pollable previous
unless (previous == progressPoll) $
displayProgressBar pb progressPoll
when (inbounds progressPoll && progressPoll < 1) $
pollProgressBar' progressPoll pollable pb
pollProgressBar :: Pollable Progress -> ProgressBar -> IO ()
pollProgressBar = pollProgressBar' 0