toktok-0.5: Toktok/Stack.hs

{-# LANGUAGE TypeSynonymInstances #-}
module Toktok.Stack where

import Data.Monoid

newtype Stack a = Stack [[a]]
   deriving (Show, Eq)

merge :: Stack a -> Stack a -> Stack a
merge (Stack a) (Stack b) = Stack $ merge' a b
   where merge' [] b = b
         merge' a [] = a
         merge' (l:ls) (l':ls') 
            = (l ++ l'):merge' ls ls'

singleton :: Int -> a -> Stack a
singleton n a = Stack $ singleton' n a
   where singleton' n x | n <= 0 = error "index should be > 0"
         singleton' n x | n == 1 =  [[x]]
         singleton' n x = []:singleton' (n-1) x

instance Monoid (Stack a) where
   mempty = Stack []
   mappend = merge


head :: Stack a -> [a]
head (Stack []) = []
head (Stack (l:_)) = l

pop:: Stack a -> Stack a
pop (Stack []) = Stack []
pop (Stack (_:ls)) = Stack ls

emptyStack :: Stack a
emptyStack = Stack []