[Haskell-cafe] Progress indications

David Roundy droundy at darcs.net
Wed Nov 28 18:16:39 EST 2007


On Wed, Nov 28, 2007 at 05:58:07PM -0500, Thomas Hartman wrote:
> maybe Debug.Trace? like...
> 
> import Debug.Trace
> 
> t = foldr debugf 0 [1..10000]
> 
> f :: Int -> Int -> Int
> f = (+)
> 
> -- same typesig as f
> debugf :: Int -> Int -> Int
> debugf x y | y `mod` 1000 == 0 = x + (trace (show y) y)
> debugf x y = x + y

Or, more flexibly:

import System.IO.Unsafe ( unsafeInterleaveIO )

monitorProgress :: (Int -> IO ()) -> [a] -> IO [a]
monitorProgress f xs = mapM f' $ zip [0..] xs
   where f' (n,x) = unsafeInterleaveIO (f n >> return x)

You could, of course, make this a function

lessSafeMonitoryProgress :: (Int -> IO ()) -> [a] -> [a]

by using unsafePerformIO instead of unsafeInterleaveIO, but that seems
slightly scary to me.

In any case, you can stick this on whichever of the lists you want to
monitor the progress of.
-- 
David Roundy
Department of Physics
Oregon State University


More information about the Haskell-Cafe mailing list