Is `data PoE a = Empty | Pair a a` a monad?

Question

This question comes from this answer in example of a functor that is Applicative but not a Monad: It is claimed that the

data PoE a = Empty | Pair a a deriving (         


        

Answer 1

Since you are interested in how to do it systematically, here's how I found a counterexample with quickcheck:

{-# LANGUAGE DeriveFunctor #-}

import Control.Monad ((>=>))
import Test.QuickCheck

-- <your code>

Defining an arbitrary instance to generate random PoEs.

instance (Arbitrary a) => Arbitrary (PoE a) where
    arbitrary = do
      emptyq <- arbitrary
      if emptyq
        then return Empty
        else Pair <$> arbitrary <*> arbitrary

And tests for the monad laws:

prop_right_id m = (m >>= return) == m
    where
    _types = (m :: PoE Int)

prop_left_id fun x = (return x >>= f) == f x
    where
    _types = fun :: Fun Int (PoE Int)
    f = applyFun fun

prop_assoc fun gun hun x = (f >=> (g >=> h)) x == ((f >=> g) >=> h) x
    where
    _types = (fun :: Fun Int (PoE Int),
              gun :: Fun Int (PoE Int),
              hun :: Fun Int (PoE Int),
              x :: Int)
    f = applyFun fun
    g = applyFun gun
    h = applyFun hun

I don't get any failures for the identity laws, but prop_assoc does generate a counterexample:

ghci> quickCheck prop_assoc
*** Failed! Falsifiable (after 7 tests and 36 shrinks):
{6->Pair 1 (-1), _->Empty}
{-1->Pair (-3) (-4), 1->Pair (-1) (-2), _->Empty}
{-3->Empty, _->Pair (-2) (-4)}
6

Not that it's terribly helpful for understanding why the failure occurs, it does give you a place to start. If we look carefully, we see that we are passing (-3) and (-2) to the third function; (-3) maps to Empty and (-2) maps to a Pair, so we can't defer to the laws of either of the two monads PoE is composed of.

Answer 2

Apparently, it is not a monad. One of the monad "join" laws is

join . join = join . fmap join

Hence, according to the law above, these two outputs should be equal, but they are not.

main :: IO ()
main = do
  let x = Pair (Pair (Pair 1 2) Empty) (Pair Empty (Pair 7 8))
  print (join . join $ x)
  -- output: Pair 1 8
  print (join . fmap join $ x)
  -- output: Empty

The problem is that

join x      = Pair (Pair 1 2) (Pair 7 8)
fmap join x = Pair Empty Empty

Performing an additional join on those does not make them equal.

how to find that out systematically?

join . join has type m (m (m a)) -> m (m a), so I started with a triple-nested Pair-of-Pair-of-Pair, using numbers 1..8. That worked fine. Then, I tried to insert some Empty inside, and quickly found the counterexample above.

This approach was possible since a m (m (m Int)) only contains a finite amount of integers inside, and we only have constructors Pair and Empty to try.

For these checks, I find the join law easier to test than, say, associativity of >>=.

Answer 3

QuickCheck immediately finds a counterexample to associativity.

{-# LANGUAGE DeriveFunctor #-}

import Test.QuickCheck

data PoE a = Empty | Pair a a deriving (Functor,Eq, Show)

instance Applicative PoE where
    pure x = Pair x x
    Pair f g <*> Pair x y = Pair (f x) (g y)
    _        <*> _        = Empty
instance Monad PoE where
    Empty    >>= _ = Empty
    Pair x y >>= f = case (f x, f y) of 
                       (Pair x' _,Pair _ y') -> Pair x' y'
                       _ -> Empty

instance Arbitrary a => Arbitrary (PoE a) where
  arbitrary = oneof [pure Empty, Pair <$> arbitrary <*> arbitrary]

prop_assoc :: PoE Bool -> (Bool -> PoE Bool) -> (Bool -> PoE Bool) -> Property
prop_assoc m k h =
  ((m >>= k) >>= h) === (m >>= (\a -> k a >>= h))

main = do
  quickCheck $ \m (Fn k) (Fn h) -> prop_assoc m k h

Output:

*** Failed! Falsifiable (after 35 tests and 3 shrinks):    
Pair True False
{False->Pair False False, True->Pair False True, _->Empty}
{False->Pair False True, _->Empty}
Pair False True /= Empty