Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Lifted variant of Concurrently #4

Closed
jonsterling opened this issue Apr 29, 2014 · 7 comments
Closed

Lifted variant of Concurrently #4

jonsterling opened this issue Apr 29, 2014 · 7 comments

Comments

@jonsterling
Copy link

@jonsterling jonsterling commented Apr 29, 2014

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
Copy link
Owner

@maoe maoe commented Apr 30, 2014

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
Copy link
Owner

@maoe maoe commented Apr 30, 2014

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

maoe pushed a commit that referenced this issue Apr 30, 2014
Mitsutoshi Aoe
@maoe
Copy link
Owner

@maoe maoe commented Apr 30, 2014

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

@jonsterling
Copy link
Author

@jonsterling jonsterling commented Apr 30, 2014

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

@jonsterling
Copy link
Author

@jonsterling jonsterling commented Apr 30, 2014

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
Copy link
Owner

@maoe maoe commented May 1, 2014

Thanks. Just released it as v0.2.0.

@maoe maoe closed this May 1, 2014
@jonsterling
Copy link
Author

@jonsterling jonsterling commented May 1, 2014

Excellent! Thanks for the quick turnaround :)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Linked pull requests

Successfully merging a pull request may close this issue.

None yet
2 participants
You can’t perform that action at this time.