{-# LANGUAGE OverloadedStrings #-}
module System.ProgressBar.ByteString(
mkByteStringProgressBar
, mkByteStringProgressWriter
, fileReadProgressBar
, fileReadProgressWriter
)
where
import Data.ByteString.Lazy(ByteString,hGetContents)
import Data.ByteString.Lazy.Progress
import Data.Text.Lazy(Text)
import qualified Data.Text.Lazy.IO as T
import Data.Time.Clock(getCurrentTime)
import System.IO(Handle,hSetBuffering,hPutChar,hPutStr,BufferMode(..))
import System.IO(openFile,hFileSize,IOMode(..))
import System.ProgressBar(Label, Progress(Progress), ProgressBarWidth(..),
Style(..), Timing(..))
import System.ProgressBar(defStyle, renderProgressBar)
type ℤ = Integer
mkByteStringProgressBar :: ByteString ->
(Text -> IO ()) ->
ℤ ->
ℤ ->
Label () ->
Label () ->
IO ByteString
mkByteStringProgressBar input tracker width size prefix postfix =
do start <- getCurrentTime
trackProgressWithChunkSize bestSize (updateFunction start) input
where
style = defStyle{ stylePrefix = prefix
, stylePostfix = postfix
, styleWidth = ConstantWidth (fromIntegral width) }
bestSize | size `div` 100 < 4096 = fromIntegral $ size `div` 100
| size `div` 100 < 16384 = 4096
| otherwise = 16384
updateFunction start _ newAmt =
do now <- getCurrentTime
let progress = Progress (fromIntegral newAmt) (fromIntegral size) ()
timing = Timing start now
tracker $ renderProgressBar style progress timing
mkByteStringProgressWriter :: ByteString ->
Handle ->
ℤ ->
ℤ ->
Label () ->
Label () ->
IO ByteString
mkByteStringProgressWriter input handle width size prefix postfix = do
hSetBuffering handle NoBuffering
mkByteStringProgressBar input tracker width size prefix postfix
where
tracker str = T.hPutStr handle "\r" >> T.hPutStr handle str
fileReadProgressBar :: FilePath ->
(Text -> IO ()) ->
ℤ ->
Label () ->
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
fileReadProgressWriter :: FilePath ->
Handle ->
ℤ ->
Label () ->
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