-- | Simple Functional queues based on a double list. This usually achieves good amortized bounds
module Data.Queue (
-- * Types
Queue
-- * Functions
, empty
, null
, first
, remove
, push
, pop
, Data.Queue.filter
-- * Test Suite
, testSuite
)
where
import Data.List as Lst hiding (null)
import Data.Maybe (fromJust)
import Prelude hiding (null)
import Test.QuickCheck
import Test.Framework
import Test.Framework.Providers.QuickCheck2
import Test.Framework.Providers.HUnit
import Test.HUnit hiding (Path, Test)
data Queue a = Queue [a] [a]
deriving (Eq, Show)
-- | The definition of an empty Queue
empty :: Queue a
empty = Queue [] []
-- | Returns True on an empty Queue, and False otherwise.
null :: Queue a -> Bool
null (Queue [] []) = True
null _ = False
-- | Pushes a new element to the tail of the list.
-- Operates in constant time.
push :: a -> Queue a -> Queue a
push e (Queue front back) = Queue front (e : back)
-- | Pops the top most element off the queue.
-- Operates in amortized constant time
pop :: Queue a -> Maybe (a, Queue a)
pop (Queue [] []) = Nothing
pop (Queue (e : es) back) = Just (e, Queue es back)
pop (Queue [] back) = pop (Queue (reverse back) [])
-- | Return the head of the queue, if any
first :: Queue a -> Maybe a
first (Queue [] []) = Nothing
first (Queue (e : _) _) = Just e
first (Queue [] back) = Just $ last back -- Yeah slow
-- | Kill the first element in the queue
remove :: Queue a -> Queue a
remove (Queue [] []) = Queue [] []
remove (Queue (_ : es) b) = Queue es b
remove (Queue [] b) = remove (Queue (reverse b) [])
-- | Generates a new Queue only containing elements for which
-- p returns true.
filter :: (a -> Bool) -> Queue a -> Queue a
filter p (Queue front back) = Queue (Lst.filter p front) (Lst.filter p back)
-- Tests
testSuite :: Test
testSuite = testGroup "Data/Queue"
[ testCase "Empty Queue is Empty" testEmptyIsEmpty
, testCase "First/Remove" testFirstRemove
, testProperty "Simple push/pop" testPushPopSimple
, testProperty "push/pop more" testPushPopMore
, testProperty "push/pop interleave" testPushPopInterleave
]
-- Rudimentary boring simple tests
testEmptyIsEmpty :: Assertion
testEmptyIsEmpty = do
assertBool "for Empty Q" (null empty)
assertBool "for non-Empty Q" (not $ null (push "Foo" empty))
assertEqual "for popping the Empty Q" (pop $ snd . fromJust . pop $ push "Foo" empty) Nothing
testFirstRemove :: Assertion
testFirstRemove = do
-- Should really cover this more
let nq = push 2 (push (1 :: Integer) empty)
assertEqual "first" (first nq) (Just 1)
assertEqual "first/removed" (first (remove nq)) (Just 2)
assertEqual "emptied" (first (remove (remove nq))) Nothing
testPushPopSimple :: String -> Bool
testPushPopSimple s =
let nq = pop (push s empty)
in case nq of
Nothing -> False
Just (r, q) -> r == s && null q
testPushPopMore :: [String] -> Bool
testPushPopMore ls =
let nq = foldl (flip push) empty ls
popAll = unfoldr pop nq
in popAll == ls
data Operation = Push | Pop
deriving (Eq, Show)
instance Arbitrary Operation where
arbitrary = oneof [return Push, return Pop]
testPushPopInterleave :: [Operation] -> [String] -> Bool
testPushPopInterleave ops ls = testQ empty ops ls []
where
testQ q op lst res =
case op of
[] -> popAll q == reverse res
Pop : r -> case pop q of
Nothing -> testQ empty r lst []
Just (e, nq) ->
if (last res) == e
then testQ nq r lst (init res)
else False
Push : r -> case lst of
[] -> testQ q r lst res
(e : es) -> testQ (push e q) r es (e : res)
popAll = unfoldr pop