bytestring-progress-1.0.7/0000755000000000000000000000000012774311731013747 5ustar0000000000000000bytestring-progress-1.0.7/bytestring-progress.cabal0000644000000000000000000000220512774311731020766 0ustar0000000000000000Name: bytestring-progress Version: 1.0.7 Build-Type: Simple Cabal-Version: >= 1.6 License: BSD3 License-File: LICENSE Author: Adam Wick Maintainer: Adam Wick Homepage: http://github.com/acw/bytestring-progress Category: Control Synopsis: A library for tracking the consumption of a lazy ByteString Description: In some cases, it is useful to know how fast a ByteString is being consumed. Typically, this could be to report some measure of progress to a waiting user, but it could also be to perform some form of testing on input / consumption code. data-files: Example.hs Flag use-system-progressbar Description: Enable integration with the terminal-progress-bar library. Default: True Library Build-Depends: base >= 4.0 && < 5.0, time >= 1.1 && < 1.8, bytestring >= 0.9 && < 1.0 Exposed-Modules: Data.ByteString.Lazy.Progress if flag(use-system-progressbar) Build-Depends: terminal-progress-bar >= 0.0.1 && < 0.2.0 Exposed-Modules: System.ProgressBar.ByteString source-repository head type: git location: http://github.com/acw/bytestring-progress bytestring-progress-1.0.7/Example.hs0000644000000000000000000000511712774311731015702 0ustar0000000000000000import Network.HTTP (simpleHTTP, Request, mkRequest) import Network.HTTP.Base (Response(..), RequestMethod(..)) import Network.HTTP.Headers (HeaderName(..), findHeader) import Network.Stream (ConnError) import Network.URI (parseURI) import Data.ByteString.Lazy.Progress (trackProgressString) import qualified Data.ByteString.Lazy as BS import System.IO (openBinaryFile, hClose, IOMode(..)) import System.IO (stderr) import System.Environment (getArgs) import System.ProgressBar (msg,noLabel) import System.ProgressBar.ByteString (mkByteStringProgressWriter) import System.ProgressBar.ByteString (fileReadProgressWriter) downloadFile :: String -> FilePath -> IO () downloadFile url path = do fhndl <- openBinaryFile path WriteMode http <- simpleHTTP dbReq case http of Left x -> fail $ "Couldn't download file: " ++ show x Right resp -> do let size = read `fmap` findHeader HdrContentLength resp putStrLn $ "Total size is " ++ show size ++ " bytes." track <- trackProgressString formatStr size handler track (rspBody resp) >>= BS.hPut fhndl hClose fhndl putStrLn "Done!" where dbReq = mkRequest GET link Just link = parseURI url formatStr = "\r Downloading file ... %p (%R, estimated done in %T)" handler = putStr downloadFile' :: String -> FilePath -> IO () downloadFile' url path = do fhndl <- openBinaryFile path WriteMode http <- simpleHTTP dbReq case http of Left x -> fail $ "Couldn't download file: " ++ show x Right resp -> do let Just size = read `fmap` findHeader HdrContentLength resp putStrLn $ "Total size is " ++ show size ++ " bytes." mkByteStringProgressWriter (rspBody resp) stderr 72 (fromIntegral size) (msg "Downloading: ") noLabel >>= BS.hPut fhndl hClose fhndl putStrLn "Done!" where dbReq = mkRequest GET link Just link = parseURI url formatStr = "\r Downloading file ... %p (%R, estimated done in %T)" handler = putStr main :: IO () main = do downloadFile' "http://ftp.ndlug.nd.edu/pub/fedora/linux/releases/16/Fedora/x86_64/iso/Fedora-16-x86_64-netinst.iso" "foo.iso" bs <- fileReadProgressWriter "foo.iso" stderr 78 (msg "Checksum comp: ") noLabel let checksum = BS.foldl' (+) 0 bs putStrLn $ "Checksum: " ++ show checksum downloadFile "http://ftp.ndlug.nd.edu/pub/fedora/linux/releases/16/Fedora/x86_64/iso/Fedora-16-x86_64-netinst.iso" "foo.iso" bytestring-progress-1.0.7/LICENSE0000644000000000000000000000271712774311731014763 0ustar0000000000000000Copyright (c) 2011 Adam Wick All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name Adam Wick nor the names of any contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. bytestring-progress-1.0.7/Setup.hs0000644000000000000000000000005612774311731015404 0ustar0000000000000000import Distribution.Simple main = defaultMain bytestring-progress-1.0.7/Data/0000755000000000000000000000000012774311731014620 5ustar0000000000000000bytestring-progress-1.0.7/Data/ByteString/0000755000000000000000000000000012774311731016712 5ustar0000000000000000bytestring-progress-1.0.7/Data/ByteString/Lazy/0000755000000000000000000000000012774311731017631 5ustar0000000000000000bytestring-progress-1.0.7/Data/ByteString/Lazy/Progress.hs0000644000000000000000000001646112774311731022001 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} -- |This module defines core functions for tracking the consumption of a -- ByteString, as well as several helper functions for making tracking -- ByteStrings easier. module Data.ByteString.Lazy.Progress( trackProgress , trackProgressWithChunkSize -- , trackProgressString , trackProgressStringWithChunkSize -- , bytesToUnittedStr ) where import Control.Applicative ((<$>)) import qualified Data.ByteString as BSS import Data.ByteString.Lazy(ByteString) import qualified Data.ByteString.Lazy as BS import Data.Maybe (isJust) import Data.Time.Clock (getCurrentTime,diffUTCTime,UTCTime) import Data.Word (Word64) import System.IO.Unsafe (unsafeInterleaveIO) -- |Given a function, return a bytestring that will call that function when it -- is partially consumed. The Words provided to the function will be the number -- of bytes that were just consumed and the total bytes consumed thus far. trackProgress :: (Word64 -> Word64 -> IO ()) -> ByteString -> IO ByteString trackProgress tracker inputBS = BS.fromChunks <$> runTrack 0 (BS.toChunks inputBS) where runTrack _ [] = return [] runTrack x (fst:rest) = unsafeInterleaveIO $ do let amtRead = fromIntegral $ BSS.length fst tracker amtRead (x + amtRead) (fst :) <$> runTrack (x + amtRead) rest -- |Works like 'trackProgress', except uses fixed-size chunks of the given -- size. Thus, for this function, the first number passed to your function -- will always be the given size *except* for the last call to the function, -- which will be less then or equal to the final size. trackProgressWithChunkSize :: Word64 -> (Word64 -> Word64 -> IO ()) -> ByteString -> IO ByteString trackProgressWithChunkSize chunkSize tracker inputBS = runLoop 0 inputBS where runLoop x bstr | BS.null bstr = return BS.empty | otherwise = unsafeInterleaveIO $ do let (first,rest) = BS.splitAt (fromIntegral chunkSize) bstr amtRead = fromIntegral (BS.length first) tracker amtRead (x + amtRead) (first `BS.append`) <$> runLoop (x + amtRead) rest -- |Given a format string (described below), track the progress of a function. -- The argument to the callback will be the string expanded with the given -- progress information. -- -- Format string items: -- -- * %b is the number of bytes read -- -- * %B is the number of bytes read, formatted into a human-readable string -- -- * %c is the size of the last chunk read -- -- * %C is the size of the last chunk read, formatted human-readably -- -- * %r is the rate in bytes per second -- -- * %R is the rate, formatted human-readably -- -- * %% is the character '%' -- -- If you provide a total size (the maybe argument, in bytes), then you may -- also use the following items: -- -- * %t is the estimated time to completion in seconds -- -- * %T is the estimated time to completion, formatted as HH:MM:SS -- -- * %p is the percentage complete -- trackProgressString :: String -> Maybe Word64 -> (String -> IO ()) -> IO (ByteString -> IO ByteString) trackProgressString formatStr mTotal tracker = do startTime <- getCurrentTime return (trackProgress (handler startTime)) where handler startTime chunkSize total = do now <- getCurrentTime tracker (buildString formatStr startTime now mTotal chunkSize total) -- |Exactly as 'trackProgressString', but use the given chunkSize instead -- of the default chunk size. trackProgressStringWithChunkSize :: String -- ^the format string -> Word64 -- ^the chunk size -> Maybe Word64 -- ^total size (opt.) -> (String -> IO ()) -- ^the action -> IO (ByteString -> IO ByteString) trackProgressStringWithChunkSize formatStr chunk mTotal tracker = do startTime <- getCurrentTime return (trackProgressWithChunkSize chunk (handler startTime)) where handler startTime chunkSize total = do now <- getCurrentTime tracker (buildString formatStr startTime now mTotal chunkSize total) -- build a progress string for trackProgressString et al buildString :: String -> UTCTime -> UTCTime -> Maybe Word64 -> Word64 -> Word64 -> String buildString form startTime curTime mTotal chunkSize amtRead = subPercents form where per_b = show amtRead per_B = bytesToUnittedStr amtRead per_c = show chunkSize per_C = bytesToUnittedStr chunkSize diff = max 1 (round $ toRational $ diffUTCTime curTime startTime) rate = amtRead `div` diff per_r = show rate per_R = bytesToUnittedStr rate ++ "ps" total = case mTotal of Just t -> t Nothing -> error "INTERNAL ERROR (needed total w/ Nothing)" tleft = (total - amtRead) `div` rate per_t = show tleft hLeft = tleft `div` (60 * 60) mLeft = (tleft `div` 60) `mod` 60 sLeft = tleft `mod` 60 per_T = showPadded hLeft ++ ":" ++ showPadded mLeft ++ ":" ++ showPadded sLeft perc = 100 * (fromIntegral amtRead / fromIntegral total) :: Double per_p = show (round perc) ++ "%" oktot = isJust mTotal -- subPercents [] = [] subPercents ('%':rest) = subPercents' rest subPercents (x:rest) = x : subPercents rest -- subPercents' [] = [] subPercents' ('b':rest) = per_b ++ subPercents rest subPercents' ('B':rest) = per_B ++ subPercents rest subPercents' ('c':rest) = per_c ++ subPercents rest subPercents' ('C':rest) = per_C ++ subPercents rest subPercents' ('r':rest) = per_r ++ subPercents rest subPercents' ('R':rest) = per_R ++ subPercents rest subPercents' ('t':rest) | oktot = per_t ++ subPercents rest subPercents' ('T':rest) | oktot = per_T ++ subPercents rest subPercents' ('p':rest) | oktot = per_p ++ subPercents rest subPercents' ('%':rest) = "%" ++ subPercents rest subPercents' (x:rest) = '%' : ('x' : subPercents rest) -- show a number padded to force at least two digits. showPadded :: Show a => a -> String showPadded x = prefix ++ base where base = show x prefix = case base of [] -> "00" [x] -> "0" _ -> "" -- |Convert a number of bytes to a string represenation that uses a reasonable -- unit to make the number human-readable. bytesToUnittedStr :: Word64 -> String bytesToUnittedStr x | x < bk_brk = show x ++ "b" | x < km_brk = showHundredthsDiv x k ++ "k" | x < mg_brk = showHundredthsDiv x m ++ "m" | otherwise = showHundredthsDiv x g ++ "g" where bk_brk = 4096 km_brk = 768 * k mg_brk = 768 * m -- k = 1024 m = 1024 * k g = 1024 * m -- Divide the first number by the second, and convert to a string showing two -- decimal places. showHundredthsDiv _ 0 = error "Should never happen!" showHundredthsDiv amt size = show ones ++ "." ++ show tenths ++ show hundreths where divRes :: Double = fromIntegral amt / fromIntegral size divRes100 = round (divRes * 100) ones = divRes100 `div` 100 tenths = (divRes100 `div` 10) `mod` 10 hundreths = divRes100 `mod` 10 bytestring-progress-1.0.7/System/0000755000000000000000000000000012774311731015233 5ustar0000000000000000bytestring-progress-1.0.7/System/ProgressBar/0000755000000000000000000000000012774311731017464 5ustar0000000000000000bytestring-progress-1.0.7/System/ProgressBar/ByteString.hs0000644000000000000000000000764712774311731022130 0ustar0000000000000000module System.ProgressBar.ByteString( mkByteStringProgressBar , mkByteStringProgressWriter , fileReadProgressBar , fileReadProgressWriter ) where import Data.ByteString.Lazy(ByteString,hGetContents) import Data.ByteString.Lazy.Progress import System.IO(Handle,hSetBuffering,hPutChar,hPutStr,BufferMode(..)) import System.IO(openFile,hFileSize,IOMode(..)) import System.ProgressBar(Label, mkProgressBar) type ℤ = Integer -- |Track the progress of a ByteString as it is consumed by some computation. -- This is the most general version in the library, and will render a progress -- string and pass it to the given function. See other functions for interacting -- with fixed-size files, the console, or generic Handles. mkByteStringProgressBar :: ByteString {- The ByteString to track. -} -> (String -> IO ()) {- ^Function to call on update.-}-> ℤ {- ^ Progress bar width -} -> ℤ {- ^ The size of the ByteString -} -> Label {- ^ Prefixed label -} -> Label {- ^ Postfixed label -} -> IO ByteString mkByteStringProgressBar input tracker width size prefix postfix = trackProgressWithChunkSize bestSize updateFunction input where bestSize | size `div` 100 < 4096 = fromIntegral $ size `div` 100 | size `div` 100 < 16384 = 4096 | otherwise = 16384 updateProgressBar = mkProgressBar prefix postfix width updateFunction _ now = tracker $ updateProgressBar (fromIntegral now) size -- |As mkByteStringProgressBar, but simply print the output to the given -- Handle instead of using a callback. mkByteStringProgressWriter :: ByteString {- ^ The ByteString to track. -} -> Handle {- ^ Handle to write to -} -> ℤ {- ^ Progress bar width -} -> ℤ {- ^ The size of the ByteString -} -> Label {- ^ Prefixed label -} -> Label {- ^ Postfixed label -} -> IO ByteString mkByteStringProgressWriter input handle width size prefix postfix = do hSetBuffering handle NoBuffering mkByteStringProgressBar input tracker width size prefix postfix where tracker str = hPutChar handle '\r' >> hPutStr handle str -- |Track the loading of a file as it is consumed by some computation. The -- use of this function should be essentially similar to ByteString's -- readFile, but with a lot more arguments and side effects. fileReadProgressBar :: FilePath {- ^ The file to load. -} -> (String -> IO ()) {- ^ Function to call on update. -} -> ℤ {- ^ Progress bar width -} -> Label {- ^ Prefixed label -} -> Label {- ^ Postfixed label -} -> IO ByteString fileReadProgressBar path tracker width prefix postfix = do inHandle <- openFile path ReadMode size <- hFileSize inHandle bytestring <- hGetContents inHandle mkByteStringProgressBar bytestring tracker width size prefix postfix -- |As fileReadProgressBar, but simply write the progress bar to the given -- Handle instead of calling a generic function. fileReadProgressWriter :: FilePath {- ^ The file to load. -} -> Handle {- ^ Handle to write to -} -> ℤ {- ^ Progress bar width -} -> Label {- ^ Prefixed label -} -> Label {- ^ Postfixed label -} -> IO ByteString fileReadProgressWriter path handle width prefix postfix = do inHandle <- openFile path ReadMode size <- hFileSize inHandle bytestring <- hGetContents inHandle mkByteStringProgressWriter bytestring handle width size prefix postfix