{-# LANGUAGE NamedFieldPuns, GeneralizedNewtypeDeriving, TypeFamilies #-} -- | A basic implementation of a stack implementing the 'Queue' abstraction. module Data.Queue.Stack (Stack) where import Data.Monoid import Data.Queue.Class import Data.Queue.QueueHelpers import Data.Maybe newtype Stk e = Stk [e] newtype Stack e = S (MonoidQ (Stk e)) deriving (Monoid) instance Monoid (Stk e) where mempty = Stk [] Stk s1 `mappend` Stk s2 = Stk (reverse s2 ++ s1) instance Queuelike (Stack e) where type QueueKey (Stack e) = e empty = mempty merge = mappend insert x (S (HQ n (Stk xs))) = S (HQ (n+1) (Stk (x:xs))) singleton x = S (HQ 1 (Stk [x])) extract (S (HQ (n+1) (Stk (x:xs)))) = Just (x, S (HQ n (Stk xs))) extract _ = Nothing size (S HQ{elts}) = elts toList (S HQ{heap = Stk xs}) = xs