Is what I wrote an actual monad?

Question

I have been trying to understand monads and since I recently understood what zippers are I thought I might try to combine both ideas. (>>=) does what I think monads should do, namely it lets me combine movements around the zipper in the form of moveRight >>= moveLeft >>= goAhead >>= return but I feel like I'm missing something because, among other things, I can't seem to fit its type to what a monad should be, namely Ma -> (a -> Mb) -> Mb. Any help would be welcome.

module MonadZipper where

import Prelude hiding (return, (>>=))

data Node a = Fork a (Node a) (Node a)
            | Passage a (Node a)
            | DeadEnd a
              deriving (Show)

data Branch a = TurnLeft a (Node a)
              | TurnRight a (Node a)
              | StraightAhead a
                deriving (Show)

type Trace a = [Branch a]
type Zipper a = (Trace a, Node a)


type Movement a = Zipper a -> Maybe (Zipper a)
--not sure whether this wrapping makes sense

turnLeft :: Zipper a -> Maybe (Zipper a)
turnLeft (t, (Fork v l r)) = Just (TurnLeft v r:t, l)
turnLeft _                 = Nothing

turnRight :: Zipper a -> Maybe (Zipper a)
turnRight (t, (Fork v l r)) = Just (TurnRight v l:t, r)
turnRight _                 = Nothing

goAhead :: Zipper a -> Maybe (Zipper a)
goAhead (t, Passage v a) = Just (StraightAhead v:t, a)
goAhead _                = Nothing

(>>=) :: Movement a -> Movement a -> Movement a
(>>=) turner func = \zippo ->
                      case turner zippo of
                        Nothing -> Nothing
                        Just tree -> func tree

return :: Zipper a -> Maybe (Zipper a)
return tree = Just tree

Answer 1

Your Movement type is a lot like a combination of the Maybe monad (to allow for failed movements) plus the State monad with the current Zipper a as the state:

State (Zipper a) b  =  Zipper a -> (b, Zipper a)

I'm cheating with the = here . This isn't the precise definition of the State type, but these types are isomorphic, so you can think of State as being equal to this type.

In other words, you've come close to reinventing the transformer-based monad:

type Movement' a b = StateT (Zipper a) Maybe b

The main difference is that Movement' a b is isomorphic to:

Zipper a -> Maybe (b, Zipper a)

so it's got that extra b value that you haven't included.

Sooo....

If you were to rewrite your Movement type as:

type Movement a b = Zipper a -> Maybe (b, Zipper a)

you'd be on to something. Here, Movement isn't a monad -- instead, Movement a is a monad which can be applied to an underlying type Movement a b.

If you're familiar with Either as a monad, it's the same thing: Either by itself isn't a monad, but Either String is a monad that can be applied to another type like Either String Double to represent, say, a computation that returns either a Double result or a String error message.

Similarly, your Movement a is a monad that can be applied to another type Movement a b to represent a computation that returns a b while maintaining a Zipper a as an internal state and allowing failure by returning Nothing.

Moving on, your turnLeft, turnRight, and goAhead are pure effects: they modify the state (the State part of the monad), signalling error if an impossible move is made (the Maybe part of the monad), but they don't need to return anything. That's okay, because they can return (). Here's how goAhead would work:

goAhead :: Movement a ()
-- same as:  goAhead :: Zipper a -> Maybe ((), Zipper a)
goAhead (t, Passage v a) = Just ((), (StraightAhead v:t, a))
goAhead _                = Nothing

and you can make analogous changes to turnLeft and turnRight.

Now, redefining return is relatively easy. It should pack an arbitrary value of type b into your Movement a monad without having any "effects". See if you can fill in the blank:

return :: b -> Movement a b
-- same as:  return :: b -> Zipper a -> Maybe (b, Zipper a)
-- in definitino below, right hand side should be:
--     Movement a b = Zipper a -> Maybe (b, Zipper a)
return b = \z -> _

Of course, (>>=) is a little harder. See if you can figure it out:

