Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Applicative async programming
import Control.Concurrent
import Control.Concurrent.Async
import Control.Applicative
import Control.Monad
import Data.Traversable
newtype Concurrently a = Concurrently { runConcurrently :: IO a }
instance Functor Concurrently where
fmap f (Concurrently a) = Concurrently $ f <$> a
instance Applicative Concurrently where
pure = Concurrently . return
Concurrently fs <*> Concurrently as =
Concurrently $ (\(f, a) -> f a) <$> concurrently fs as
instance Alternative Concurrently where
empty = Concurrently $ forever (threadDelay maxBound)
Concurrently as <|> Concurrently bs =
Concurrently $ either id id <$> race as bs
doConcurrently :: Traversable t => (a -> IO b) -> t a -> IO (t b)
doConcurrently f = runConcurrently . traverse (Concurrently . f)
-- testing
getURL :: String -> IO String
getURL s = return $ "<" ++ s ++ ">"
main :: IO ()
main = do
(page1, page2, page3)
<- runConcurrently $ (,,)
<$> Concurrently (getURL "url1")
<*> Concurrently (getURL "url2")
<*> Concurrently (getURL "url3")
print [page1, page2, page3]
pages <- doConcurrently getURL ["url1", "url2", "url3"]
print pages
page <- runConcurrently
$ Concurrently (getURL "url1")
<|> empty
<|> Concurrently (getURL "url2")
print page
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.