This might be a little less invasive. You could add any unsafe* stuff
as you desire.
-- every hundred elements generates a trace marker
addTrace xs = addTrace' 100 0 where
addTrace' 0 !cnt xs = Left cnt : addTrace' 100 cnt xs
addTrace' n !cnt (x:xs) = Right x : addTrace' (n - 1) (cnt + 1) xs
separateTrace = partition isLeft
-- result k = filter my_weird_condition $ map strange_conversion $ unfoldr ...
observe k = do
let (trace, result) = (filter my_weird_condition >< id) $
separateTrace . addTrace $
map strange_conversion $ unfoldr...
print trace
return result
On Nov 28, 2007 5:16 PM, David Roundy
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
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe