content: {-# Language DeriveDataTypeable, NoMonomorphismRestriction #-}
  import Test.FitSpec
  import Prelude hiding (null)
  import qualified Data.List as L
  import Data.Maybe (listToMaybe)
  import Heap
  import Control.Monad (unless)
  
  instance (Ord a, Listable a) => Listable (Heap a) where
    tiers = bagCons fromList
  
  instance (Ord a, Listable a) => Mutable (Heap a) where
    mutiers = mutiersEq 
  
  instance (Ord a, Show a, Listable a) => ShowMutable (Heap a) where
    mutantS = mutantSEq
  
  type Merge a = Heap a -> Heap a -> Heap a
  type Ty a = Merge a
  
  properties :: (Ord a, Show a, Listable a)
             => Merge a
             -> [Property]
  properties merge =
    [ property $ \h h1    -> merge h h1 == merge h1 h
    , property $ \h       -> merge h Nil == h
    , property $ \x h h1  -> merge h (insert x h1) == insert x (merge h h1)
    , property $ \h h1 h2 -> merge h (merge h1 h2) == merge h1 (merge h h2)
    , property $ \h       -> notNull h ==> findMin (merge h h) == findMin h
    , property $ \h       -> null (merge h h) == null h
    , property $ \h       -> notNull h ==> merge h (deleteMin h) == deleteMin (merge h h)
    , property $ \h h1    -> (null h && null h1) == null (merge h h1)
  --, property $ \xs ys   -> merge (fromList xs) (fromList ys) == fromList (xs++ys)
  --, property $ \h h1    -> mergeLists (toList h) (toList h1) == toList (merge h h1)
    ]
    where notNull = not . null
  
  sargs = args
    { timeout  = 0
    , nMutants = 500
    , nTests   = 500
    , names    = ["merge h h'"]
    }
  
  em :: (Bounded a, Ord a) => [Ty a]
  em = take 4
    [ (\_ _ -> Nil)
    , maxMerge
    , crazyMerge
    , mergeEqNil
    ]
  
  main :: IO ()
  main = do 
    as <- getArgsWith sargs
    let run f = reportWithExtra em as f properties
    case concat (extra as) of
      "bool"  -> run (merge :: Ty Bool)
      "bools" -> run (merge :: Ty [Bool])
      "i"     -> run (merge :: Ty Int)
      "i1"    -> run (merge :: Ty Int1)
      "i2"    -> run (merge :: Ty Int2)
      "i3"    -> run (merge :: Ty Int3)
      "w1"    -> run (merge :: Ty Word1)
      "w2"    -> run (merge :: Ty Word2)
      "w3"    -> run (merge :: Ty Word3)
      "unit"  -> run (merge :: Ty ())
      ""      -> run (merge :: Ty Word2)
  
  
  maxInsert :: Ord a => a -> Heap a -> Heap a
  maxInsert x h = maxMerge h (branch x Nil Nil)
  
  maxDeleteMin :: Ord a => Heap a -> Heap a
  maxDeleteMin (Branch _ _ l r) = maxMerge l r
  maxDeleteMin Nil              = Nil
  
  maxMerge :: Ord a => Heap a -> Heap a -> Heap a
  maxMerge Nil h = h
  maxMerge h Nil = h
  maxMerge h1@(Branch _ x1 l1 r1) h2@(Branch _ x2 l2 r2)
   | x1 >= x2 = branch x1 (maxMerge l1 h2) r1
   | otherwise = maxMerge h2 h1
  
  uncurry3 :: (a->b->c->d) -> (a,b,c) -> d
  uncurry3 f (x,y,z) = f x y z
  
  crazyMerge :: (Bounded a, Ord a) => Heap a -> Heap a -> Heap a
  crazyMerge Nil Nil = Nil
  crazyMerge Nil h = h
  crazyMerge h Nil = h
  crazyMerge h h1 = insert maxBound $ merge h h1
  
  mergeEqNil :: (Ord a) => Heap a -> Heap a -> Heap a
  mergeEqNil h h1 | h == h1   = Nil
                  | otherwise = merge h h1
  
  -- Only necessary for crazyMerge + bools to compile
  -- (it won't run, because it won't be able to PRINT surviving
  -- mutants).
  -- all other types should work fine
  instance Bounded a => Bounded [a] where
    minBound = []
    maxBound = repeat maxBound
  