I wrote a test monad to test different ways of monad composition:
newtype Logger a = Logger (Maybe a, Int)
deriving (Show)
instance Functor Logger where
fmap = liftM
instance Applicative Logger where
pure a = Logger (Just a, 0)
(<*>) = ap
instance Monad Logger where
Logger (Just a, s) >>= f = Logger (b, s + s1 + 1)
where
Logger (b, s1) = f a
Logger (Nothing, s) >>= _ = Logger (Nothing, s + 1)
instance MonadFail Logger where
fail _ = Logger (Nothing, 0)
where counter s::Int
counts the number of times that (>>=)
is invoked.
test1 :: Logger Integer
test1 = do
pure 11
fail ""
pure 22
pure 33
pure 44
-- >>> test1
-- Logger (Nothing,2)
test2 :: Logger Integer
test2 =
(\x -> pure 11)
>=> (\x -> fail "")
>=> (\x -> pure 22)
>=> (\x -> pure 33)
>=> (\x -> pure 44)
$ 0
-- >>> test2
-- Logger (Nothing,2)
test3 :: Logger Integer
test3 =
pure 11
>>= (\x -> fail "")
>>= (\x -> pure 22)
>>= (\x -> pure 33)
>>= (\x -> pure 44)
-- >>> test3
-- Logger (Nothing,4)
test4 :: Logger Integer
test4 = pure 11 >> fail "" >> pure 22 >> pure 33 >> pure 44
-- >>> test4
-- Logger (Nothing,4)
As you can see, the do-notation and (>=>)
are right associated and thus allow an earlier escape from the monad when running into a failure. (>>=)
and (>>)
, on the other hand, are left associated and need to pass the failure to the right.
I know that both implementations (left/right association) obey the monad law, but I wonder what is the design principle of this discrepancy for different operators.