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

Comments

2 participants
@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

This comment has been minimized.

Show comment
Hide comment
@maoe

maoe Apr 30, 2014

Owner

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?

Owner

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

This comment has been minimized.

Show comment
Hide comment
@maoe

maoe Apr 30, 2014

Owner

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

Owner

maoe commented Apr 30, 2014

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

maoe added a commit that referenced this issue Apr 30, 2014

@maoe

This comment has been minimized.

Show comment
Hide comment
@maoe

maoe Apr 30, 2014

Owner

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

Owner

maoe commented Apr 30, 2014

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

@jonsterling

This comment has been minimized.

Show comment
Hide comment
@jonsterling

jonsterling Apr 30, 2014

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

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

@jonsterling

This comment has been minimized.

Show comment
Hide comment
@jonsterling

jonsterling 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!

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

This comment has been minimized.

Show comment
Hide comment
@maoe

maoe May 1, 2014

Owner

Thanks. Just released it as v0.2.0.

Owner

maoe commented May 1, 2014

Thanks. Just released it as v0.2.0.

@maoe maoe closed this May 1, 2014

@jonsterling

This comment has been minimized.

Show comment
Hide comment
@jonsterling

jonsterling May 1, 2014

Excellent! Thanks for the quick turnaround :)

Excellent! Thanks for the quick turnaround :)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment