Defining Applicative for the Product of Two Monads

Learn
#1

I am trying to figure out how to properly define Applicative for the type

data (:*:) p q u v = (:*:) {pfst :: p u v, psnd :: q u v} deriving (Show, Eq, Functor)

I currently have Applicative, Monad, and MonadFail defined as

instance (Applicative (p u), Applicative (q u)) => Applicative ((:*:) p q u) where
  pure x = pure x :*: pure x
  (f :*: b) <*> (f' :*: b') = (f <*> f') :*: (b <*> b')

instance (Monad (p u), Monad (q u)) => Monad ((:*:) p q u) where
  (fw :*: bw) >>= f = (fw >>= pfst . f) :*: (bw >>= psnd . f)

instance (MonadFail (p u), MonadFail (q u)) => MonadFail ((:*:) p q u) where
  fail msg = fail msg :*: fail msg

This seems to work ok until I recursively use Applicative. For example

x :: (ConstM Maybe :*: ConstM Maybe) () ()
x = fail "" *> x

y :: (ConstM Maybe :*: ConstM Maybe) () ()
y = fail "" >> y

newtype ConstM m p a = ConstM (m a) deriving (Show, Eq, Functor, Applicative, Monad, MonadFail)

The Applicative x will never finish while Monadic y will. Is there a way to define <*> so this can complete?

HELP! Hunting for Problematic Strictness in Products
#2

It seems (:*:) p q u is isomorphic to Product (p u) (q u) from Data.Functor.Product. Is instance Applicative (Product f g) any different from yours?

3 Likes
#3

This will work. Whether it’s a good idea or not, I don’t know.

instance (Applicative (p u), Applicative (q u)) => Applicative ((:*:) p q u) where
  pure x = pure x :*: pure x
  ~(f :*: b) <*> ~(f' :*: b') = (f <*> f') :*: (b <*> b')
#8

It seems strange to me that laziness needs to be explicitly stated. Do you know why that is the case here?

#9

It does look like the exact implementation. I will test this with product and let you know.

#10

It’s because in order to reduce l <*> r, the strict version requires both l and r to be in WHNF in order to extract the f and the b on each side. But in x = fail "" *> x, reducing x to WHNF means reducing the overall expression, so you’re stuck in an infinite loop. Reducing l >> r, which expands to l >>= \_ -> r, only requires reducing l to WHNF at first.

The laziness markers defer the extracting of f and b to when they themselves are needed, which solves the problem. It’s the same as writing

l <*> r = (pfst l <*> pfst r) :*: (psnd l <*> psnd r)

With no patterns to match, l and r don’t have to be reduced to WHNF until one or the other side of the pair is reduced.

The Biapplicative instance for (,), which is close to what you’re doing, uses lazy patterns in its implementation.

Interestingly, the Biapplicative instance for Data.Bifunctor.Product, which is even closer to what you’re doing, does not. I wonder if this is an oversight; I would have expected it to.

(I’m looking at Biapplicatives because that’s the structure that matches the types that you’re using, even if you ultimately only want to use an Applicative. @Bodigrim is correct that regular old Data.Functor.Product should be isomorphic to your use case as well—and huh, that one isn’t lazy either. I wonder if that’s an oversight too.)

1 Like
#11

Thanks, that makes a lot of sense. My next question is why is the strict version chosen instead of the lazy version by the compiler?

If I use Maybe

> x = fail "" *> x :: Maybe ()
> x
Nothing

it uses the lazy version?

So I would have expected the lazy version to have been used by default instead of the strict version. The only reason I can think of is that the pattern matching with (f' :*: b') causes it to be strict.

#12

What do you mean “the strict version” and “the lazy version”? The version of *> that is chosen is the one that is defined for the particular Applicative in question. There’s no other choice involved. The Applicative instance for Maybe only inspects the first argument of *> before deciding to short circuit, so you don’t get an infinite loop.

1 Like
#13 
instance Applicative Maybe where
    pure = Just

    Just f  <*> m       = fmap f m
    Nothing <*> _m      = Nothing

    liftA2 f (Just x) (Just y) = Just (f x y)
    liftA2 _ _ _ = Nothing

    Just _m1 *> m2      = m2
    Nothing  *> _m2     = Nothing

There is no matching on m2 (the recursive term). Same for <*>.

~(f :*: b) <*> ~(f' :*: b') = (f <*> f') :*: (b <*> b')

can actually be

(f :*: b) <*> ~(f' :*: b') = (f <*> f') :*: (b <*> b')

as unpacking f and b and using them is enough to halt the recursion.
Making the first term lazy allows you to pattern match on the constructor :*: but if that’s not enough to provide a result then you’re off to loop land if the first term is recursive.

#14

Added an issue to ghc and bifunctors.

#15

This is safe when the base Applicative is Maybe, but in the general case you want both patterns to be lazy, because unlike Monad, Applicative doesn’t force an order of effects. Consider:

import Control.Applicative (Alternative(..))
import Control.Applicative.Backwards (Backwards(..))

data P1 f g a = P1 (f a) (g a) deriving (Functor, Show)
data P2 f g a = P2 (f a) (g a) deriving (Functor, Show)

instance (Applicative f, Applicative g) => Applicative (P1 f g) where
  pure a = P1 (pure a) (pure a)
  P1 l r <*> ~(P1 l' r') = P1 (l <*> l') (r <*> r')

instance (Alternative f, Alternative g) => Alternative (P1 f g) where
  empty = P1 empty empty
  P1 l r <|> ~(P1 l' r') = P1 (l <|> l') (r <|> r')

instance (Applicative f, Applicative g) => Applicative (P2 f g) where
  pure a = P2 (pure a) (pure a)
  ~(P2 l r) <*> ~(P2 l' r') = P2 (l <*> l') (r <*> r')

instance (Alternative f, Alternative g) => Alternative (P2 f g) where
  empty = P2 empty empty
  ~(P2 l r) <|> ~(P2 l' r') = P2 (l <|> l') (r <|> r')
  
main :: IO ()
main = do
  print (empty <*> undefined :: P1 Maybe Maybe Int)
  print (empty <*> undefined :: P2 Maybe Maybe Int)
  
  -- doesn't work:
  -- print (undefined <*> empty :: P1 (Backwards Maybe) (Backwards Maybe) Int)
  
  -- does work:
  print (undefined <*> empty :: P2 (Backwards Maybe) (Backwards Maybe) Int)
1 Like
#16

That is a really good point. Thank you @rhendric

#17

@rhendric Could you please add your comments to

I have marked Applicative, Alternative, MonadPlus, MonadZip, and Semigroup to be problematic.