Your Movement type is very similar to the Maybe monad combination (to allow unsuccessful movements) plus the State monad with the current Zipper a as state:
State (Zipper a) b = Zipper a -> (b, Zipper a)
I cheat = here. This is not an exact definition of the State type, but these types are isomorphic, so you can think of State as being equal to that type.
In other words, you are close to creating a monad based on a transformer:
type Movement' ab = StateT (Zipper a) Maybe b
The main difference is that Movement' ab is isomorphic:
Zipper a -> Maybe (b, Zipper a)
to get an extra b value that you didn't include.
Soooo ...
If you must rewrite your Movement type as:
type Movement ab = Zipper a -> Maybe (b, Zipper a)
would you like to say something. Here, Movement not a monad - instead, Movement a is a monad, which can be applied to the base type of Movement ab .
If you are familiar with Either as a monad, this is the same: Either is not a monad by itself, but Either String is a monad that can be applied to another type of type Either String Double to represent, say, a calculation that returns either a message Double , or String error message.
Likewise, your Movement a is a monad that can be applied to another type of Movement ab to represent a calculation that returns b , while preserving Zipper a as an internal state and allowing failure to return Nothing .
Moving on, your turnLeft , turnRight and goAhead are pure effects: they change state (part of the State monad), an error signal if an impossible move is made ( Maybe part of the monad), but they do not need to return anything. This is good because they can return () . Here's how goAhead will work:
goAhead :: Movement a ()
and you can make similar changes to turnLeft and turnRight .
Now overriding return relatively simple. It should pack an arbitrary value of type b into your Movement a monad without any "effects". See if you can fill in the gap:
return :: b -> Movement ab -- same as: return :: b -> Zipper a -> Maybe (b, Zipper a) -- in definitino below, right hand side should be: -- Movement ab = Zipper a -> Maybe (b, Zipper a) return b = \z -> _
Of course (>>=) bit more complicated. See if you can understand this:
(>>=) :: Movement ab -> (b -> Movement ac) -> Movement ac -- in definition below, right-hand side is a: -- Movement ac = Zipper a -> Maybe (b, Zipper a) mb >>= bToMc = \z1 -> case mb z1 of ...
If you give up, I have included the answers below.
With this monad, things can get a little more interesting. For example, you can enter an action that returns something. How about a 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 item at current position:
peek :: Movement aa 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 create a monadic action that moves the zipper, always using the first valid move and returning the value at the dead end:
findDeadEnd :: Movement aa findDeadEnd = validMoves >>= \moves -> case moves of [] -> peek (mv:_) -> (case mv of StraightOk -> goAhead LeftOk -> turnLeft RightOk -> turnRight) >>= \() -> findDeadEnd
If it was a real copy of the monad, you could write above more clearly in the do notation.
Not bad, huh?
In any case, the full code with answers for return and >>= given below. Then you can try wrapping your Movement in a new type so that you can define instances:
newtype Movement ab = 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 .
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 ab = Zipper a -> Maybe (b, Zipper a) (>>=) :: Movement ab -> (b -> Movement ac) -> Movement ac mb >>= bToMc = \z1 -> case mb z1 of Nothing -> Nothing Just (b, z2) -> bToMc b z2 return :: b -> Movement ab return bz = Just (b, z) turnLeft :: Movement a () turnLeft (t, (Fork vlr)) = Just ((), (TurnLeft vr:t, l)) turnLeft _ = Nothing turnRight :: Movement a () turnRight (t, (Fork vlr)) = Just ((), (TurnRight vl:t, r)) turnRight _ = Nothing goAhead :: Movement a () goAhead (t, Passage va) = 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 aa peek z@ (_, n) = case n of Fork a _ _ -> Just (a, z) Passage a _ -> Just (a, z) DeadEnd a -> Just (a, z) findDeadEnd :: Movement aa 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