Queue.hs

{-# LANGUAGE ScopedTypeVariables, TypeApplications, AllowAmbiguousTypes #-}
-- {-# OPTIONS_GHC -fdefer-type-errors #-}

module Queue where

import Data.Maybe (fromJust)
import Test.QuickCheck

class Queue q where
  empty :: q a
  push :: a -> q a -> q a
  pop :: q a -> (Maybe a, q a)
  peek :: q a -> Maybe a
  size :: q a -> Int
  isEmpty :: q a -> Bool
  isEmpty = (== 0) . size
  member :: Eq a => a -> q a -> Bool
  toList :: q a -> [a]
  toList = step . pop
    where step (Nothing, _) = []
          step (Just x, rest) = x : toList rest
  fromList :: Foldable t => t a -> q a
  fromList = foldr push empty


prop_EmptySizeZero :: Bool
prop_EmptySizeZero = size (empty :: Q Int) == 0

prop_PushMember :: Queue q => Int -> q Int -> Bool
prop_PushMember x q = member x $ push x q

prop_PopSizeDecr :: Queue q => q Int -> Property
prop_PopSizeDecr q = not (isEmpty q) ==> size q - 1 == size newQ
  where (_, newQ) = pop q

prop_PushPopNoChange :: Queue q => Int -> q Int -> Bool
prop_PushPopNoChange x q = size q == size newQ
  where (_, newQ) = pop $ push x q

prop_PopPushNoChange :: Queue q => q Int -> Property
prop_PopPushNoChange q = not (isEmpty q) ==>
  size (push (fromJust x) newQ) == size q
  where (x, newQ) = pop q

prop_ToFromListIdentity :: Queue q => [Int] -> Bool
prop_ToFromListIdentity xs = toList ((fromList :: [Int] -> Q Int) xs) == xs

data Q a = Q [a] [a]

instance Queue Q where
  empty = Q [] []
  push x (Q i o) = Q (x : i) o
  pop q@(Q i o) = helper i o
    where helper [] []       = (Nothing, q)
          helper _  []       = pop $ inboxToOutbox q
          helper _  (x : xs) = (Just x, Q i xs)
  peek q@(Q i o) = helper i o
    where helper [] []       = Nothing
          helper _  []       = peek $ inboxToOutbox q
          helper _  (x : xs) = Just x
  size (Q i o) = length i + length o
  member x (Q i o) = x `elem` i || x `elem` o

inboxToOutbox :: Q a -> Q a
inboxToOutbox (Q i o) = Q [] $ reverse i


instance Arbitrary (Q a) where
  arbitrary = liftM2 Q (arbitrary :: Gen [a]) (arbitrary :: Gen [a])
  shrink (Q i o) = liftM2 (shrink i) (shrink o)