Safe stack operations with lens

Question

I wrote this code to learn how to work with State monad. Then I added Either result to gracefully handle error condition (stack underflow).

I believe most of this code is actually unnecessary. I know there are stateful and monadic lens out there, there is EitherT transformer and also StateStack monad. How can I go about incorporating those libraries into this example?

For example, I imagine that it is possible to replace safely with %= or mapMOf from lens library once appropriate EitherT monad stack is constructed but I'm not sure how to get there.

{-# LANGUAGE LambdaCase #-}

module Main where

import           Control.Lens
import           Control.Monad.State

push :: a -> State [a] ()
push a = get >>= put . (a:)

pop :: State [a] (Either String a)
pop = get >>= \case (x:xs) -> liftM (const $ Right x) $ put xs
                    _      -> return $ Left "Stack underflow"

safely :: (a -> a) -> (Either String a) -> State [a] ()
safely f = either (const $ return ()) (push . f)

-- Stack operations that cannot crash program.
--
-- To avoid passing stack back and forth in pure language, use State monad.
-- To avoid `if` statements for overflow checking, use Either monad.
-- To avoid code duplication use parameterized and high-order types.
main :: IO ()
main = do
    print $ runState (push "Hello" >> pop >> pop >>= safely (++" World!") >> pop) []
    print $ runState (push 2 >> pop >>= safely (**7) >> pop) []

Answer 1

I don't really see how lens will help you at all here, but you can certainly take advantage of monad transformers to handle part of your calculations, and make it so that you can layer you stack operation language on top of any monad. (so that you can, as I show below, print out the stack in the middle of the calculation)

{-# LANGUAGE LambdaCase #-}

module Main where

import           Control.Monad.State
import           Control.Monad.Except
import           Control.Monad.Identity

type StackMT s m a = ExceptT String (StateT [s] m) a
type StackM s a = StackMT s Identity a

push :: (Monad m) => s -> StackMT s m ()
push a = modify (a:)

pop :: (Monad m) => StackMT s m s
pop = get >>= \case (x:xs) -> put xs >> return x
                    _      -> throwError "Stack underflow"

safely :: (Monad m) => StackMT s m a -> StackMT s m (Either String a)
safely act = liftM Right act `catchError` (return . Left)

safely_ :: (Monad m) => StackMT s m a -> StackMT s m ()
safely_ act = (act >> return ()) `catchError` (\_ -> return ())

runStackT :: (Monad m) => StackMT s m a -> [s] -> m (Either String a, [s])
runStackT = runStateT . runExceptT

runStack :: StackM s a -> [s] -> (Either String a, [s])
runStack act stack = runIdentity $ runStackT act stack

runOnEmpty :: StackM s a -> (Either String a, [s])
runOnEmpty = flip runStack []

runOnEmptyIO :: StackMT s IO a -> IO (Either String a, [s])
runOnEmptyIO = flip runStackT []

-- Stack operations that cannot crash program.
--
-- To avoid passing stack back and forth in pure language, use State monad.
-- To avoid `if` statements for overflow checking, use Either monad.
-- To avoid code duplication use parameterized and high-order types.
main :: IO ()
main = do
    print =<< runOnEmptyIO (do push "Hello"
                               _ <- pop
                               safely_ $ pop >>= push . (++" World!")
                               get >>= liftIO . putStrLn . ("Stack: " ++) . show
                               pop)
    print $ runOnEmpty $ do push (2::Double)
                            safely_ (pop >>= push . (**7))
                            pop

As you can see, I also added a few convenience methods.

Note that the way this is set up, the StackMT monad transformer has to be the outermost in the stack; that is, if you attempt to apply ListT or ReaderT to something of the form StackMT s m, then in the resulting monad push and pop won't work.