How to monitor computation process in Haskell - haskell

Question

I have a function in my main block
map anyHeavyFunction [list]
I'd like to show a progress bar during the computation process or add additional actions (pause, stop process etc.), but because map is a pure function I can't do it directly. I can guess I have to use monads, but what monad is appropriate? IO, State?

Answer 1

I know there is at least one library on hackage that has some pre-made monad transformers for this task, but I normally turn to the pipes package to roll my own when I need one. I am using pipes-4.0.0 it is going to be on hackage this weekend, but you can grab it form the github repo before that.
I also used terminal-progress-bar package so that it makes a nice terminal animation as well.
{-# language BangPatterns #-}
import Pipes
import qualified Pipes.Prelude as P
import Control.Monad.IO.Class
import System.ProgressBar
import System.IO ( hSetBuffering, BufferMode(NoBuffering), stdout )
-- | Takes the total size of the stream to be processed as l and the function
-- to map as fn
progress l = loop 0
where
loop n = do
liftIO $ progressBar (msg "Working") percentage 40 n l
!x <- await -- bang pattern to make strict
yield x
loop (n+1)
main = do
-- Force progress bar to print immediately
hSetBuffering stdout NoBuffering
let n = 10^6
let heavy x = last . replicate n $ x -- time wasting function
r <- P.toListM $ each [1..100] >-> P.map heavy >-> progress 100
putStrLn ""
return r
This animates:
> Working [=>.......................] 7%
> Working [=====>...................] 20%
Every update erases the last bar so it only take up one line on the terminal. Then it finishes like so:
> main
Working [=========================] 100%
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100]

Answer 2

Here's a (kind of) simple answer that I'm not satisfied with. It is based on the fact that #shellenberg wanted to apply a heavy function on each element of a (supposedly long) list. If it suffices to move the "progress bar" once for every element of the list, then the following can be turned into a general solution.
First of all, you need to pick the monad in which you'll work. This depends on what exactly your "progress bar" is. For this discussion, let's say that the IO monad is enough and that we want to alternately display the characters -, /, | and \. You'll also (most probably) need some kind of state S (here it is only the number of elements processed so far, therefore S is Int), so the real monad used will be StateT S IO.
Suppose your original program is:
m = 100000 -- how many elements the list has
-- Your (pure) function
anyHeavyFunction :: Int -> Bool
anyHeavyFunction n =
length [1..n] + length [n+1..4217] == 4217
-- Your list
list :: [Int]
list = take m $ repeat 4217
-- The main program
main :: IO ()
main = do
let l = map anyHeavyFunction list
if and l
then putStrLn "OK"
else putStrLn "WRONG"
(Notice that, very conveniently, the heavy function takes the same time for each element of the list.)
This is how you could convert it to display the crude "progress bar":
import Control.Monad.State
import System.IO (hFlush, stdout)
m = 100000 -- how many elements the list has
k = 5000 -- how often you want to "tick"
tick :: a -> StateT Int IO a
tick x = do
s <- get
put $ s+1
when (s `mod` k == 0) $ liftIO $ do
let r = (s `div` k) `mod` 4
putChar $ "-/|\\" !! r
putChar '\b'
hFlush stdout
x `seq` return x
-- Your (pure) function
anyHeavyFunction :: Int -> Bool
anyHeavyFunction n =
length [1..n] + length [n+1..4217] == 4217
-- Your list
list :: [Int]
list = take m $ repeat 4217
-- The main program
main :: IO ()
main = do
l <- flip evalStateT 0 $ mapM (tick . anyHeavyFunction) list
if and l
then putStrLn "OK"
else putStrLn "WRONG"
An interesting point: The seq in tick forces evaluation of the result for each element of the list. This is enough, if the result has a basic type (Bool here). Otherwise, it's not clear what you would want to do -- remember Haskell is lazy!
If one wants a finer progress bar or if one is not satisfied with the assumption that one "tick" will be counted for each element of the list, then I believe it's necessary to incorporate the ticking in the logic of the heavy function. This makes it ugly... I'd like to see what kind of general solutions can be suggested to that. I'm all in for Haskell, but I think it just sucks for such things as progress bars... There's no free lunch; you can't be pure and lazy and have your progress bars made easy!
EDIT: A version which uses the ProgressBar module suggested by #Davorak. It certainly looks nicer than my rotating bar.
import Control.Monad.State
import System.ProgressBar
import System.IO (hSetBuffering, BufferMode(NoBuffering), stdout)
m = 100000 -- how many elements the list has
k = 5000 -- how often you want to "tick"
tick :: a -> StateT Int IO a
tick x = do
s <- get
put $ s+1
when (s `mod` k == 0) $ liftIO $ do
progressBar (msg "Working") percentage 40 (toInteger s) (toInteger m)
x `seq` return x
-- Your (pure) function
anyHeavyFunction :: Int -> Bool
anyHeavyFunction n =
length [1..n] + length [n+1..4217] == 4217
-- Your list
list :: [Int]
list = take m $ repeat 4217
-- The main program
main :: IO ()
main = do
hSetBuffering stdout NoBuffering
l <- flip evalStateT 0 $ mapM (tick . anyHeavyFunction) list
if and l
then putStrLn "OK"
else putStrLn "WRONG"
The idea is the same, the drawbacks too.

Answer 3

You could use parMap to apply the expensive function in parallel (if the dependencies permit) and a list of TVars corresponding to each list (or chunk of) element(s) and set them once the respective function application has completed. A separate thread could check on the values and update the display (obviously some IO action would happen here).