Skip to content

Instantly share code, notes, and snippets.

@rdnetto
Created December 17, 2017 22:23
Show Gist options
  • Save rdnetto/90f23ea17960b50236199c120fbd37d6 to your computer and use it in GitHub Desktop.
Save rdnetto/90f23ea17960b50236199c120fbd37d6 to your computer and use it in GitHub Desktop.
Progress bar example using Conduit
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
main :: IO
main = runConduitRes
$ sourceFileBS "input.txt"
.| progressReporter 1000
.| sinkFile "output.txt"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment