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.1.2 +version: 0.3.0.0 synopsis: A simple progress bar for the console. description: A simple Haskell progress bar for the console. Heavily borrows from TJ @@ -29,6 +29,7 @@ exposed-modules: System.Console.AsciiProgress , System.Console.AsciiProgress.Internal build-depends: ansi-terminal + , concurrent-output , async >= 2.0.1.5 , base >=4 && <5 , data-default >= 0.5.3 @@ -38,22 +39,31 @@ executable example main-is: Example.hs - build-depends: ansi-terminal + default-language: Haskell2010 + + if !flag(examples) + buildable: False + else + buildable: True + build-depends: ansi-terminal + , concurrent-output , async >= 2.0.1.5 , base >=4 && <5 , data-default >= 0.5.3 , time >= 1.4.2 - hs-source-dirs: lib + hs-source-dirs: lib , bin - if flag(examples) - buildable: True - else - buildable: False - default-language: Haskell2010 executable download-example main-is: DownloadExample.hs - build-depends: HTTP + default-language: Haskell2010 + + if !flag(examples) + buildable: False + else + buildable: True + build-depends: HTTP + , concurrent-output , ansi-terminal , async >= 2.0.1.5 , base >=4 && <5 @@ -64,33 +74,49 @@ , http-conduit >= 2.1 , http-types >= 0.8 , transformers >= 0.3 - hs-source-dirs: lib + hs-source-dirs: lib , bin - if flag(examples) - buildable: True - else - buildable: False - default-language: Haskell2010 executable multi-example main-is: MultiExample.hs - build-depends: ansi-terminal + default-language: Haskell2010 + + if !flag(examples) + buildable: False + else + buildable: True + build-depends: ansi-terminal + , concurrent-output , async >= 2.0.1.5 , base >=4 && <5 , data-default >= 0.5.3 , time >= 1.4.2 - hs-source-dirs: lib + hs-source-dirs: lib , bin - if flag(examples) - buildable: True - else - buildable: False + +executable crazy-multi-example + main-is: CrazyMultiExample.hs default-language: Haskell2010 + if !flag(examples) + buildable: False + else + buildable: True + build-depends: ansi-terminal + , concurrent-output + , async >= 2.0.1.5 + , base >=4 && <5 + , data-default >= 0.5.3 + , random + , time >= 1.4.2 + hs-source-dirs: lib + , bin + test-suite hspec type: exitcode-stdio-1.0 main-is: Spec.hs build-depends: ansi-terminal + , concurrent-output , async >= 2.0.1.5 , base >=4 && <5 , data-default >= 0.5.3 diff --git a/bin/CrazyMultiExample.hs b/bin/CrazyMultiExample.hs new file mode 100644 --- /dev/null +++ b/bin/CrazyMultiExample.hs @@ -0,0 +1,27 @@ +import Control.Concurrent (forkIO, threadDelay) +import Control.Concurrent.Async (wait) +import Control.Monad (forM, unless) +import System.Console.AsciiProgress +import System.Random (randomRIO) + +main :: IO () +main = displayConsoleRegions $ do + fs <- forM ([0..100] :: [Int]) $ \i -> do + pg <- newProgressBar def { pgWidth = 100 + , pgFormat = "pg " ++ show i ++ " " ++ (pgFormat def) + , pgOnCompletion = Just $ "pg " ++ show i ++ " is Done!" + } + speed <- (* 100000) <$> randomRIO (3, 10) + threadDelay 50000 + _ <- forkIO $ loop pg speed + return $ pgFuture pg + waitAll fs + where + waitAll [] = return () + waitAll (f:fs) = wait f >> waitAll fs + loop pg ts = do + b <- isComplete pg + unless b $ do + threadDelay ts + tick pg + loop pg ts diff --git a/bin/DownloadExample.hs b/bin/DownloadExample.hs --- a/bin/DownloadExample.hs +++ b/bin/DownloadExample.hs @@ -1,17 +1,17 @@ -import Control.Monad.IO.Class (MonadIO, liftIO) -import qualified Data.ByteString as ByteString (length) -import Data.ByteString (ByteString) -import Data.ByteString.Char8 as ByteString (unpack) -import Data.Conduit (ConduitM, ($=+), ($$+-), await, yield) -import Data.Conduit.List (sinkNull) -import Network.HTTP.Conduit (http, parseUrl, responseBody, responseHeaders, - withManager) -import Network.HTTP.Types (hContentLength) -import System.Console.AsciiProgress (ProgressBar, Options(..), complete, def, - newProgressBar, tickN) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.ByteString (ByteString) +import qualified Data.ByteString as ByteString (length) +import Data.ByteString.Char8 as ByteString (unpack) +import Data.Conduit (ConduitM, await, yield, ($$+-), + ($=+)) +import Data.Conduit.List (sinkNull) +import Network.HTTP.Conduit (http, parseUrl, responseBody, + responseHeaders, withManager) +import Network.HTTP.Types (hContentLength) +import System.Console.AsciiProgress main :: IO () -main = withManager $ \manager -> do +main = withManager $ \manager -> displayConsoleRegions $ do -- Start the request req <- parseUrl "https://i.imgur.com/8CJGhZQ.gif" res <- http req manager @@ -19,7 +19,7 @@ let Just cl = lookup hContentLength (responseHeaders res) pg <- liftIO $ newProgressBar def { pgTotal = read (ByteString.unpack cl) , pgWidth = 100 - , pgOnCompletion = putStrLn "Download done" + , pgOnCompletion = Just "Download done" } -- Consume the response updating the progress bar responseBody res $=+ updateProgress pg $$+- sinkNull diff --git a/bin/Example.hs b/bin/Example.hs --- a/bin/Example.hs +++ b/bin/Example.hs @@ -1,11 +1,12 @@ -import Control.Concurrent (threadDelay) -import Control.Monad (unless) -import System.Console.AsciiProgress (Options(..), isComplete, def, - newProgressBar, tick) +import Control.Concurrent (threadDelay) +import Control.Monad (unless) +import System.Console.AsciiProgress main :: IO () -main = do - pg <- newProgressBar def { pgWidth = 100 } +main = displayConsoleRegions $ do + pg <- newProgressBar def { pgWidth = 100 + , pgOnCompletion = Just "Done :percent after :elapsed seconds" + } loop pg where loop pg = do diff --git a/bin/MultiExample.hs b/bin/MultiExample.hs --- a/bin/MultiExample.hs +++ b/bin/MultiExample.hs @@ -1,23 +1,22 @@ -import Control.Concurrent (forkIO, threadDelay) -import Control.Concurrent.Async (wait) -import Control.Monad (unless) -import System.Console.AsciiProgress (ProgressBar(..), Options(..), isComplete, - def, newProgressBar, tick) +import Control.Concurrent (forkIO, threadDelay) +import Control.Concurrent.Async (wait) +import Control.Monad (unless) +import System.Console.AsciiProgress main :: IO () -main = do +main = displayConsoleRegions $ do pg1 <- newProgressBar def { pgWidth = 100 - , pgOnCompletion = putStr "pg 1 is Done!" + , pgOnCompletion = Just "pg 1 is Done!" } _ <- forkIO $ loop pg1 (100 * 1000) pg2 <- newProgressBar def { pgWidth = 100 - , pgOnCompletion = putStr "pg 2 is Done!" + , pgOnCompletion = Just "pg 2 is Done!" } _ <- forkIO $ loop pg2 (400 * 1000) pg3 <- newProgressBar def { pgWidth = 100 - , pgOnCompletion = putStr "pg 3 is Done!" + , pgOnCompletion = Just "pg 3 is Done!" } _ <- forkIO $ loop pg3 (200 * 1000) 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,81 +11,81 @@ , getProgressStrIO , getProgressStats , getProgressStr - , registerLn -- Re-exports: , Default(..) + , module System.Console.Regions ) where -import Control.Applicative ((<$>)) -import Control.Concurrent (MVar, modifyMVar, modifyMVar_, newMVar, readChan, - readMVar, writeChan) -import Control.Concurrent.Async (Async, async, poll, wait) -import Data.Default (Default(..)) -import Data.Maybe (isJust) -import System.Console.ANSI (clearLine, cursorDown, cursorUp, setCursorColumn) -import System.IO (BufferMode(..), hSetBuffering, stdout) -import System.IO.Unsafe (unsafePerformIO) - -import System.Console.AsciiProgress.Internal +import Control.Applicative ((<$>)) +import Control.Concurrent (modifyMVar_, readChan, + readMVar, writeChan) +import Control.Concurrent.Async (Async (..), async, poll, + wait) +import Data.Default (Default (..)) +import Data.Maybe (fromMaybe, isJust) +import System.Console.AsciiProgress.Internal +import System.Console.Regions -data ProgressBar = ProgressBar { pgInfo :: ProgressBarInfo +data ProgressBar = ProgressBar { pgInfo :: ProgressBarInfo , pgFuture :: Async () } -nlines :: MVar Int -nlines = unsafePerformIO (newMVar 0) - -writeLock :: MVar () -writeLock = unsafePerformIO (newMVar ()) - -- | --- 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` +-- may be created. This package depends on `concurrent-output`, so it's -- +-- necessary that progress-bar usage is wrapped with a call to +-- 'displayConsoleRegions'. +-- +-- > import Control.Concurrent (threadDelay) +-- > import Control.Monad (unless) +-- > import System.Console.AsciiProgress +-- > +-- > main :: IO () +-- > main = do +-- > pg <- newProgressBar def { pgWidth = 100 +-- > , pgOnCompletion = Just "Done :percent after :elapsed seconds" +-- > } +-- > loop pg +-- > where +-- > loop pg = do +-- > b <- isComplete pg +-- > unless b $ do +-- > threadDelay $ 200 * 1000 +-- > tick pg +-- > loop pg newProgressBar :: Options -> IO ProgressBar newProgressBar opts = do - hSetBuffering stdout NoBuffering + region <- openConsoleRegion Linear info <- newProgressBarInfo opts - cnlines <- modifyMVar nlines $ \nl -> return (nl + 1, nl) - atProgressLine cnlines $ - getProgressStr opts <$> getInfoStats info >>= putStrLn - future <- async $ start info cnlines - return $ ProgressBar info future - where - 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 + -- Display initial progress-bar + pgStr <- getProgressStr opts <$> getInfoStats info + setConsoleRegion region pgStr - start info@ProgressBarInfo{..} cnlines = do + future <- async $ start info region + return $ ProgressBar info future + where + start info@ProgressBarInfo{..} region = do c <- readMVar pgCompleted - unlessDone cnlines c $ do + unlessDone c $ do n <- readChan pgChannel - handleMessage info cnlines n - unlessDone cnlines (c + n) $ - start info cnlines + _ <- handleMessage info region n + unlessDone (c + n) $ start info region + where + unlessDone c action | c < pgTotal opts = action + unlessDone _ _ = do + let fmt = fromMaybe (pgFormat opts) (pgOnCompletion opts) + onCompletion <- getProgressStr opts { pgFormat = fmt } <$> getInfoStats info + setConsoleRegion region onCompletion - handleMessage info cnlines n = modifyMVar_ writeLock $ const $ do + handleMessage info region n = 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 + setConsoleRegion region progressStr -- | -- Tick the progress bar 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 @@ -1,19 +1,20 @@ +{-# LANGUAGE MagicHash #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE MagicHash, UnboxedTuples #-} +{-# LANGUAGE UnboxedTuples #-} module System.Console.AsciiProgress.Internal where -import Control.Concurrent (Chan, newChan, newEmptyMVar, newMVar, - readMVar, tryPutMVar) -import Data.Default (Default(..)) -import Data.Time.Clock -import GHC.Base (IO(..), tryReadMVar#) -import GHC.MVar (MVar(..)) -import Text.Printf +import Control.Concurrent (Chan, newChan, newEmptyMVar, newMVar, + readMVar, tryPutMVar) +import Data.Default (Default (..)) +import Data.Time.Clock +import GHC.Base (IO (..), tryReadMVar#) +import GHC.MVar (MVar (..)) +import Text.Printf -- | -- The progress bar's options. -data Options = Options { pgFormat :: String +data Options = Options { pgFormat :: String -- ^ A format string for the progress bar. Currently the -- following format strings are supported: -- - ":eta" (ETA displayed in seconds) @@ -25,15 +26,14 @@ , pgCompletedChar :: Char -- ^ Character to be used on the completed part of the -- bar - , pgPendingChar :: Char + , pgPendingChar :: Char -- ^ Character to be used on the pending part of the bar - , pgTotal :: Int + , pgTotal :: Int -- ^ Total amount of ticks expected - , pgWidth :: Int + , 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 + , pgOnCompletion :: Maybe String + -- ^ What to output when the progress bar is done } instance Default Options where @@ -43,26 +43,26 @@ , pgPendingChar = ' ' , pgTotal = 20 , pgWidth = 80 - , pgOnCompletion = return () + , pgOnCompletion = Nothing } -- | -- The progress bar's state object. Contains all but the printing thread's -- @Async@ object. -data ProgressBarInfo = ProgressBarInfo { pgOptions :: Options - , pgChannel :: Chan Int +data ProgressBarInfo = ProgressBarInfo { pgOptions :: Options + , pgChannel :: Chan Int , pgCompleted :: MVar Int , pgFirstTick :: MVar UTCTime } -- | -- Represents a point in time for the progress bar. -data Stats = Stats { stTotal :: Int +data Stats = Stats { stTotal :: Int , stCompleted :: Int , stRemaining :: Int - , stElapsed :: Double - , stPercent :: Double - , stEta :: Double + , stElapsed :: Double + , stPercent :: Double + , stEta :: Double } -- | @@ -132,6 +132,7 @@ -- >>> getEta 30 70 23.3 -- 54.366666666666674 getEta :: Int -> Int -> Double -> Double +getEta 0 _ _ = 0 getEta completed remaining elapsed = averageSecsPerTick * fromIntegral remaining where averageSecsPerTick = elapsed / fromIntegral completed