ascii-progress 0.2.0.0 → 0.2.1.0

raw patch · 4 files changed

+108/−33 lines, 4 filesdep +QuickChecknew-component:exe:multi-examplePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: QuickCheck

API changes (from Hackage documentation)

Files

• ascii-progress.cabal +17/−1
• bin/MultiExample.hs +33/−0
• lib/System/Console/AsciiProgress.hs +51/−26
• lib/System/Console/AsciiProgress/Internal.hs +7/−6

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

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

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

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