Skip to content

Instantly share code, notes, and snippets.

@joom

joom/setInterval.hs

Forked from saml/setInterval.hs
Created July 18, 2014 21:17
Download ZIP

Revisions

  1. joom revised this gist Jul 18, 2014. 1 changed file with 8 additions and 17 deletions.
    25 changes: 8 additions & 17 deletions setInterval.hs
    View file
    Original file line number Diff line number Diff line change
    @@ -1,23 +1,14 @@
    -- ghc --make -O2 -threaded setInterval.hs
    import Control.Concurrent
    import Control.Exception

    import Control.Concurrent (forkIO, putMVar, takeMVar,
    newEmptyMVar, threadDelay)
    import Control.Exception (finally)

    setInterval :: IO a -> Int -> IO ()
    setInterval action microsecs = do
    mvar <- newEmptyMVar
    setInterval' mvar action microsecs
    _ <- forkIO $ loop `finally` putMVar mvar ()
    takeMVar mvar
    where loop = threadDelay microsecs >> action >> loop

    setInterval' mvar action microsecs = do
    threadId <- forkIO (loop `finally` putMVar mvar ())
    return threadId
    where
    loop = do
    threadDelay microsecs
    action
    loop

    main = do
    setInterval (do
    putStrLn "yolo"
    ) 1000000
    main :: IO ()
    main = setInterval (putStrLn "yolo") 1000000
  2. @saml saml revised this gist Sep 5, 2012. 1 changed file with 8 additions and 4 deletions.
    12 changes: 8 additions & 4 deletions setInterval.hs
    View file
    Original file line number Diff line number Diff line change
    @@ -2,7 +2,13 @@
    import Control.Concurrent
    import Control.Exception

    setInterval mvar action microsecs = do

    setInterval action microsecs = do
    mvar <- newEmptyMVar
    setInterval' mvar action microsecs
    takeMVar mvar

    setInterval' mvar action microsecs = do
    threadId <- forkIO (loop `finally` putMVar mvar ())
    return threadId
    where
    @@ -12,8 +18,6 @@ setInterval mvar action microsecs = do
    loop

    main = do
    mvar <- newEmptyMVar
    setInterval mvar (do
    setInterval (do
    putStrLn "yolo"
    ) 1000000
    takeMVar mvar
  3. @saml saml created this gist Sep 5, 2012.
    19 changes: 19 additions & 0 deletions setInterval.hs
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,19 @@
    -- ghc --make -O2 -threaded setInterval.hs
    import Control.Concurrent
    import Control.Exception

    setInterval mvar action microsecs = do
    threadId <- forkIO (loop `finally` putMVar mvar ())
    return threadId
    where
    loop = do
    threadDelay microsecs
    action
    loop

    main = do
    mvar <- newEmptyMVar
    setInterval mvar (do
    putStrLn "yolo"
    ) 1000000
    takeMVar mvar