use Writer monad and StateT to implement ListZipper

gistfile1.hs

import Control.Monad
import Control.Monad.Writer
import Control.Monad.Trans.State

type ListZipper a = ([a], [a])

-- move focus forward, put previous root into breadcrumbs
goForward :: ListZipper a -> ListZipper a
goForward (x:xs, bs) = (xs, x:bs)

-- move focus back, restore previous root from breadcrumbs
goBack :: ListZipper a -> ListZipper a
goBack (xs, b:bs) = (b:xs, bs)

-- wrap goForward so it becomes a State
goForwardS :: StateT (ListZipper a) (Writer [String]) [a]
goForwardS = state stateTrans where
	stateTrans z = (fst newZ, newZ) where
		newZ = goForward z

-- wrap goBack so it becomes a State
goBackS :: StateT (ListZipper a) (Writer [String]) [a]
goBackS = state stateTrans where
	stateTrans z = (fst newZ, newZ) where
		newZ = goBack z

goForwardLog = do
	l <- goForwardS
	lift $ tell ["move forward, current focus:\t" ++ (show l)]

goBackLog = do
	l <- goBackS
	lift $ tell ["move back, current focus:\t" ++ (show l)]

-- nothing but write out current focus
printLog :: Show a => StateT (ListZipper a) (Writer [String]) [a]
printLog = do 
	l <- state $ \z -> (fst z, z) 
	lift $ tell ["print current focus:\t" ++ (show l)]
	return l

-- return
listZipper :: [a] -> ListZipper a
listZipper xs = (xs, [])

_performTestCase1 = do
	printLog
	goForwardLog
	goForwardLog
	goBackLog
	printLog

performTestCase1 = do
	let ((a, s), w) = runWriter $ runStateT _performTestCase1 (listZipper [1..4])
	putStrLn $ "Focus:\t" ++ (show a)
	putStrLn $ "Zipper:\t" ++ (show s)
	putStrLn "Log:"
	mapM_ putStrLn w

main = performTestCase1