Progress bar example using Conduit

ProgressUtils.hs

module ProgressUtils where

import BasicPrelude
import Conduit (Conduit, mapMC, execStateC)
import qualified Control.Monad.State.Class as S
import Data.Fixed (divMod')
import qualified Data.Text as T
import System.Clock
import System.IO (hFlush, stdout)
import Text.Printf (printf)


-- A simple helper conduit that writes progress updates to stdout.
-- n is the total number of elements expected.
progressReporter :: (MonadIO m) => Int -> Conduit a m a
progressReporter n = do
        t0 <- liftIO $ getTime Monotonic
        void . execStateC (0, t0, t0, t0) $ mapMC (\x -> f >> return x)
    where
        f = do
            -- t0 is the time we started
            -- t1 is the time of the last update
            -- t2 is the time of the last check
            -- i is the current index
            (i, t0, t1, t2) <- S.get
            now <- liftIO $ getTime Monotonic
            let secsSinceUpdate = now `diffSecs` t1
            let secsSinceCheck = now `diffSecs` t2

            when (secsSinceCheck > 0.1) $ print secsSinceCheck

            t1' <- if secsSinceUpdate > 1
                      then do
                          let d = 1000 * i `div` n
                          let elapsed = now `diffSecs` t0
                          let progress = (fromIntegral i) / (fromIntegral n)
                          let remaining = elapsed / progress * (1 - progress)

                          liftIO $ printf "%f%%, %s elapsed, %s remaining, %.0f rows/sec\n"
                              (fromIntegral d / 10 :: Float)
                              (showTime elapsed)
                              (showTime remaining)
                              (fromIntegral i / elapsed)
                          return now
                      else return t1

            S.put (i + 1, t0, t1', now)

-- Returns the number of seconds' difference between two TimeSpecs
diffSecs :: TimeSpec -> TimeSpec -> Float
diffSecs (TimeSpec s1 ns1) (TimeSpec s0 ns0) = fromIntegral (s1 - s0) + fromIntegral (ns1 - ns0) / 1000000000

-- Converts seconds to presentation format
showTime :: Float -> String
showTime t = res where
    res = if t < 0.001
             then printf "%.0f ns" (t * 1000000)
             else if t < 10
                     then printf "%.0f ms" (t * 1000)
                     else printf "%.2i:%.2i:%.2i" h m s

    (h::Int, h') = t  `divMod'` 3600
    (m::Int, m') = h' `divMod'` 60
    s::Int = floor m'

-- Prints the mean rate of computation, given the start time and units of work done since
showRate :: MonadIO m => TimeSpec -> Int -> m ()
showRate t0 n = liftIO $ do
    t1 <- getTime Monotonic
    let rate = fromIntegral n / diffSecs t1 t0
    putStrLn . T.pack $ printf "%.00g rows/sec" rate

-- Runs an action and displays the time it took
timedPrint :: MonadIO m => Text -> m a -> m a
timedPrint s action = do
    putStr $ s ++ " ... "
    liftIO $ hFlush stdout
    start <- liftIO $ getTime Monotonic
    res <- action
    done <- liftIO $ getTime Monotonic
    putStrLn . T.pack . showTime $ done `diffSecs` start
    return res

Usage.hs

main :: IO
main = runConduitRes
     $ sourceFileBS "input.txt"
     .| progressReporter 1000
     .| sinkFile "output.txt"