content: -- | 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.partition
                , 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)
  
  -- | Find elements matching an predicate and lift them out of the queue
  partition :: (a -> Bool) -> Queue a -> ([a], Queue a)
  partition p (Queue front back) =
      let (ft, fl) = Lst.partition p front
          (bt, bl) = Lst.partition p back
      in (ft ++ bt, Queue fl bl)
  
  ---------------------------------------------------------------------
  -- 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
  