module StackM (StackM, pushM, popM, isEmptyM, runStackM)
where
import Control.Monad
import Control.Monad.Trans

newtype Monad m => StackM a m b = StackM ([a] -> m ([a], b))

instance Monad m => Monad (StackM a m) where
    return result = StackM $ \state -> return (state, result)
    StackM priorFunction >>= nextAction =
	let combinedFunction priorState = 
              do (currentState, priorResult) <- priorFunction priorState
	         let StackM nextFunction = nextAction priorResult
                 nextFunction currentState
         in StackM combinedFunction

instance MonadTrans (StackM a) where
    lift resultAction =
        StackM liftFunction
        where
        liftFunction state =
            do result <- resultAction
               return (state, result)

pushM :: Monad m => a -> StackM a m ()

pushM item =
    StackM $ \state -> return (item : state, ())

popM :: Monad m => StackM a m a

popM =
    StackM popFunction
    where
    popFunction state =
           case state of
               []                 -> error "stack empty"
               (item : remainder) -> return (remainder, item)

isEmptyM :: Monad m => StackM a m Bool

isEmptyM = 
    StackM $ \state -> return (state, null state)

runStackM :: Monad m => StackM a m b -> m b

runStackM (StackM function) = 
    do (liftM snd) (function [])