Hello community,
here is the log from the commit of package ghc-terminal-progress-bar for
openSUSE:Factory checked in at 2017-03-14 10:06:03
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-terminal-progress-bar (Old)
and /work/SRC/openSUSE:Factory/.ghc-terminal-progress-bar.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-terminal-progress-bar"
Tue Mar 14 10:06:03 2017 rev:2 rq:461687 version:0.1.1
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-terminal-progress-bar/ghc-terminal-progress-bar.changes
2017-02-03 17:40:12.043473520 +0100
+++
/work/SRC/openSUSE:Factory/.ghc-terminal-progress-bar.new/ghc-terminal-progress-bar.changes
2017-03-14 10:06:04.288417434 +0100
@@ -1,0 +2,5 @@
+Sun Feb 12 14:18:12 UTC 2017 - [email protected]
+
+- Update to version 0.1.1 with cabal2obs.
+
+-------------------------------------------------------------------
Old:
----
terminal-progress-bar-0.0.1.4.tar.gz
New:
----
terminal-progress-bar-0.1.1.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-terminal-progress-bar.spec ++++++
--- /var/tmp/diff_new_pack.ZlmSLZ/_old 2017-03-14 10:06:04.788346643 +0100
+++ /var/tmp/diff_new_pack.ZlmSLZ/_new 2017-03-14 10:06:04.788346643 +0100
@@ -1,7 +1,7 @@
#
# spec file for package ghc-terminal-progress-bar
#
-# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -19,16 +19,14 @@
%global pkg_name terminal-progress-bar
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.0.1.4
+Version: 0.1.1
Release: 0
Summary: A simple progress bar in the terminal
License: BSD-3-Clause
-Group: System/Libraries
+Group: Development/Languages/Other
Url: https://hackage.haskell.org/package/%{pkg_name}
Source0:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
BuildRequires: ghc-Cabal-devel
-# Begin cabal-rpm deps:
-BuildRequires: ghc-base-unicode-symbols-devel
BuildRequires: ghc-rpm-macros
BuildRequires: ghc-stm-chans-devel
BuildRequires: ghc-stm-devel
@@ -38,7 +36,6 @@
BuildRequires: ghc-test-framework-devel
BuildRequires: ghc-test-framework-hunit-devel
%endif
-# End cabal-rpm deps
%description
A progress bar is used to convey the progress of a task. This package
@@ -51,10 +48,6 @@
carriage return character ('\r'). If your terminal interprets it as something
else then "move cursor to beginning of line", the animation won't work.
-Note: Due to a bug in "cabal haddock" you will have to manually uncomment the
-example section in the cabal file. But uncommenting that section will result in
-"cabal haddock" failing.
-
%package devel
Summary: Haskell %{pkg_name} library development files
Group: Development/Libraries/Other
@@ -70,20 +63,14 @@
%prep
%setup -q -n %{pkg_name}-%{version}
-
%build
%ghc_lib_build
-
%install
%ghc_lib_install
-
%check
-%if %{with tests}
-%{cabal} test
-%endif
-
+%cabal_test
%post devel
%ghc_pkg_recache
@@ -97,6 +84,6 @@
%files devel -f %{name}-devel.files
%defattr(-,root,root,-)
-%doc README.markdown
+%doc README.markdown example.hs
%changelog
++++++ terminal-progress-bar-0.0.1.4.tar.gz ->
terminal-progress-bar-0.1.1.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/terminal-progress-bar-0.0.1.4/LICENSE
new/terminal-progress-bar-0.1.1/LICENSE
--- old/terminal-progress-bar-0.0.1.4/LICENSE 2014-04-14 17:52:48.000000000
+0200
+++ new/terminal-progress-bar-0.1.1/LICENSE 2016-10-03 10:55:09.000000000
+0200
@@ -1,4 +1,4 @@
-Copyright 2012–2014 Roel van Dijk
+Copyright 2012–2016 Roel van Dijk
All rights reserved.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/terminal-progress-bar-0.0.1.4/example.hs
new/terminal-progress-bar-0.1.1/example.hs
--- old/terminal-progress-bar-0.0.1.4/example.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/terminal-progress-bar-0.1.1/example.hs 2016-10-03 10:55:09.000000000
+0200
@@ -0,0 +1,28 @@
+{-# LANGUAGE PackageImports #-}
+
+module Main where
+
+import "base" Control.Concurrent ( threadDelay )
+import "base" Control.Monad ( forM_ )
+import "terminal-progress-bar" System.ProgressBar
+ ( progressBar, percentage, exact, startProgress, incProgress )
+
+main :: IO ()
+main = do
+ example 60 (13 + 60) 25000
+ example' 60 (13 + 60) 25000
+
+example :: Integer -> Integer -> Int -> IO ()
+example t w delay = do
+ forM_ [1..t] $ \d -> do
+ progressBar percentage exact w d t
+ threadDelay delay
+ putStrLn ""
+
+example' :: Integer -> Integer -> Int -> IO ()
+example' t w delay = do
+ (pr, _) <- startProgress percentage exact w t
+ forM_ [1..t] $ \_d -> do
+ incProgress pr 1
+ threadDelay delay
+ putStrLn ""
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/terminal-progress-bar-0.0.1.4/src/System/ProgressBar.hs
new/terminal-progress-bar-0.1.1/src/System/ProgressBar.hs
--- old/terminal-progress-bar-0.0.1.4/src/System/ProgressBar.hs 2014-04-14
17:52:48.000000000 +0200
+++ new/terminal-progress-bar-0.1.1/src/System/ProgressBar.hs 2016-10-03
10:55:09.000000000 +0200
@@ -1,8 +1,10 @@
-{-# LANGUAGE NoImplicitPrelude, PackageImports, NamedFieldPuns,
RecordWildCards, UnicodeSyntax #-}
+{-# language PackageImports, NamedFieldPuns, RecordWildCards #-}
module System.ProgressBar
( -- * Progress bars
- progressBar
+ ProgressBar
+ , progressBar
+ , hProgressBar
, mkProgressBar
-- * Labels
, Label
@@ -10,77 +12,69 @@
, msg
, percentage
, exact
- -- * auto-printing
+ -- * Auto printing
, ProgressRef
, startProgress
, incProgress
) where
-import "base" Control.Monad ( (=<<), (>>), return, when )
-import "base" Data.Bool ( otherwise )
-import "base" Data.Function ( ($), (.) )
-import "base" Data.List ( null, length, genericLength, genericReplicate )
-import "base" Data.Maybe ( maybe )
-import "base" Data.Ord ( min, max, (>=) )
+import "base" Control.Monad ( when )
+import "base" Data.List ( genericLength, genericReplicate )
import "base" Data.Ratio ( (%) )
-import "base" Data.String ( String )
-import "base" Prelude ( (+), (-), round, floor, Bool(..) )
-import "base" System.IO ( IO, putStr, putChar )
+import "base" System.IO ( Handle, stderr, hPutChar, hPutStr, hFlush )
import "base" Text.Printf ( printf )
-import "base" Text.Show ( show )
-import "base" Control.Concurrent ( ThreadId, forkIO )
-import "stm" Control.Concurrent.STM ( TVar, readTVar, writeTVar, newTVar,
atomically, STM )
-import "stm-chans" Control.Concurrent.STM.TMQueue ( TMQueue, readTMQueue,
closeTMQueue, writeTMQueue, newTMQueue )
-import "base-unicode-symbols" Data.Bool.Unicode ( (∧) )
-import "base-unicode-symbols" Data.Eq.Unicode ( (≢) )
-import "base-unicode-symbols" Prelude.Unicode ( ℤ, ℚ, (⋅) )
+import "base" Control.Concurrent ( ThreadId, forkIO )
+import "stm" Control.Concurrent.STM
+ ( TVar, readTVar, writeTVar, newTVar, atomically, STM )
+import "stm-chans" Control.Concurrent.STM.TMQueue
+ ( TMQueue, readTMQueue, closeTMQueue, writeTMQueue, newTMQueue )
+
+-- | Type of functions producing a progress bar.
+type ProgressBar a
+ = Label -- ^ Prefixed label.
+ -> Label -- ^ Postfixed label.
+ -> Integer -- ^ Total progress bar width in characters.
+ -> Integer -- ^ Amount of work completed.
+ -> Integer -- ^ Total amount of work.
+ -> a
+
+-- | Print a progress bar to 'stderr'
+--
+-- See 'hProgressBar'.
+progressBar :: ProgressBar (IO ())
+progressBar = hProgressBar stderr
-
--- | Print a progress bar
+-- | Print a progress bar to a file handle.
--
-- Erases the current line! (by outputting '\r') Does not print a
-- newline '\n'. Subsequent invocations will overwrite the previous
-- output.
---
--- Remember to set the correct buffering mode for stdout:
---
--- > import System.IO ( hSetBuffering, BufferMode(NoBuffering), stdout )
--- > hSetBuffering stdout NoBuffering
-progressBar ∷ Label -- ^ Prefixed label.
- → Label -- ^ Postfixed label.
- → ℤ -- ^ Total progress bar width in characters.
- → ℤ -- ^ Amount of work completed.
- → ℤ -- ^ Total amount of work.
- → IO ()
-progressBar mkPreLabel mkPostLabel width todo done = do
- putChar '\r'
- putStr $ mkProgressBar mkPreLabel mkPostLabel width todo done
+hProgressBar :: Handle -> ProgressBar (IO ())
+hProgressBar hndl mkPreLabel mkPostLabel width todo done = do
+ hPutChar hndl '\r'
+ hPutStr hndl $ mkProgressBar mkPreLabel mkPostLabel width todo done
+ hFlush hndl
-- | Renders a progress bar
--
-- >>> mkProgressBar (msg "Working") percentage 40 30 100
-- "Working [=======>.................] 30%"
-mkProgressBar ∷ Label -- ^ Prefixed label.
- → Label -- ^ Postfixed label.
- → ℤ -- ^ Total progress bar width in characters.
- → ℤ -- ^ Amount of work completed.
- → ℤ -- ^ Total amount of work.
- → String
+mkProgressBar :: ProgressBar String
mkProgressBar mkPreLabel mkPostLabel width todo done =
printf "%s%s[%s%s%s]%s%s"
preLabel
prePad
(genericReplicate completed '=')
- (if remaining ≢ 0 ∧ completed ≢ 0 then ">" else "")
- (genericReplicate (remaining - if completed ≢ 0 then 1 else 0)
+ (if remaining /= 0 && completed /= 0 then ">" else "")
+ (genericReplicate (remaining - if completed /= 0 then 1 else 0)
'.'
)
postPad
postLabel
where
-- Amount of work completed.
- fraction ∷ ℚ
- fraction | done ≢ 0 = todo % done
+ fraction :: Rational
+ fraction | done /= 0 = todo % done
| otherwise = 0 % 1
-- Amount of characters available to visualize the progress.
@@ -93,41 +87,44 @@
-- Number of characters needed to represent the amount of work
-- that is completed. Note that this can not always be represented
-- by an integer.
- numCompletedChars ∷ ℚ
- numCompletedChars = fraction ⋅ (effectiveWidth % 1)
+ numCompletedChars :: Rational
+ numCompletedChars = fraction * (effectiveWidth % 1)
- completed, remaining ∷ ℤ
+ completed, remaining :: Integer
completed = min effectiveWidth $ floor numCompletedChars
remaining = effectiveWidth - completed
- preLabel, postLabel ∷ String
+ preLabel, postLabel :: String
preLabel = mkPreLabel todo done
postLabel = mkPostLabel todo done
- prePad, postPad ∷ String
+ prePad, postPad :: String
prePad = pad preLabel
postPad = pad postLabel
- pad ∷ String → String
+ pad :: String -> String
pad s | null s = ""
| otherwise = " "
-- | A label that can be pre- or postfixed to a progress bar.
-type Label = ℤ → ℤ → String
+type Label
+ = Integer -- ^ Completed amount of work.
+ -> Integer -- ^ Total amount of work.
+ -> String -- ^ Resulting label.
-- | The empty label.
--
-- >>> noLabel 30 100
-- ""
-noLabel ∷ Label
+noLabel :: Label
noLabel = msg ""
-- | A label consisting of a static string.
--
-- >>> msg "foo" 30 100
-- "foo"
-msg ∷ String → Label
+msg :: String -> Label
msg s _ _ = s
-- | A label which displays the progress as a percentage.
@@ -138,9 +135,9 @@
-- >>> percentage 30 100
-- " 30%"
--- ∀ d t : ℕ. d ≤ t → length (percentage d t) ≡ 3
-percentage ∷ Label
-percentage done todo = printf "%3i%%" (round (done % todo ⋅ 100) ∷ ℤ)
+-- ∀ d t : ℕ. d ≤ t -> length (percentage d t) ≡ 3
+percentage :: Label
+percentage done todo = printf "%3i%%" (round (done % todo * 100) :: Integer)
-- | A label which displays the progress as a fraction of the total
-- amount of work.
@@ -151,28 +148,32 @@
-- >>> exact 30 100
-- " 30/100"
--- ∀ d₁ d₂ t : ℕ. d₁ ≤ d₂ ≤ t → length (exact d₁ t) ≡ length (exact d₂ t)
-exact ∷ Label
+-- ∀ d₁ d₂ t : ℕ. d₁ ≤ d₂ ≤ t -> length (exact d₁ t) ≡ length (exact d₂ t)
+exact :: Label
exact done total = printf "%*i/%s" (length totalStr) done totalStr
where
totalStr = show total
-- * Auto-Printing Progress
-data ProgressRef = ProgressRef { prPrefix ∷ Label
- , prPostfix ∷ Label
- , prWidth ∷ ℤ
- , prCompleted ∷ TVar ℤ
- , prTotal ∷ ℤ
- , prQueue ∷ TMQueue ℤ }
+data ProgressRef
+ = ProgressRef
+ { prPrefix :: Label
+ , prPostfix :: Label
+ , prWidth :: Integer
+ , prCompleted :: TVar Integer
+ , prTotal :: Integer
+ , prQueue :: TMQueue Integer
+ }
-- | Start a thread to automatically display progress. Use incProgress to step
-- the progress bar.
-startProgress ∷ Label -- ^ Prefixed label.
- → Label -- ^ Postfixed label.
- → ℤ -- ^ Total progress bar width in characters.
- → ℤ -- ^ Total amount of work.
- → IO (ProgressRef, ThreadId)
+startProgress
+ :: Label -- ^ Prefixed label.
+ -> Label -- ^ Postfixed label.
+ -> Integer -- ^ Total progress bar width in characters.
+ -> Integer -- ^ Total amount of work.
+ -> IO (ProgressRef, ThreadId)
startProgress mkPreLabel mkPostLabel width total = do
pr <- buildProgressRef
tid <- forkIO $ reportProgress pr
@@ -184,36 +185,32 @@
return $ ProgressRef mkPreLabel mkPostLabel width completed total queue
-- | Increment the progress bar. Negative values will reverse the progress.
--- Progress will never be negative and will silently stop taking data when it
--- completes.
-incProgress ∷ ProgressRef
- → ℤ
- → IO ()
-incProgress ProgressRef {prQueue} = atomically . writeTMQueue prQueue
+-- Progress will never be negative and will silently stop taking data
+-- when it completes.
+incProgress :: ProgressRef -> Integer -> IO ()
+incProgress progressRef =
+ atomically . writeTMQueue (prQueue progressRef)
-reportProgress ∷ ProgressRef
- → IO ()
+reportProgress :: ProgressRef -> IO ()
reportProgress pr = do
- continue <- atomically $ updateProgress pr
- renderProgress pr
- when continue $ reportProgress pr
+ continue <- atomically $ updateProgress pr
+ renderProgress pr
+ when continue $ reportProgress pr
-updateProgress ∷ ProgressRef
- → STM Bool
+updateProgress :: ProgressRef -> STM Bool
updateProgress ProgressRef {prCompleted, prQueue, prTotal} = do
- maybe dontContinue doUpdate =<< readTMQueue prQueue
- where
- dontContinue = return False
- doUpdate countDiff = do
- count <- readTVar prCompleted
- let newCount = min prTotal $ max 0 $ count + countDiff
- writeTVar prCompleted newCount
- if newCount >= prTotal
- then closeTMQueue prQueue >> dontContinue
- else return True
-
-renderProgress ∷ ProgressRef
- → IO ()
+ maybe dontContinue doUpdate =<< readTMQueue prQueue
+ where
+ dontContinue = return False
+ doUpdate countDiff = do
+ count <- readTVar prCompleted
+ let newCount = min prTotal $ max 0 $ count + countDiff
+ writeTVar prCompleted newCount
+ if newCount >= prTotal
+ then closeTMQueue prQueue >> dontContinue
+ else return True
+
+renderProgress :: ProgressRef -> IO ()
renderProgress ProgressRef {..} = do
- completed <- atomically $ readTVar prCompleted
- progressBar prPrefix prPostfix prWidth completed prTotal
+ completed <- atomically $ readTVar prCompleted
+ progressBar prPrefix prPostfix prWidth completed prTotal
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/terminal-progress-bar-0.0.1.4/terminal-progress-bar.cabal
new/terminal-progress-bar-0.1.1/terminal-progress-bar.cabal
--- old/terminal-progress-bar-0.0.1.4/terminal-progress-bar.cabal
2014-04-14 17:52:48.000000000 +0200
+++ new/terminal-progress-bar-0.1.1/terminal-progress-bar.cabal 2016-10-03
10:55:09.000000000 +0200
@@ -1,6 +1,6 @@
name: terminal-progress-bar
-version: 0.0.1.4
-cabal-version: >=1.8
+version: 0.1.1
+cabal-version: >=1.10
build-type: Simple
stability: provisional
author: Roel van Dijk <[email protected]>
@@ -24,10 +24,6 @@
the carriage return character (\'\\r\'). If your terminal interprets
it as something else then \"move cursor to beginning of line\", the
animation won't work.
- .
- Note: Due to a bug in \"cabal haddock\" you will have to manually
- uncomment the example section in the cabal file. But uncommenting
- that section will result in \"cabal haddock\" failing.
extra-source-files: LICENSE, README.markdown
@@ -42,32 +38,33 @@
library
hs-source-dirs: src
build-depends: base >= 3.0.3.1 && < 5.0
- , base-unicode-symbols >= 0.2.2.3 && < 0.3
, stm >= 2.4 && < 3.0
, stm-chans >= 3.0.0 && < 4.0
exposed-modules: System.ProgressBar
ghc-options: -Wall
+ default-language: Haskell2010
-test-suite test-terminal-progress-bar
- type: exitcode-stdio-1.0
- main-is: test.hs
- hs-source-dirs: test
- ghc-options: -Wall
- build-depends: base >= 3.0.3.1 && < 5.0
- , base-unicode-symbols >= 0.2.2.3 && < 0.3
- , HUnit >= 1.2.4.2 && < 1.3
- , terminal-progress-bar
- , test-framework >= 0.3.3 && < 0.9
- , test-framework-hunit >= 0.2.6 && < 0.4
-
--- executable example
--- main-is: example.hs
--- hs-source-dirs: .
--- if flag(example)
--- build-depends: base >= 3.0.3.1 && < 4.6
--- , base-unicode-symbols >= 0.2.2.3 && < 0.3
--- , terminal-progress-bar == 0.0.1
--- buildable: True
--- else
--- buildable: False
+test-suite test-terminal-progress-bar
+ type: exitcode-stdio-1.0
+ main-is: test.hs
+ hs-source-dirs: test
+ ghc-options: -Wall
+ build-depends: base >= 3.0.3.1 && < 5.0
+ , HUnit >= 1.2.4.2 && < 1.4
+ , terminal-progress-bar == 0.1.0
+ , test-framework >= 0.3.3 && < 0.9
+ , test-framework-hunit >= 0.2.6 && < 0.4
+ default-language: Haskell2010
+
+executable example
+ main-is: example.hs
+ hs-source-dirs: .
+ ghc-options: -Wall
+ if flag(example)
+ build-depends: base >= 3.0.3.1 && < 5.0
+ , terminal-progress-bar == 0.1.0
+ buildable: True
+ else
+ buildable: False
+ default-language: Haskell2010
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/terminal-progress-bar-0.0.1.4/test/test.hs
new/terminal-progress-bar-0.1.1/test/test.hs
--- old/terminal-progress-bar-0.0.1.4/test/test.hs 2014-04-14
17:52:48.000000000 +0200
+++ new/terminal-progress-bar-0.1.1/test/test.hs 2016-10-03
10:55:09.000000000 +0200
@@ -1,18 +1,12 @@
-{-# LANGUAGE NoImplicitPrelude, PackageImports, UnicodeSyntax #-}
+{-# language PackageImports #-}
module Main where
-
--------------------------------------------------------------------------------
-- Imports
--------------------------------------------------------------------------------
-import "base" Control.Monad ( (=<<) )
-import "base" Data.Function ( ($) )
-import "base" Prelude ( String )
import "base" System.Environment ( getArgs )
-import "base" System.IO ( IO )
-import "base-unicode-symbols" Prelude.Unicode ( ℤ )
import "HUnit" Test.HUnit.Base ( assertEqual )
import "test-framework" Test.Framework
( defaultMainWithOpts, interpretArgsOrExit, Test, testGroup )
@@ -24,11 +18,11 @@
-- Test suite
--------------------------------------------------------------------------------
-main ∷ IO ()
-main = do opts ← interpretArgsOrExit =<< getArgs
+main :: IO ()
+main = do opts <- interpretArgsOrExit =<< getArgs
defaultMainWithOpts tests opts
-tests ∷ [Test]
+tests :: [Test]
tests =
[ testGroup "Label padding"
[ eqTest "no labels" "[]" noLabel noLabel 0 0 0
@@ -60,10 +54,9 @@
]
]
-eqTest ∷ String → String → Label → Label → ℤ → ℤ → ℤ → Test
+eqTest :: String -> String -> Label -> Label -> Integer -> Integer -> Integer
-> Test
eqTest name expected mkPreLabel mkPostLabel width todo done =
testCase name $ assertEqual errMsg expected actual
where
actual = mkProgressBar mkPreLabel mkPostLabel width todo done
errMsg = "Expected result doesn't match actual result"
-
