diff --git a/ascii-progress.cabal b/ascii-progress.cabal --- a/ascii-progress.cabal +++ b/ascii-progress.cabal @@ -1,5 +1,5 @@ name: ascii-progress -version: 0.2.0.0 +version: 0.2.1.0 synopsis: A simple progress bar for the console. description: A simple Haskell progress bar for the console. Heavily borrows from TJ @@ -69,6 +69,21 @@ buildable: False default-language: Haskell2010 +executable multi-example + main-is: MultiExample.hs + build-depends: ansi-terminal + , async >= 2.0.1.5 + , base >=4.7 && <4.8 + , data-default >= 0.5.3 + , time >= 1.4.2 + hs-source-dirs: lib + , bin + if flag(examples) + buildable: True + else + buildable: False + default-language: Haskell2010 + test-suite hspec type: exitcode-stdio-1.0 main-is: Spec.hs @@ -78,6 +93,7 @@ , data-default >= 0.5.3 , hspec >=2.1 && <3 , time >= 1.4.2 + , QuickCheck >= 2.6 hs-source-dirs: lib , test default-language: Haskell2010 diff --git a/bin/MultiExample.hs b/bin/MultiExample.hs new file mode 100644 --- /dev/null +++ b/bin/MultiExample.hs @@ -0,0 +1,33 @@ +import Control.Concurrent (forkIO, threadDelay) +import Control.Concurrent.Async (wait) +import Control.Monad (unless) +import System.Console.AsciiProgress (ProgressBar(..), Options(..), isComplete, + def, newProgressBar, tick) + +main :: IO () +main = do + pg1 <- newProgressBar def { pgWidth = 100 + , pgOnCompletion = putStr "pg 1 is Done!" + } + _ <- forkIO $ loop pg1 (100 * 1000) + + pg2 <- newProgressBar def { pgWidth = 100 + , pgOnCompletion = putStr "pg 2 is Done!" + } + _ <- forkIO $ loop pg2 (400 * 1000) + + pg3 <- newProgressBar def { pgWidth = 100 + , pgOnCompletion = putStr "pg 3 is Done!" + } + _ <- forkIO $ loop pg3 (200 * 1000) + + wait $ pgFuture pg1 + wait $ pgFuture pg2 + wait $ pgFuture pg3 + where + loop pg ts = do + b <- isComplete pg + unless b $ do + threadDelay ts + tick pg + loop pg ts diff --git a/lib/System/Console/AsciiProgress.hs b/lib/System/Console/AsciiProgress.hs --- a/lib/System/Console/AsciiProgress.hs +++ b/lib/System/Console/AsciiProgress.hs @@ -11,53 +11,78 @@ , getProgressStrIO , getProgressStats , getProgressStr + , registerLn -- Re-exports: , Default(..) ) where import Control.Applicative ((<$>)) -import Control.Concurrent (readChan, readMVar, writeChan, modifyMVar_) +import Control.Concurrent -- (readChan, readMVar, writeChan, modifyMVar_) import Control.Concurrent.Async (Async, async, poll, wait) import Data.Default (Default(..)) import Data.Maybe (isJust) -import System.Console.ANSI (clearLine, setCursorColumn) +import System.Console.ANSI -- (clearLine, setCursorColumn) import System.IO (BufferMode(..), hSetBuffering, stdout) +import System.IO.Unsafe (unsafePerformIO) import System.Console.AsciiProgress.Internal -data ProgressBar = ProgressBar ProgressBarInfo (Async ()) +data ProgressBar = ProgressBar { pgInfo :: ProgressBarInfo + , pgFuture :: Async () + } +nlines :: MVar Int +nlines = unsafePerformIO (newMVar 0) + +writeLock :: MVar () +writeLock = unsafePerformIO (newMVar ()) + -- | --- Creates a new progress bar with the given @Options@ +-- Registers a new line for multiple progress bars +registerLn :: IO () +registerLn = modifyMVar_ nlines (\n -> return $ n + 1) + +-- | +-- Creates a new progress bar with the given @Options@. Multiple progress bars +-- may be created as long as everytime a line is outputted by your program, +-- while progress bars run is followed by a call to `registerLn` newProgressBar :: Options -> IO ProgressBar newProgressBar opts = do hSetBuffering stdout NoBuffering info <- newProgressBarInfo opts - future <- async $ start info + cnlines <- modifyMVar nlines $ \nl -> return (nl + 1, nl) + putStrLn "" + future <- async $ start info cnlines 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 - -- Update the completed tick count - modifyMVar_ pgCompleted (\c -> return (c + n)) - -- Find and update the current and first tick times: - stats <- getInfoStats info - reset - let progressStr = getProgressStr opts stats + resetCursor = clearLine >> setCursorColumn 0 + unlessDone _ c action | c < pgTotal opts = action + unlessDone cnlines _ _ = atProgressLine cnlines (pgOnCompletion opts) + + atProgressLine cnlines action = do + diff <- (\nl -> nl - cnlines) <$> readMVar nlines + cursorUp diff + resetCursor + action + cursorDown diff + resetCursor + + start info@ProgressBarInfo{..} cnlines = do + c <- readMVar pgCompleted + unlessDone cnlines c $ do + n <- readChan pgChannel + handleMessage info cnlines n + unlessDone cnlines (c + n) $ + start info cnlines + + handleMessage info cnlines n = modifyMVar_ writeLock $ const $ do + -- Update the completed tick count + modifyMVar_ (pgCompleted info) (\c -> return (c + n)) + -- Find and update the current and first tick times: + stats <- getInfoStats info + let progressStr = getProgressStr opts stats + atProgressLine cnlines $ putStr progressStr -- | diff --git a/lib/System/Console/AsciiProgress/Internal.hs b/lib/System/Console/AsciiProgress/Internal.hs --- a/lib/System/Console/AsciiProgress/Internal.hs +++ b/lib/System/Console/AsciiProgress/Internal.hs @@ -29,8 +29,10 @@ -- ^ Total amount of ticks expected , pgWidth :: Int -- ^ The progress bar's width + , pgOnCompletion :: IO () + -- ^ An IO action to be executed on completion, with the + -- cursor set at progress bar's line } - deriving(Eq, Ord, Show) instance Default Options where def = Options { pgFormat = "Working :percent [:bar] :current/:total " ++ @@ -39,6 +41,7 @@ , pgPendingChar = ' ' , pgTotal = 20 , pgWidth = 80 + , pgOnCompletion = return () } -- | @@ -49,7 +52,6 @@ , pgCompleted :: MVar Int , pgFirstTick :: MVar UTCTime } - deriving(Eq) -- | -- Represents a point in time for the progress bar. @@ -77,11 +79,11 @@ getProgressStr Options{..} Stats{..} = replace ":bar" barStr statsStr where statsStr = replaceMany - [ (":elapsed", printf "%3.1f" stElapsed) + [ (":elapsed", printf "%5.1f" stElapsed) , (":current", printf "%3d" stCompleted) , (":total" , printf "%3d" stTotal) , (":percent", printf "%3d%%" (floor (100 * stPercent) :: Int)) - , (":eta" , printf "%3.1f" stEta) + , (":eta" , printf "%5.1f" stEta) ] pgFormat barWidth = pgWidth - length (replace ":bar" "" statsStr) @@ -110,10 +112,9 @@ getBar completedChar pendingChar width percent = replicate bcompleted completedChar ++ replicate bremaining pendingChar where - percentRemaining = 1 - percent fwidth = fromIntegral width bcompleted = ceiling $ fwidth * percent - bremaining = floor $ fwidth * percentRemaining + bremaining = width - bcompleted -- | -- Gets the amount of seconds elapsed between two @UTCTime@s as a double.