Lifted variant of Concurrently

[jonsterling]

I've been needing a lifted variant of Concurrently, but I'm not sure about the right way to write it. What I currently have is this:

newtype Concurrently m a = Concurrently { runConcurrently :: m a }

instance MonadBaseControl IO m => Functor (Concurrently m) where
  fmap f (Concurrently a) = Concurrently $ f <$> a

instance MonadBaseControl IO m => Applicative (Concurrently m) where
  pure = Concurrently . return
  Concurrently fs <*> Concurrently as =
    Concurrently $ (\(f, a) -> f a) <$> concurrently fs as

instance MonadBaseControl IO m => Alternative (Concurrently m) where
  empty = Concurrently . liftBaseWith . const $ forever (threadDelay maxBound)
  Concurrently as <|> Concurrently bs =
    Concurrently $ either id id <$> race as bs

But this is less than desirable, since it requires -XUndecidableInstances. Can you think of a better way to go about this? If we are able to come up with something, I'd be delighted to open a pull request.

[maoe]

Ah, I completely forgot about Concurrently because I've never used it directly. Thanks for reminding me of it.

I'm not quite sure how bad UndecidableInstances are, but I came up with something which doesn't need it but uses TypeFamilies and KindSignatures instead:

{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}

newtype Concurrently (b :: * -> *) m a = Concurrently { runConcurrently :: m a }

instance (base ~ IO, Functor m) => Functor (Concurrently base m) where
  fmap f (Concurrently a) = Concurrently $ f <$> a

instance (base ~ IO, MonadBaseControl base m) => Applicative (Concurrently base m) where
  pure = Concurrently . pure
  Concurrently fs <*> Concurrently as =
    Concurrently $ uncurry ($) <$> concurrently fs as

instance (base ~ IO, MonadBaseControl base m) => Alternative (Concurrently base m) where
  empty = Concurrently . liftBaseWith . const $ forever (threadDelay maxBound)
  Concurrently as <|> Concurrently bs =
    Concurrently $ either id id <$> race as bs

Or if we prefer FlexibleInstances over the type equality constraints:

{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE FlexibleInstances #-}

newtype Concurrently (b :: * -> *) m a = Concurrently { runConcurrently :: m a }

instance Functor m => Functor (Concurrently IO m) where
  fmap f (Concurrently a) = Concurrently $ f <$> a

instance MonadBaseControl IO m => Applicative (Concurrently IO m) where
  pure = Concurrently . pure
  Concurrently fs <*> Concurrently as =
    Concurrently $ uncurry ($) <$> concurrently fs as

instance MonadBaseControl IO m => Alternative (Concurrently IO m) where
  empty = Concurrently . liftBaseWith . const $ forever (threadDelay maxBound)
  Concurrently as <|> Concurrently bs =
    Concurrently $ either id id <$> race as bs

What do you think?

[maoe]

The FlexibleInstances approach doesn't work because b is ambiguous. The former approach should work.

[maoe]

@jonsterling Just pushed the patch. Could you try this with your use cases?

[jonsterling]

Great, I'll try it out once I get to my office! Thanks!

[jonsterling]

This seems to work nicely! Though it's not clear to me that it does in fact require -XTypeFamilies...

EDIT: Ah, I see. Either -XTypeFamilies or -XGADTs will do. Nvm!

[maoe]

Thanks. Just released it as v0.2.0.

[jonsterling]

Excellent! Thanks for the quick turnaround :)