I think I already know, the monad is not a state monad, but a writer
monad. I have to implement the dsl in a state monad.
Sorry I was somewhat too fast sending to the list. But comments are of
course still welcome.
On 4/15/10, 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)
-- Flatliner ICT Service, Email: Edgar.klerks@gmail.com, Tel: +31727851429 Fax: +31848363080 Skype: edgar.klerks Website: flatlinerict.nl Adres: Koelmalaan 258, 1813JD, Alkmaar Nederland