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?
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')
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.)
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.
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.
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 <*>.
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.
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)