module Happstack.Util.Concurrent where
import Control.Concurrent
import Prelude hiding (catch)
import Control.Exception
#ifdef INTERACTIVE
import System.IO.Unsafe
import System.Mem
#endif
forkEverSt :: (t -> IO t) -> t -> IO ThreadId
forkEverSt f = fork . foreverSt f
foreverSt :: (Monad m) => (t -> m t) -> t -> m b
foreverSt f state= f state >>= foreverSt f
forkEver :: IO a -> IO ThreadId
forkEver = fork . forever
writeChanRight :: Chan (Either a b) -> b -> IO ()
writeChanRight chan = writeChan chan . Right
writeChanLeft :: Chan (Either a b) -> a -> IO ()
writeChanLeft chan = writeChan chan . Left
fork_ :: IO a -> IO ()
fork_ c = fork c >> return ()
fork :: IO a -> IO ThreadId
registerResetAction :: IO () -> IO ()
reset :: IO ()
forever :: IO a -> IO a
#ifndef INTERACTIVE
forever a = finally a (forever a)
fork c = forkIO (c >> return ())
registerResetAction _ = return ()
reset = return ()
#else
forever a = try a >>= w
where w (Right _) = forever a
w (Left (AsyncException ThreadKilled)) = return ()
w (Left e) = print e >> forever a
registerResetAction x = modifyMVar_ happsThreadList (return . (x:))
fork c = do
x <- forkIO (c >> return ())
modifyMVar_ happsThreadList (\xs -> return (killThread x:xs))
return x
reset = do xs <- swapMVar happsThreadList []
sequence_ xs
threadDelay 10000
performGC
logM "Happstack.Util.Concurrent" INFO "reset ok"
happsThreadList = unsafePerformIO $ newMVar []
#endif
sleep :: Int -> IO ()
sleep n = threadDelay (n * second) where second = 1000000