[Haskell-beginners] Trying to find an alternative StateMonad

[edgar klerks]

Hi All,

I wanted to write the statemonad in a different way, because I want to
track mutations to the state. And also to be able to undo an done or
redo an undone mutation. Therefore I wrote a small dsl with an
evaluator, which finds out the current state.

The problem is, I don't know how to create a get and put function for
my monad. I have a function which evaluate the state and gives back
the current State.

Can someone help me a bit along? I have the feeling I do something
wrong, but I am not sure what.

With kind regards,

Edgar

{-# LANGUAGE GADTs,DeriveFunctor  #-}
import Control.Monad
import Data.Maybe

data StateCmd a where
	Put :: a -> StateCmd a
	Undo :: StateCmd a
	Redo :: StateCmd a
		deriving (Show, Functor)

newtype State s a = State { unState :: ([StateCmd s],a) }
	deriving Show

joinState :: State s a -> State s b -> State s b
joinState (State (xs, a)) (State (ys, b)) = State (xs ++ ys, b)

instance Monad (State s) where
	return a = State $ ([], a)
	(>>=) = bindState

-- m a -> ( a -> m b) -> m b
bindState st@(State (_,a)) f = st `joinState` st'
	where st' = f a

unPut :: StateCmd a -> Maybe a
unPut (Put a) = Just a
unPut _ = Nothing

test = State $ ([Put 4, Undo, Redo, Undo, Put 5, Undo, Redo,  Put 6,
Undo, Redo, Undo], ())

getCurrent = fromJust.unPut.head.snd.(foldr current'
([],[])).reverse.fst.unState
		where current' x (ul,cl) = case x of
					Put n -> (ul, Put n : cl)
					Undo -> (head cl : ul, tail cl)
					Redo -> (tail ul, head ul : cl)