In particular, you wouldn't be able
to use the unsafeInterleaveIO version to do a progress indicator for the
function I initially proposed
> t = foldr (+) 0 [1..10000]
since your lift would wind up being
lifted into IO. But you would be able to use the unsafePerformIO version,
just like in what I initially proposed you could use trace.
t = foldr (+) 0 ( lessSafeMonitoryProgress f [1..10000]
) where f i | i mod 1000 == 0 =
(putStrLn . show ) i
| otherwise = return ()
Make sense?
thomas.
David Roundy <droundy@darcs.net> Sent by: haskell-cafe-bounces@haskell.org
11/28/2007 06:16 PM
To
haskell-cafe@haskell.org
cc
Subject
Re: [Haskell-cafe] Progress indications
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)
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
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
---
This e-mail may contain confidential and/or privileged information. If you are not the intended recipient (or have received this e-mail in error) please notify the sender immediately and destroy this e-mail. Any unauthorized copying, disclosure or distribution of the material in this e-mail is strictly forbidden.