ascii-progress 0.2.1.2 → 0.3.0.0

raw patch · 7 files changed

+176/−122 lines, 7 filesdep +concurrent-outputdep +randomdep ~ansi-terminaldep ~asyncdep ~basenew-component:exe:crazy-multi-examplePVP ok

version bump matches the API change (PVP)

Dependencies added: concurrent-output, random

Dependency ranges changed: ansi-terminal, async, base, data-default, time

API changes (from Hackage documentation)

Files

• ascii-progress.cabal +47/−21
• bin/CrazyMultiExample.hs +27/−0
• bin/DownloadExample.hs +13/−13
• bin/Example.hs +7/−6
• bin/MultiExample.hs +8/−9
• lib/System/Console/AsciiProgress.hs +51/−51
• lib/System/Console/AsciiProgress/Internal.hs +23/−22

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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) 

@@ -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

@@ -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