Why are (>>=) and (>>) left associative while do-notation and (>=>) right associative?

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.

1 Like

Never mind. It is easily seen from the type signature that (>>=) cannot be right associated. And (>>) just follows the convention of (>>=).

I think it has less to do with the type signature as it is than it has to do with the syntax for lambda expressions, which came first.

Bind is meant to ‘bind’ the result of a monadic computation within the scope ‘whatever monadic computation comes next’. The thing is that ‘whatever comes next can be arbitrarily big/long. This isn’t an issue with lambda syntax:

m >>= \x -> (… the rest
   can be
   however long
   you want…
   …)

So bind and lambda work well together in this way.

Do notation is a convenience, meant to emulate imperative languages, where the ‘whatever comes next’ is the rest of the block of statements. In this way it is ‘right associated’ but I would think of it as just a convenient syntax for the nested lambdas that is common when using bind.

1 Like

The lambda syntax takes precedence (no pun intended) over the associativity of the bind operator, so the fixity declaration doesn’t influence how the lambda notation works together with the bind operation. In fact, the lambda notation always forces a kind of right associativity, so I still find it very weird that the fixity declaration of bind gives it left associativity. Compare:

m >>= f >>= g
m >>= \x -> f x >>= g

Adding the invisible parentheses yields:

(m >>= f) >>= g
m >>= (\x -> f x >>= g)

I find that unnatural.

But indeed as @mozhewen says, making bind right associative yields a type error (I guess it could work with a particular choice of monad):

m >>= (f >>= g)

Perhaps >>= should just have had no associativity and >> should have been right associative.

2 Likes

It’s not a type error. Both choices of associativity type check, although I’d say that neither of them is very useful. The right-associative one seems to rely on instance Monad ((->) a1)

ghci> :t \a b c -> a >>= b >>= c
\a b c -> a >>= b >>= c
  :: Monad m => m a1 -> (a1 -> m a2) -> (a2 -> m b) -> m b
ghci> :t \a b c -> (a >>= b) >>= c
\a b c -> (a >>= b) >>= c
  :: Monad m => m a1 -> (a1 -> m a2) -> (a2 -> m b) -> m b
ghci> :t \a b c -> a >>= (b >>= c)
\a b c -> a >>= (b >>= c)
  :: Monad m => m a1 -> (a1 -> a2) -> (a2 -> a1 -> m b) -> m b

I think this would have been the correct choice. I suppose the choice was made 30 years ago before much was understood about how they’d be used in practice.

3 Likes