Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- {-# LANGUAGE JavaScriptFFI #-}
- module Main where
- import Control.Concurrent
- import Control.Concurrent.MVar
- import Control.Monad
- -- | Very simple, no exception safety. Intended for async JS functions.
- parallel :: [IO a] -> IO [a]
- parallel fs = do
- vars <- forM fs $ \f -> do
- v <- newEmptyMVar
- _ <- forkIO $ f >>= putMVar v
- return v
- mapM takeMVar vars
- -- | Just your average async JS function.
- foreign import javascript interruptible
- " console.log('Starting ' + $1); \
- \ setTimeout(function(){ \
- \ console.log('Ending ' + $1); \
- \ $c($1 * 100); \
- \ }, $1 * 1000); "
- seconds :: Int -> IO Int
- -- | Waits a maximum of 5 seconds for the action to finish.
- timeout :: IO a -> IO (Maybe a)
- timeout f = do
- v <- newEmptyMVar
- _ <- forkIO $ f >>= putMVar v . Just
- _ <- forkIO $ threadDelay 5000000 >> putMVar v Nothing
- takeMVar v
- main :: IO ()
- main = do
- parallel (map timeout [seconds 1, seconds 2, seconds 10]) >>= print
- print "done"
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement