Double-Stack Haskell implementation using State and Maybe monads.

doubleStack.hs

import Control.Monad
import Control.Monad.State

type DoubleStack = ([Int],[Int])

--INTERACTIVE MAIN:
main = do
  putStrLn ("Insert an initial doubleStack in the format: ([1,2,3],[4,5,6])")
  initialStack <- getLine
  stackManip (Just (read initialStack))


--EXAMPLE MAIN WITH A FIXED SEQUENCE OF OPERATIONS:
--main = do
  --putStrLn ("Insert an initial doubleStack in the format: ([1,2,3],[4,5,6])")
  --initialStack <- getLine
  --putStrLn ("You inserted " ++ s)
  --putStrLn (show (runState (do push 7; move; move; pop; pop) (Just (read initialStack))))


--PUSH: pushes an Int on the top of the left stack. It returns a couple
--(Nothing, Just doubleStack-state) or (Nothing, Nothing) if the operation is
--part of an already illegal sequence of operations (i.e. the previous state
--was Nothing).
push :: Int -> State (Maybe DoubleStack) (Maybe Int)
push a = do
    s <- get
    if s == Nothing then do
      put Nothing
      return Nothing
    else do
      Just (xs,ys) <- get
      put (Just ((a:xs),ys))
      return Nothing

--MOVE: moves the value on the top of the left stack to the top of
--the right stack.
--It returns a couple (Nothing, Just doubleStack-state) or (Nothing, Nothing)
--if the left stack is empty or if the operation is part of an already illegal
--sequence of operations (i.e. the previous state was Nothing).
move :: State (Maybe DoubleStack) (Maybe Int)
move = do
    s <- get
    if s == Nothing then do
      put Nothing
      return Nothing
    else do
      Just (xs, ys) <- get
      if xs == [] then do
        put Nothing
        return Nothing
      else do
        Just ((x:xs),ys) <- get
        put (Just (xs,(x:ys)))
        return Nothing

--POP: pops the value on the top of the right stack. The function returns
--a couple (Just Int, Just doubleStack-state) or (Nothing, Nothing) if the
--right stack is empty or if the operation is part of an already illegal
--sequence of operations (i.e. the previous state was Nothing).
pop :: State (Maybe DoubleStack) (Maybe Int)
pop = do
    s <- get
    if s == Nothing then do
      put Nothing
      return Nothing
    else do
      Just (xs, ys) <- get
      if ys == [] then do
        put Nothing
        return Nothing
      else do
        Just (xs,(y:ys)) <- get
        put (Just (xs,ys))
        return (Just y)

--Function that, given a couple (Maybe Int, Maybe DoubleStack) as the ones
--returned by the defined operations, it returns the DoubleStack state.
--It is an helper function of the stackManip function.
extractState :: (Maybe Int, Maybe DoubleStack) -> (Maybe DoubleStack)
extractState (_,b) = b

--Function used to implement the cycle in the interactive main, it calls
--itself indefinetely in a recursive way.
--The user, at every recursive iteration, can decide to perform
--an operation (pop, push or move) or to exit.
stackManip :: (Maybe DoubleStack) -> IO ()
stackManip init = do
  putStrLn ("Choose an operation:")
  putStrLn ("1) pop;")
  putStrLn ("2) move;")
  putStrLn ("3) push;")
  putStrLn ("4) close program.")
  putStrLn ("Insert the number of the operation.")
  op <- getLine
  if op == "1" then do
    putStrLn ("----------------------------")
    putStrLn ("RESULT:")
    putStrLn (show (runState (do pop) init))
    stackManip (extractState (runState (do pop) init))
  else if op == "2" then do
    putStrLn ("----------------------------")
    putStrLn ("RESULT:")
    putStrLn (show (runState (do move) init))
    stackManip (extractState (runState (do move) init))
  else if op == "3" then do
    putStrLn ("Insert the number to push:")
    num <- getLine
    putStrLn ("----------------------------")
    putStrLn ("RESULT:")
    putStrLn (show (runState (do push (read num)) init))
    stackManip (extractState (runState (do push (read num)) init))
  else if op == "4" then do
    putStrLn ("End.")
  else do
    putStrLn ("Invalid operation.")
    stackManip init