FrameStack.hs

{-# language DeriveFunctor #-}

import Control.Applicative ((<|>))

import qualified Data.Map as Map
import Data.Map (Map)
import Data.Maybe

newtype FrameStack k v = FrameStack
    { rawFrameStack :: [Map k v]
    }
    deriving (Functor)  -- allows mapping over `V`

empty :: FrameStack k v
empty = FrameStack []

exit :: FrameStack k v -> Maybe (FrameStack k v)
exit (FrameStack (_ : stack)) = Just (FrameStack stack)
exit  _                       = Nothing

enter :: FrameStack k v -> FrameStack k v
enter (FrameStack stack) = FrameStack (Map.empty : stack)

get :: Ord k => k -> FrameStack k v -> Maybe v
get key frameStack = listToMaybe (list key frameStack)

list :: Ord k => k -> FrameStack k v -> [v]
list key (FrameStack stack) = map (Map.lookup key) stack >>= maybeToList

set :: Ord k => k -> v -> FrameStack k v -> FrameStack k v
set k v (FrameStack (top : rest)) = FrameStack (Map.insert k v top : rest)

main = do
    let infinite = FrameStack (repeat Map.empty)
    let withFoo  = set 1 "foo" (enter infinite)

    print (get 1 withFoo) -- prints: Just "foo"