{-# 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 :: ByteString
-> (Text -> IO ())
-> ℤ
-> ℤ
-> Label ()
-> Label ()
-> IO ByteString
mkByteStringProgressBar input :: ByteString
input tracker :: Text -> IO ()
tracker width :: ℤ
width size :: ℤ
size prefix :: Label ()
prefix postfix :: Label ()
postfix =
do UTCTime
start <- IO UTCTime
getCurrentTime
Word64
-> (Word64 -> Word64 -> IO ()) -> ByteString -> IO ByteString
trackProgressWithChunkSize Word64
bestSize (UTCTime -> Word64 -> Word64 -> IO ()
forall a p. Integral a => UTCTime -> p -> a -> IO ()
updateFunction UTCTime
start) ByteString
input
where
style :: Style ()
style = Style ()
forall s. Style s
defStyle{ stylePrefix :: Label ()
stylePrefix = Label ()
prefix
, stylePostfix :: Label ()
stylePostfix = Label ()
postfix
, styleWidth :: ProgressBarWidth
styleWidth = Int -> ProgressBarWidth
ConstantWidth (ℤ -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ℤ
width) }
bestSize :: Word64
bestSize | ℤ
size ℤ -> ℤ -> ℤ
forall a. Integral a => a -> a -> a
`div` 100 ℤ -> ℤ -> Bool
forall a. Ord a => a -> a -> Bool
< 4096 = ℤ -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ℤ -> Word64) -> ℤ -> Word64
forall a b. (a -> b) -> a -> b
$ ℤ
size ℤ -> ℤ -> ℤ
forall a. Integral a => a -> a -> a
`div` 100
| ℤ
size ℤ -> ℤ -> ℤ
forall a. Integral a => a -> a -> a
`div` 100 ℤ -> ℤ -> Bool
forall a. Ord a => a -> a -> Bool
< 16384 = 4096
| Bool
otherwise = 16384
updateFunction :: UTCTime -> p -> a -> IO ()
updateFunction start :: UTCTime
start _ newAmt :: a
newAmt =
do UTCTime
now <- IO UTCTime
getCurrentTime
let progress :: Progress ()
progress = Int -> Int -> () -> Progress ()
forall s. Int -> Int -> s -> Progress s
Progress (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
newAmt) (ℤ -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ℤ
size) ()
timing :: Timing
timing = UTCTime -> UTCTime -> Timing
Timing UTCTime
start UTCTime
now
Text -> IO ()
tracker (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Style () -> Progress () -> Timing -> Text
forall s. Style s -> Progress s -> Timing -> Text
renderProgressBar Style ()
style Progress ()
progress Timing
timing
mkByteStringProgressWriter :: ByteString ->
Handle ->
ℤ ->
ℤ ->
Label () ->
Label () ->
IO ByteString
mkByteStringProgressWriter :: ByteString
-> Handle -> ℤ -> ℤ -> Label () -> Label () -> IO ByteString
mkByteStringProgressWriter input :: ByteString
input handle :: Handle
handle width :: ℤ
width size :: ℤ
size prefix :: Label ()
prefix postfix :: Label ()
postfix = do
Handle -> BufferMode -> IO ()
hSetBuffering Handle
handle BufferMode
NoBuffering
ByteString
-> (Text -> IO ())
-> ℤ
-> ℤ
-> Label ()
-> Label ()
-> IO ByteString
mkByteStringProgressBar ByteString
input Text -> IO ()
tracker ℤ
width ℤ
size Label ()
prefix Label ()
postfix
where
tracker :: Text -> IO ()
tracker str :: Text
str = Handle -> Text -> IO ()
T.hPutStr Handle
handle "\r" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Text -> IO ()
T.hPutStr Handle
handle Text
str
fileReadProgressBar :: FilePath ->
(Text -> IO ()) ->
ℤ ->
Label () ->
Label () ->
IO ByteString
fileReadProgressBar :: FilePath
-> (Text -> IO ()) -> ℤ -> Label () -> Label () -> IO ByteString
fileReadProgressBar path :: FilePath
path tracker :: Text -> IO ()
tracker width :: ℤ
width prefix :: Label ()
prefix postfix :: Label ()
postfix = do
Handle
inHandle <- FilePath -> IOMode -> IO Handle
openFile FilePath
path IOMode
ReadMode
ℤ
size <- Handle -> IO ℤ
hFileSize Handle
inHandle
ByteString
bytestring <- Handle -> IO ByteString
hGetContents Handle
inHandle
ByteString
-> (Text -> IO ())
-> ℤ
-> ℤ
-> Label ()
-> Label ()
-> IO ByteString
mkByteStringProgressBar ByteString
bytestring Text -> IO ()
tracker ℤ
width ℤ
size Label ()
prefix Label ()
postfix
fileReadProgressWriter :: FilePath ->
Handle ->
ℤ ->
Label () ->
Label () ->
IO ByteString
fileReadProgressWriter :: FilePath -> Handle -> ℤ -> Label () -> Label () -> IO ByteString
fileReadProgressWriter path :: FilePath
path handle :: Handle
handle width :: ℤ
width prefix :: Label ()
prefix postfix :: Label ()
postfix = do
Handle
inHandle <- FilePath -> IOMode -> IO Handle
openFile FilePath
path IOMode
ReadMode
ℤ
size <- Handle -> IO ℤ
hFileSize Handle
inHandle
ByteString
bytestring <- Handle -> IO ByteString
hGetContents Handle
inHandle
ByteString
-> Handle -> ℤ -> ℤ -> Label () -> Label () -> IO ByteString
mkByteStringProgressWriter ByteString
bytestring Handle
handle ℤ
width ℤ
size Label ()
prefix Label ()
postfix