There is a number of possible solutions.
The simplest one is to alter your function to return stream of events instead of the final result. You sum_of_factors
doesn't compile for me, so I'll use a sum
function as an example. The idea is to send Left message
to show progress, and send Right result
when done. Thanks to lazy evaluation, you'll see progress events while the function is working:
import Control.Monad
sum' :: [Int] -> [Either String Int]
sum' = go step 0
where
step = 10000
go _ res [] = [Right res]
go 0 res (x:xs) = Left ("progress: " ++ show x) : go step (res + x) xs
go c res (x:xs) = go (c - 1) (res + x) xs
main :: IO ()
main = do
forM_ (sum' [1..1000000]) $ \event ->
case event of
Right res -> putStrLn $ "Result: " ++ show res
Left str -> putStrLn str
Other (and better from my point of view) solution is to make the function monadic:
class Monad m => LogM m where
logMe :: String -> m ()
instance LogM IO where
logMe = putStrLn
sum' :: LogM m => [Int] -> m Int
sum' = go step 0
where
step = 10000
go _ res [] = return res
go 0 res (x:xs) = logMe ("progress: " ++ show x) >> go step (res + x) xs
go c res (x:xs) = go (c - 1) (res + x) xs
main :: IO ()
main = sum' [1..1000000] >>= print
or using foldM
:
import Control.Monad
sum' :: LogM m => [Int] -> m Int
sum' = liftM snd . foldM go (0, 0)
where
step = 10000
-- `!` forces evaluation and prevents build-up of thunks.
-- See the BangPatterns language extension.
go (!c, !res) x = do
when (c == 0) $ logMe ("progress: " ++ show x)
return $ ((c + 1) `mod` step, res + x)