use State monad and WriterT to implement ListZipper

gistfile1.hs

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

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
goForwardW :: WriterT [String] (State (ListZipper a)) [a]
goForwardW = lift $ state stateTrans where
	stateTrans z = (fst newZ, newZ) where
		newZ = goForward z

-- wrap goBack so it becomes a State
goBackW :: WriterT [String] (State (ListZipper a)) [a]
goBackW = lift $ state stateTrans where
	stateTrans z = (fst newZ, newZ) where
		newZ = goBack z

goForwardLog :: Show a => WriterT [String] (State (ListZipper a)) [a]
goForwardLog = do
	l <- goForwardW
	tell ["move forward, current focus:\t" ++ (show l)]
	return l

goBackLog :: Show a => WriterT [String] (State (ListZipper a)) [a]
goBackLog = do
	l <- goBackW
	tell ["move back, current focus:\t" ++ (show l)]
	return l

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

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

_performTestCase1 :: Show a =>  WriterT [String] (State (ListZipper a)) [a]
_performTestCase1 = do
	printLog
	goForwardLog
	goForwardLog
	goBackLog
	printLog

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

main = performTestCase1