Ketil Malde wrote:
I've done something similar, I think. Often, I want to output some kind of progress indicator, just to show that the program is working. Typically, the program works by lazily evaluating a list (lines from an input file, say); each element of the list is wrapped with an IO action that outputs the status when evaluated -- which typically happens lazily from pure code.
countIO :: String -> String -> Int -> [a] -> IO [a] countIO msg post step xs = sequence $ map unsafeInterleaveIO ((blank >> outmsg (0::Int) >> c):cs) where (c:cs) = ct 0 xs output = hPutStr stderr blank = output ('\r':take 70 (repeat ' ')) outmsg x = output ('\r':msg++show x) >> hFlush stderr ct s ys = let (a,b) = splitAt (step-1) ys next = s+step in case b of [b1] -> map return a ++ [outmsg (s+step) >> hPutStr stderr post >> return b1] [] -> map return (init a) ++ [outmsg (s+length a) >> hPutStr stderr post >> return (last a)] _ -> map return a ++ [outmsg s >> return (head b)] ++ ct next (tail b)
-k
Your use of unsafeInterleaveIO is just not quite correct. A quick series of examples: Let me define this function:
unsafeSequenceIO :: [ IO a ] -> IO [a] unsafeSequenceIO [] = return [] unsafeSequenceIO (x:xs) = unsafeInterleaveIO $ do this <- x rest <- unsafeSequenceIO xs return (this:rest)
And an infinite [ IO a ]
todo :: [ IO Int ] todo = map return [0..]
These diverge
*Main> liftM (take 10) (sequence todo) *Main> liftM (take 10) (sequence (map unsafeInterleaveIO todo))
This is finite:
*Main> liftM (take 10) (unsafeSequenceIO todo) [0,1,2,3,4,5,6,7,8,9]
An alternate definition of unsafeSequenceIO, which is not quite the same but still works, is
unsafeSequenceIO' :: [ IO a ] -> IO [a] unsafeSequenceIO' [] = return [] unsafeSequenceIO' (x:xs) = do this <- x rest <- unsafeInterleaveIO' (unsafeSequenceIO' xs) return (this:rest)
The two definitions differ only very slightly in how lazily the very first element is handled:
*Main> (unsafeSequenceIO (error "boom":[]) >> print "ok") "ok" *Main> (unsafeSequenceIO' (error "boom":[]) >> print "ok") *** Exception: boom