{-# LANGUAGE NoMonomorphismRestriction,MultiParamTypeClasses,FlexibleContexts,
FlexibleInstances,GeneralizedNewtypeDeriving,UndecidableInstances #-}-- | This code has been taken from <http://haskell.org> -- A Monad transformer UndoT on a state supporting undo , redo and hput to push the last state on history.-- Redo stack is blanked on hputmoduleUndowhereimportControl.Monad.State-- | State stacks wrapping states in timedataHistorys=History{current::s,-- ^ last state puttedundos::[s],-- ^ the history of putted states (reversed) without the redosredos::[s]-- ^ history of the undo}derivingShow-- | a state monad transformer with the state historytypeHStateTsm=StateT(Historys)m-- | facility to write signatures contextclass(Monadm,MonadState(Historys)(HStateTsm))=>HCtxmsinstance(Monadm,MonadState(Historys)(HStateTsm))=>HCtxms-- | a wrapper around HStateT to derive his classes and add an instancenewtypeMonadm=>UndoTsma=UndoT(HStateTsma)deriving(Functor,Monad,MonadTrans,MonadIO)-- | the MonadState instance for the wrapperinstance(Monadm)=>MonadStates(UndoTsm)whereget=UndoT$getscurrentputx=UndoT$get>>=\(History_usrs)->put$Historyxusrs-- | tries to get back one step the stateundo::HCtxms=>UndoTsmBool-- ^ False if the undo stack was emptyundo=UndoT$doHistorycusrs<-getifnullusthenreturnFalseelseput(History(headus)(tailus)(c:rs))>>returnTrue-- | tries to get back the undo operationredo::HCtxms=>UndoTsmBool-- ^ False if the redo stack was emptyredo=UndoT$doHistorycusrs<-getifnullrsthenreturnFalseelseput(History(headrs)(c:us)(tailrs))>>returnTrue-- | push the old state in the undo stack and set the new state (alternative to put)hput::HCtxms=>s-- ^ the new state to put->UndoTsm()-- ^ monadinghputx=UndoT$doHistorycundosredos<-getput(Historyx(c:undos)[])-- | an History of one stateblank::s->Historysblanks=Historys[][]-- | run the UndoT monad transformer spitting out the computation result in the inner monadevalUndoT::(Monadm)=>UndoTsma-- ^ a UndoT action->s-- ^ the initial state->ma-- ^ the resultevalUndoT(UndoTx)s=evalStateTx(blanks)-- | run the UndoT monad transformer spitting out the final state in the inner monadexecUndoT::(Monadm)=>UndoTsma-- ^ a UndoT action->s-- ^ the initial state->ms-- ^ the final stateexecUndoT(UndoTx)s=liftMcurrent$execStateTx(blanks)