diff --git a/Data/ByteString/Lazy/Progress.hs b/Data/ByteString/Lazy/Progress.hs new file mode 100644 --- /dev/null +++ b/Data/ByteString/Lazy/Progress.hs @@ -0,0 +1,193 @@ +{-# 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 + + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,25 @@ +Copyright (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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/bytestring-progress.cabal b/bytestring-progress.cabal new file mode 100644 --- /dev/null +++ b/bytestring-progress.cabal @@ -0,0 +1,28 @@ +Name: bytestring-progress +Version: 1.0.0 +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. + +Library + Build-Depends: base >= 4.0 && < 5.0, + time >= 1.1 && <= 1.2, + bytestring >= 0.9 && < 1.0 + Exposed-Modules: Data.ByteString.Lazy.Progress + +source-repository head + type: git + location: http://github.com/acw/bytestring-progress +