module Control.Shell.Concurrent (
Future,
future, await, check,
parallel, parallel_,
chunks
) where
#if __GLASGOW_HASKELL__ <= 708
import Control.Applicative
#endif
import Control.Concurrent
import Control.Monad
import Control.Shell
import Data.IORef
type FinalizerHandle = IORef ThreadId
data Future a = Future !FinalizerHandle !(MVar (Either ExitReason a))
future :: Shell a -> Shell (Future a)
future m = liftIO $ do
v <- newEmptyMVar
tid <- forkIO $ shell m >>= putMVar v
r <- newIORef tid
_ <- mkWeakIORef r (killThread tid)
return $ Future r v
fromResult :: Either ExitReason a -> Shell a
fromResult x =
case x of
Left Success -> exit
Left (Failure err) -> fail err
Right x' -> return x'
await :: Future a -> Shell a
await (Future h v) = liftIO (readMVar v <* readIORef h) >>= fromResult
check :: Future a -> Shell (Maybe a)
check (Future h v) = do
mx <- liftIO $ tryReadMVar v <* readIORef h
maybe (pure Nothing) (fmap Just . fromResult) (h `seq` mx)
parallel :: [Shell a] -> Shell [a]
parallel = mapM future >=> mapM await
parallel_ :: [Shell a] -> Shell ()
parallel_ = mapM future >=> mapM_ await
chunks :: Int -> [a] -> [[a]]
chunks _ [] = []
chunks n xs | length xs > n = take n xs : chunks n (drop n xs)
| otherwise = [xs]