module System.Console.AsciiProgress
( ProgressBar(..)
, Options(..)
, Stats(..)
, isComplete
, newProgressBar
, tick
, tickN
, getProgressStrIO
, getProgressStats
, getProgressStr
, Default(..)
)
where
import Control.Applicative ((<$>))
import Control.Concurrent
import Control.Concurrent.Async (Async, async, poll)
import Data.Default (Default(..))
import Data.Maybe (isJust)
import System.Console.ANSI (clearLine, setCursorColumn)
import System.IO (BufferMode(..), hSetBuffering, stdout)
import System.Console.AsciiProgress.Internal
data ProgressBar = ProgressBar ProgressBarInfo (Async ())
newProgressBar :: Options -> IO ProgressBar
newProgressBar opts = do
hSetBuffering stdout NoBuffering
info <- newProgressBarInfo opts
future <- async $ start info
return $ ProgressBar info future
where
start info@ProgressBarInfo{..} = do
c <- readMVar pgCompleted
if c < pgTotal opts
then do
n <- readChan pgChannel
handleMessage n
if c + n < pgTotal opts
then start info
else reset
else reset
where
reset = do
clearLine
setCursorColumn 0
handleMessage n = do
modifyMVar_ pgCompleted (\c -> return (c + n))
stats <- getInfoStats info
reset
let progressStr = getProgressStr opts stats
putStr progressStr
tick :: ProgressBar -> IO ()
tick pg = tickN pg 1
tickN :: ProgressBar -> Int -> IO ()
tickN (ProgressBar info _) = writeChan (pgChannel info)
isComplete :: ProgressBar -> IO Bool
isComplete (ProgressBar _ future) = isJust <$> poll future
getProgressStats :: ProgressBar -> IO Stats
getProgressStats (ProgressBar info _) = getInfoStats info
getProgressStrIO :: ProgressBar -> IO String
getProgressStrIO (ProgressBar info _) =
getProgressStr (pgOptions info) <$> getInfoStats info