(>>=) :: Movement a b -> (b -> Movement a c) -> Movement a c
-- in definition below, right-hand side is a:
--   Movement a c = Zipper a -> Maybe (b, Zipper a)
mb >>= bToMc = \z1 -> case mb z1 of ...

If you give up, I've included the answers below.

With this monad, things can get a little more interesting. For example, you can can introduce an action that does return something. How about the set of valid moves?

data Move = LeftOk | RightOk | StraightOk

validMoves :: Movement a [Move]
validMoves z@(t, n) = case n of
  (Fork _ _ _)  -> Just ([LeftOk, RightOk], z)
  (Passage _ _) -> Just ([StraightOk], z)
  (DeadEnd _)   -> Just ([], z)

or the element at the current position:

peek :: Movement a a
peek z@(_, n) = case n of
  Fork a _ _  -> Just (a, z)
  Passage a _ -> Just (a, z)
  DeadEnd a   -> Just (a, z)

Using this, you can construct a monadic action that walks the zipper, always using the first valid move, and returns the value at the dead end:

findDeadEnd :: Movement a a
findDeadEnd =
    validMoves >>= \moves ->
    case moves of [] -> peek
                  (mv:_) -> (case mv of StraightOk -> goAhead
                                        LeftOk     -> turnLeft
                                        RightOk    -> turnRight)
                            >>= \() -> findDeadEnd

If this was a real monad instance, you could write the above more cleanly in do notation.

Not bad, huh?

Anyway, the full code with the answers for return and >>= is below. Next, you might want to try wrapping your Movement into a newtype so you can define instances:

newtype Movement a b 
  = Movement { runMovement :: Zipper a -> Maybe (b, Zipper a) }
instance Functor (Movement a) where
instance Applicative (Movement a) where
instance Monad (Movement a) where

and see if you can rewrite everything to make it a real Monad.

The full example:

module MonadZipper where

import Prelude hiding (return, (>>=))

data Node a = Fork a (Node a) (Node a)
            | Passage a (Node a)
            | DeadEnd a
              deriving (Show)

data Branch a = TurnLeft a (Node a)
              | TurnRight a (Node a)
              | StraightAhead a
                deriving (Show)

type Trace a = [Branch a]
type Zipper a = (Trace a, Node a)

type Movement a b = Zipper a -> Maybe (b, Zipper a)

(>>=) :: Movement a b -> (b -> Movement a c) -> Movement a c
mb >>= bToMc = \z1 -> case mb z1 of
                        Nothing -> Nothing
                        Just (b, z2) -> bToMc b z2

return :: b -> Movement a b
return b z = Just (b, z)

turnLeft :: Movement a ()
turnLeft (t, (Fork v l r)) = Just ((), (TurnLeft v r:t, l))
turnLeft _                 = Nothing

turnRight :: Movement a ()
turnRight (t, (Fork v l r)) = Just ((), (TurnRight v l:t, r))
turnRight _                 = Nothing

goAhead :: Movement a ()
goAhead (t, Passage v a) = Just ((), (StraightAhead v:t, a))
goAhead _                = Nothing

data Move = LeftOk | RightOk | StraightOk

validMoves :: Movement a [Move]
validMoves z@(t, n) = case n of
  (Fork _ _ _)  -> Just ([LeftOk, RightOk], z)
  (Passage _ _) -> Just ([StraightOk], z)
  (DeadEnd _)   -> Just ([], z)

peek :: Movement a a
peek z@(_, n) = case n of
  Fork a _ _  -> Just (a, z)
  Passage a _ -> Just (a, z)
  DeadEnd a   -> Just (a, z)

findDeadEnd :: Movement a a
findDeadEnd =
    validMoves >>= \moves ->
    case moves of [] -> peek
                  (mv:_) -> (case mv of StraightOk -> goAhead
                                        LeftOk     -> turnLeft
                                        RightOk    -> turnRight)
                            >>= \() -> findDeadEnd

test = case findDeadEnd ([], (Fork 1 (Fork 2 (Passage 3 (DeadEnd 4))
                                             (DeadEnd 5))
                                     (Passage 6 (DeadEnd 7)))) of
         Just (v, _) -> print v