{-# 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

-- |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. -} ->
                           (Text -> IO ()) {- ^Function to call on update.-}->
                                {- ^ Progress bar width -}         ->
                                {- ^ The size of the ByteString -} ->
                           Label () {- ^ Prefixed label -}           ->
                           Label () {- ^ Postfixed label -}          ->
                           IO ByteString
mkByteStringProgressBar :: ByteString
-> (Text -> IO ())
-> ℤ
-> ℤ
-> Label ()
-> Label ()
-> IO ByteString
mkByteStringProgressBar ByteString
input Text -> IO ()
tracker width size Label ()
prefix Label ()
postfix =
  do UTCTime
start <- IO UTCTime
getCurrentTime
     Word64
-> (Word64 -> Word64 -> IO ()) -> ByteString -> IO ByteString
trackProgressWithChunkSize Word64
bestSize (UTCTime -> Word64 -> Word64 -> IO ()
forall {p} {p}. Integral p => UTCTime -> p -> p -> 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 = Word64
4096
           | Bool
otherwise              = Word64
16384
  updateFunction :: UTCTime -> p -> p -> IO ()
updateFunction UTCTime
start p
_ p
newAmt           =
    do UTCTime
now <- IO UTCTime
getCurrentTime
       let progress :: Progress ()
progress = Int -> Int -> () -> Progress ()
forall s. Int -> Int -> s -> Progress s
Progress (p -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
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

-- |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 :: ByteString
-> Handle -> ℤ -> ℤ -> Label () -> Label () -> IO ByteString
mkByteStringProgressWriter ByteString
input Handle
handle width size Label ()
prefix 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 Text
str = Handle -> Text -> IO ()
T.hPutStr Handle
handle Text
"\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

-- |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. -} ->
                       (Text -> IO ()) {- ^ Function to call on update. -} ->
                        {- ^ Progress bar width -} ->
                       Label () {- ^ Prefixed label -} ->
                       Label () {- ^ Postfixed label -} ->
                       IO ByteString
fileReadProgressBar :: FilePath
-> (Text -> IO ()) -> ℤ -> Label () -> Label () -> IO ByteString
fileReadProgressBar FilePath
path Text -> IO ()
tracker width Label ()
prefix 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

-- |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 :: FilePath -> Handle -> ℤ -> Label () -> Label () -> IO ByteString
fileReadProgressWriter FilePath
path Handle
handle width Label ()
prefix 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