diff --git a/Data/Heap.hs b/Data/Heap.hs
--- a/Data/Heap.hs
+++ b/Data/Heap.hs
@@ -1,8 +1,7 @@
-{-# LANGUAGE CPP, EmptyDataDecls, FlexibleInstances, MultiParamTypeClasses #-}
-
--- | A flexible implementation of min-, max- and custom-priority heaps based on
--- the leftist-heaps from Chris Okasaki's book \"Purely Functional Data
--- Structures\", Cambridge University Press, 1998, chapter 3.1.
+-- | A flexible implementation of min-, max-, min-priority, max-priority and
+-- custom-priority heaps based on the leftist-heaps from Chris Okasaki's book
+-- \"Purely Functional Data Structures\", Cambridge University Press, 1998,
+-- chapter 3.1.
 --
 -- There are different flavours of 'Heap's, each of them following a different
 -- strategy when ordering its elements:
@@ -12,30 +11,33 @@
 --
 --  * If you wish to manually annotate a value with a priority, e. g. an @IO ()@
 --    action with an 'Int' use 'MinPrioHeap' or 'MaxPrioHeap'. They manage
---    @(priority, value)@ tuples so that only the priority (and not the value)
+--    @(prio, val)@ tuples so that only the priority (and not the value)
 --    influences the order of elements.
 --
 --  * If you still need something different, define a custom order for the heap
---    elements by implementing a 'HeapPolicy' and let the maintainer know,
---    what's missing.
+--    elements by implementing an instance of 'HeapItem' and let the maintainer
+--    know what's missing.
 --
--- This module is best imported @qualified@ in order to prevent name clashes
--- with other modules.
+-- All sorts of heaps mentioned above ('MinHeap', 'MaxHeap', 'MinPrioHeap' and
+-- 'MaxPrioHeap') are built on the same underlying type: @'HeapT' prio val@. It is
+-- a simple minimum priority heap. The trick is, that you never insert @(prio,
+-- val)@ pairs directly: You only insert an \"external representation\", usually
+-- called @item@, and an appropriate 'HeapItem' instance is used to 'split' the
+-- @item@ to a @(prio, val)@ pair. For details refer to the documentation of
+-- 'HeapItem'.
 module Data.Heap
     ( -- * Types
       -- ** Various heap flavours
-#ifdef __DEBUG__
-      Heap(..), rank, policy
-#else
-      Heap
-#endif
+      HeapT, Heap
     , MinHeap, MaxHeap, MinPrioHeap, MaxPrioHeap
-      -- ** Ordering policies
-    , HeapPolicy(..), MinPolicy, MaxPolicy, FstMinPolicy, FstMaxPolicy
+      -- ** Ordering strategies
+    , HeapItem(..), MinPolicy, MaxPolicy, FstMinPolicy, FstMaxPolicy
       -- * Query
-    , null, isEmpty, size, head, tail, view, extractHead
+    , I.isEmpty, null, I.size
       -- * Construction
-    , empty, singleton, insert, union, unions
+    , I.empty, singleton, insert, I.union, I.unions
+      -- * Deconstruction
+    , view, viewHead, viewTail
       -- * Filter
     , filter, partition
       -- * Subranges
@@ -43,327 +45,124 @@
     , takeWhile, dropWhile, span, break
       -- * Conversion
       -- ** List
-    , fromList, toList, elems
+    , fromList, toList
       -- ** Ordered list
     , fromAscList, toAscList
     , fromDescList, toDescList
     ) where
 
-import Data.Foldable ( foldl' )
-import Data.List ( sortBy )
-import Data.Monoid ( Monoid(..) )
-import Data.Ord ( comparing )
-import Prelude hiding ( break, drop, dropWhile, filter, head, null, tail, span
-                      , splitAt, take, takeWhile )
-#ifdef __GLASGOW_HASKELL__
-import Text.Read
-#endif
-
--- | The basic 'Heap' type.
-data Heap p a
-    = Empty -- rank, size, elem, left, right
-    | Tree {-# UNPACK #-} !Int {-# UNPACK #-} !Int a !(Heap p a) !(Heap p a)
-
--- | A 'Heap' which will always extract the minimum first.
-type MinHeap a = Heap MinPolicy a
-
--- | A 'Heap' which will always extract the maximum first.
-type MaxHeap a = Heap MaxPolicy a
-
--- | A 'Heap' storing priority-value-associations. It only regards the priority
--- for determining the order of elements, the tuple with minimal 'fst' value
--- (i. e. priority) will always be the head of the 'Heap'.
-type MinPrioHeap priority value = Heap FstMinPolicy (priority, value)
-
--- | A 'Heap' storing priority-value-associations. It only regards the priority
--- for determining the order of elements, the tuple with maximal 'fst' value
--- (i. e. priority) will always be the head of the 'Heap'.
-type MaxPrioHeap priority value = Heap FstMaxPolicy (priority, value)
-
-instance (Show a) => Show (Heap p a) where
-    show = ("fromList " ++) . show . toList
-
-instance (HeapPolicy p a, Read a) => Read (Heap p a) where
-#ifdef __GLASGOW_HASKELL__
-    readPrec = parens $ prec 10 $ do
-        Ident "fromList" <- lexP
-        xs               <- readPrec
-        return (fromList xs)
-    readListPrec = readListPrecDefault
-#else
-    readsPrec p = readParen (p > 10) $ \r -> do
-        ("fromList", s) <- lex r
-        (xs, t)         <- reads s
-        return (fromList xs, t)
-#endif
-
-instance (HeapPolicy p a) => Eq (Heap p a) where
-    h1 == h2 = EQ == compare h1 h2
-
-instance (HeapPolicy p a) => Ord (Heap p a) where
-    compare h1 h2 = compareBy (heapCompare (policy h1)) (toAscList h1) (toAscList h2)
-        where
-        compareBy :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering
-        compareBy _   []     []     = EQ
-        compareBy _   []     _      = LT
-        compareBy _   _      []     = GT
-        compareBy cmp (x:xs) (y:ys) = mappend (cmp x y) (compareBy cmp xs ys)
-
-instance (HeapPolicy p a) => Monoid (Heap p a) where
-    mempty  = empty
-    mappend = union
-    mconcat = unions
-
--- | The 'HeapPolicy' class defines an order on the elements contained within
--- a 'Heap'.
-class HeapPolicy p a where
-    -- | Compare two elements, just like 'compare' of the 'Ord' class, so this
-    -- function has to define a mathematical ordering. When using a 'HeapPolicy'
-    -- for a 'Heap', the minimal value (defined by this order) will be the head
-    -- of the 'Heap'.
-    heapCompare :: p -- ^ /Must not be evaluated/.
-        -> a         -- ^ Compared to 3rd parameter.
-        -> a         -- ^ Compared to 2nd parameter.
-        -> Ordering  -- ^ Result of the comparison.
-
--- | Policy type for a 'MinHeap'.
-data MinPolicy
-
-instance (Ord a) => HeapPolicy MinPolicy a where
-    heapCompare = const compare
-
--- | Policy type for a 'MaxHeap'.
-data MaxPolicy
-
-instance (Ord a) => HeapPolicy MaxPolicy a where
-    heapCompare = const (flip compare)
-
--- | Policy type for a @(priority, value)@ 'MinPrioHeap'.
-data FstMinPolicy
-
-instance (Ord priority) => HeapPolicy FstMinPolicy (priority, value) where
-    heapCompare = const (comparing fst)
-
--- | Policy type for a @(priority, value)@ 'MaxPrioHeap'.
-data FstMaxPolicy
-
-instance (Ord priority) => HeapPolicy FstMaxPolicy (priority, value) where
-    heapCompare = const (flip (comparing fst))
-
--- | /O(1)/. Is the 'Heap' empty?
-null :: Heap p a -> Bool
-null Empty = True
-null _     = False
-
--- | /O(1)/. Is the 'Heap' empty?
-isEmpty :: Heap p a -> Bool
-isEmpty = null
-
--- | /O(1)/. Calculate the rank of a 'Heap'.
-rank :: Heap p a -> Int
-rank Empty            = 0
-rank (Tree r _ _ _ _) = r
-
--- | /O(1)/. The number of elements in the 'Heap'.
-size :: Heap p a -> Int
-size Empty            = 0
-size (Tree _ s _ _ _) = s
-
--- | This function is 'undefined' and just used as a type-helper to determine
--- the first parameter of 'heapCompare'.
-policy :: Heap p a -> p
-policy = undefined
+import Data.Heap.Item
+import Data.Heap.Internal ( HeapT )
+import qualified Data.Heap.Internal as I
+import Prelude hiding
+    ( break, drop, dropWhile, filter, null, span, splitAt, take, takeWhile )
 
--- | /O(1)/. Returns the first item of the 'Heap', according to its 'HeapPolicy'.
---
--- /Warning:/ This function issues an 'error' for empty 'Heap's, please consider
--- using the 'view' function instead, it's safe.
-head :: (HeapPolicy p a) => Heap p a -> a
-head = fst . extractHead
+-- | /O(1)/. Is the 'HeapT' empty?
+null :: HeapT prio val -> Bool
+null = I.isEmpty
 
--- | /O(log n)/. Returns the 'Heap' with the 'head' removed.
---
--- /Warning:/ This function issues an 'error' for empty 'Heap's, please consider
--- using the 'view' function instead, it's safe.
-tail :: (HeapPolicy p a) => Heap p a -> Heap p a
-tail = snd . extractHead
+-- | /O(1)/. Create a singleton 'HeapT'.
+singleton :: (HeapItem pol item) => item -> Heap pol item
+singleton = (uncurry I.singleton) . split
 
--- | /O(log n)/ for the tail, /O(1)/ for the head. Find the minimum (depending
--- on the 'HeapPolicy') and delete it from the 'Heap' (i. e. find head and tail
--- of a heap) if it is not empty. Otherwise, 'Nothing' is returned.
-view :: (HeapPolicy p a) => Heap p a -> Maybe (a, Heap p a)
-view Empty            = Nothing
-view (Tree _ _ x l r) = Just (x, union l r)
-{-# INLINE view #-}
+-- | /O(log n)/. Insert a single item into the 'HeapT'.
+insert :: (HeapItem pol item) => item -> Heap pol item -> Heap pol item
+insert = I.union . singleton
 
--- | /O(log n)/. Returns 'head' and 'tail' of a 'Heap'.
---
--- /Warning:/ This function issues an 'error' for empty 'Heap's, please consider
--- using the 'view' function instead, it's safe.
-extractHead :: (HeapPolicy p a) => Heap p a -> (a, Heap p a)
-extractHead heap = maybe (error (__FILE__ ++ ": empty heap in extractHead")) id (view heap)
+-- | /O(1)/ for the head, /O(log n)/ for the tail. Find the item with minimal
+-- associated priority and remove it from the 'Heap' (i. e. find head and tail
+-- of the heap) if it is not empty. Otherwise, 'Nothing' is returned.
+view :: (HeapItem pol item) => Heap pol item -> Maybe (item, Heap pol item)
+view = fmap (\(p, v, h) -> (merge (p, v), h)) . I.view
 
--- | /O(1)/. Constructs an empty 'Heap'.
-empty :: Heap p a
-empty = Empty
+-- | /O(1)/. Find the item with minimal associated priority on the 'Heap' (i. e.
+-- its head) if it is not empty. Otherwise, 'Nothing' is returned.
+viewHead :: (HeapItem pol item) => Heap pol item -> Maybe item
+viewHead = fmap fst . view
 
--- | /O(1)/. Create a singleton 'Heap'.
-singleton :: a -> Heap p a
-singleton x = Tree 1 1 x empty empty
+-- | /O(log n)/. Remove the item with minimal associated priority and from the
+-- 'Heap' (i. e. its tail) if it is not empty. Otherwise, 'Nothing' is returned.
+viewTail :: (HeapItem pol item) => Heap pol item -> Maybe (Heap pol item)
+viewTail = fmap snd . view
 
--- | /O(log n)/. Insert an element in the 'Heap'.
-insert :: (HeapPolicy p a) => a -> Heap p a -> Heap p a
-insert x h = union h (singleton x)
+-- | Remove all items from a 'HeapT' not fulfilling a predicate.
+filter :: (HeapItem pol item) => (item -> Bool) -> Heap pol item -> Heap pol item
+filter p = fst . (partition p)
 
--- | /O(1)/. Insert an element into the 'Heap' that is smaller than all elements
--- currently in the 'Heap' (according to the 'HeapPolicy'), i. e. an element
--- that will be the new 'head' of the 'Heap'.
---
--- /The precondition is not checked/.
-insertMin :: (HeapPolicy p a) => a -> Heap p a -> Heap p a
-insertMin h hs = Tree 1 (1 + size hs) h hs empty
+-- | Partition the 'Heap' into two. @'partition' p h = (h1, h2)@: All items in
+-- @h1@ fulfil the predicate @p@, those in @h2@ don't. @'union' h1 h2 = h@.
+partition :: (HeapItem pol item)
+    => (item -> Bool) -> Heap pol item -> (Heap pol item, Heap pol item)
+partition = I.partition . splitF
 
--- | Take the lowest @n@ elements in ascending order of the 'Heap' (according
--- to the 'HeapPolicy').
-take :: (HeapPolicy p a) => Int -> Heap p a -> [a]
-take n = fst . (splitAt n)
+-- | Take the first @n@ items from the 'Heap'.
+take :: (HeapItem pol item) => Int -> Heap pol item -> [item]
+take n = fst . splitAt n
 
--- | Remove the lowest (according to the 'HeapPolicy') @n@ elements
--- from the 'Heap'.
-drop :: (HeapPolicy p a) => Int -> Heap p a -> Heap p a
-drop n = snd . (splitAt n)
+-- | Remove first @n@ items from the 'Heap'.
+drop :: (HeapItem pol item) => Int -> Heap pol item -> Heap pol item
+drop n = snd . splitAt n
 
--- | @'splitAt' n h@ returns an ascending list of the lowest @n@ elements of @h@
--- (according to its 'HeapPolicy') and a 'Heap' like @h@, lacking those elements.
-splitAt :: (HeapPolicy p a) => Int -> Heap p a -> ([a], Heap p a)
-splitAt n heap
-    | n > 0     = case view heap of
-        Nothing      -> ([], empty)
-        Just (h, hs) -> let (xs, heap') = splitAt (n-1) hs in (h:xs, heap')
-    | otherwise = ([], heap)
+-- | @'splitAt' n h@: Return a list of the first @n@ items of @h@ and @h@, with
+-- those elements removed.
+splitAt :: (HeapItem pol item) => Int -> Heap pol item -> ([item], Heap pol item)
+splitAt n heap = let (xs, heap') = I.splitAt n heap in (fmap merge xs, heap')
 
--- | @'takeWhile' p h@ lists the longest prefix of elements in ascending order
--- (according to its 'HeapPolicy') of @h@ that satisfy @p@.
-takeWhile :: (HeapPolicy p a) => (a -> Bool) -> Heap p a -> [a]
+-- | @'takeWhile' p h@: List the longest prefix of items in @h@ that satisfy @p@.
+takeWhile :: (HeapItem pol item) => (item -> Bool) -> Heap pol item -> [item]
 takeWhile p = fst . (span p)
 
--- | @'dropWhile' p h@ removes the longest prefix of elements from @h@ that
--- satisfy @p@.
-dropWhile :: (HeapPolicy p a) => (a -> Bool) -> Heap p a -> Heap p a
+-- | @'dropWhile' p h@: Remove the longest prefix of items in @h@ that satisfy
+-- @p@.
+dropWhile :: (HeapItem pol item)
+    => (item -> Bool) -> Heap pol item -> Heap pol item
 dropWhile p = snd . (span p)
 
--- | @'span' p h@ returns the longest prefix of elements in ascending order
--- (according to its 'HeapPolicy') of @h@ that satisfy @p@ and a 'Heap' like
+-- | @'span' p h@: Return the longest prefix of items in @h@ that satisfy @p@ and
 -- @h@, with those elements removed.
-span :: (HeapPolicy p a) => (a -> Bool) -> Heap p a -> ([a], Heap p a)
-span p heap = case view heap of
-    Nothing      -> ([], empty)
-    Just (h, hs) -> if p h
-        then let (xs, heap') = span p hs in (h:xs, heap')
-        else ([], heap)
+span :: (HeapItem pol item)
+    => (item -> Bool) -> Heap pol item -> ([item], Heap pol item)
+span p heap = let (xs, heap') = I.span (splitF p) heap in (fmap merge xs, heap')
 
--- | @'break' p h@ returns the longest prefix of elements in ascending order
--- (according to its 'HeapPolicy') of @h@ that do /not/ satisfy @p@ and a 'Heap'
--- like @h@, with those elements removed.
-break :: (HeapPolicy p a) => (a -> Bool) -> Heap p a -> ([a], Heap p a)
+-- | @'break' p h@: The longest prefix of items in @h@ that do /not/ satisfy @p@
+-- and @h@, with those elements removed.
+break :: (HeapItem pol item)
+    => (item -> Bool) -> Heap pol item -> ([item], Heap pol item)
 break p = span (not . p)
 
--- | /O(log max(n, m))/. The union of two 'Heap's.
-union :: (HeapPolicy p a) => Heap p a -> Heap p a -> Heap p a
-union h Empty = h
-union Empty h = h
-union heap1@(Tree _ _ x l1 r1) heap2@(Tree _ _ y l2 r2) =
-    if LT == heapCompare (policy heap1) x y
-        then makeT x l1 (union r1 heap2) -- keep smallest number on top and merge the other
-        else makeT y l2 (union r2 heap1) -- heap into the right branch, it's shorter
-
--- | Combines a value @x@ and two 'Heap's to one 'Heap'. Therefore, @x@ has to
--- be less or equal the minima (depending on the 'HeapPolicy') of both 'Heap'
--- parameters.
---
--- /The precondition is not checked/.
-makeT :: a -> Heap p a -> Heap p a -> Heap p a
-makeT x a b = let
-    ra = rank a
-    rb = rank b
-    s  = size a + size b + 1
-    in if ra > rb
-        then Tree (rb + 1) s x a b
-        else Tree (ra + 1) s x b a
-{-# INLINE makeT #-}
-
--- | Builds the union over all given 'Heap's.
-unions :: (HeapPolicy p a) => [Heap p a] -> Heap p a
-unions heaps = case tournamentFold' heaps of
-    []  -> empty
-    [h] -> h
-    hs  -> unions hs
-    where
-    tournamentFold' :: (Monoid m) => [m] -> [m]
-    tournamentFold' (x1:x2:xs) = (: tournamentFold' xs) $! mappend x1 x2
-    tournamentFold' xs         = xs
-    {-# INLINE tournamentFold' #-}
-
--- | Removes all elements from a given 'Heap' that do not fulfil the predicate.
-filter :: (HeapPolicy p a) => (a -> Bool) -> Heap p a -> Heap p a
-filter p = fst . (partition p)
-
--- | Partition the 'Heap' into two. @'partition' p h = (h1, h2)@: All elements
--- in @h1@ fulfil the predicate @p@, those in @h2@ don't. @'union' h1 h2 = h@.
-partition :: (HeapPolicy p a) => (a -> Bool) -> Heap p a -> (Heap p a, Heap p a)
-partition _ Empty = (empty, empty)
-partition p (Tree _ _ x l r)
-    | p x       = (makeT x l1 r1, union l2 r2)
-    | otherwise = (union l1 r1, makeT x l2 r2)
-    where
-    (l1, l2) = partition p l
-    (r1, r2) = partition p r
-
--- | Builds a 'Heap' from the given elements. Assuming you have a sorted list,
--- you may want to use 'fromDescList' or 'fromAscList', they are both faster
--- than this function.
-fromList :: (HeapPolicy p a) => [a] -> Heap p a
-fromList xs = let
-    heap = fromDescList $ sortBy (flip (heapCompare (policy heap))) xs
-    in heap
-
--- | /O(n)/. Lists elements of the 'Heap' in no specific order.
-toList :: Heap p a -> [a]
-toList Empty            = []
-toList (Tree _ _ x l r) = x : if size r < size l
-    then toList r ++ toList l
-    else toList l ++ toList r
+-- | /O(n log n)/. Build a 'Heap' from the given items. Assuming you have a
+-- sorted list, you probably want to use 'fromDescList' or 'fromAscList', they
+-- are faster than this function.
+fromList :: (HeapItem pol item) => [item] -> Heap pol item
+fromList = I.fromList . fmap split
 
--- | /O(n)/. Lists elements of the 'Heap' in no specific order.
-elems :: Heap p a -> [a]
-elems = toList
+-- | /O(n log n)/. List all items of the 'Heap' in no specific order.
+toList :: (HeapItem pol item) => Heap pol item -> [item]
+toList = fmap merge . I.toList
 
--- | /O(n)/. Creates a 'Heap' from an ascending list. Note that the list has to
--- be ascending corresponding to the 'HeapPolicy', not to its 'Ord' instance
--- declaration (if there is one). This function is faster than 'fromList' but
--- not as fast as 'fromDescList'.
+-- | /O(n)/. Create a 'Heap' from a list providing its items in ascending order
+-- of priority (i. e. in the same order they will be removed from the 'Heap').
+-- This function is faster than 'fromList' but not as fast as 'fromDescList'.
 --
 -- /The precondition is not checked/.
-fromAscList :: (HeapPolicy p a) => [a] -> Heap p a
+fromAscList :: (HeapItem pol item) => [item] -> Heap pol item
 fromAscList = fromDescList . reverse
 
--- | /O(n)/. Lists elements of the 'Heap' in ascending order (corresponding to
--- the 'HeapPolicy').
-toAscList :: (HeapPolicy p a) => Heap p a -> [a]
-toAscList = takeWhile (const True)
+-- | /O(n log n)/. List the items of the 'Heap' in ascending order of priority.
+toAscList :: (HeapItem pol item) => Heap pol item -> [item]
+toAscList = fmap merge . I.toAscList
 
--- | /O(n)/. Create a 'Heap' from a descending list. Note that the list has to
--- be descending corresponding to the 'HeapPolicy', not to its 'Ord' instance
--- declaration (if there is one). This function is provided, because it is much
--- faster than 'fromList' and 'fromAscList'.
+-- | /O(n)/. Create a 'Heap' from a list providing its items in descending order
+-- of priority (i. e. they will be removed inversely from the 'Heap'). Prefer
+-- this function over 'fromList' and 'fromAscList', it's faster.
 --
 -- /The precondition is not checked/.
-fromDescList :: (HeapPolicy p a) => [a] -> Heap p a
-fromDescList = foldl' (flip insertMin) empty
+fromDescList :: (HeapItem pol item) => [item] -> Heap pol item
+fromDescList = I.fromDescList . fmap split
 
--- | /O(n)/. Lists the elements on the 'Heap' in descending order (corresponding
--- to the 'HeapPolicy'). Note that this function is not especially efficient (it
--- is implemented as @'reverse' . 'toAscList'@), it is just provided as a
--- counterpart of the very efficient 'fromDescList' function.
-toDescList :: (HeapPolicy p a) => Heap p a -> [a]
+-- | /O(n log n)/. List the items of the 'Heap' in descending order of priority.
+-- Note that this function is not especially efficient (it is implemented in
+-- terms of 'reverse' and 'toAscList'), it is provided as a counterpart of the
+-- efficient 'fromDescList' function.
+toDescList :: (HeapItem pol item) => Heap pol item -> [item]
 toDescList = reverse . toAscList
diff --git a/Data/Heap/Internal.hs b/Data/Heap/Internal.hs
new file mode 100644
--- /dev/null
+++ b/Data/Heap/Internal.hs
@@ -0,0 +1,255 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-- | This module provides a simple leftist-heap implementation based on Chris
+-- Okasaki's book \"Purely Functional Data Structures\", Cambridge University
+-- Press, 1998, chapter 3.1.
+--
+-- A @'HeapT' prio val@ associates a priority @prio@ to a value @val@. A
+-- priority-value pair with minimum priority will always be the head of the
+-- 'HeapT', so this module implements minimum priority heaps. Note that the value
+-- associated to the priority has no influence on the ordering of elements, only
+-- the priority does.
+module Data.Heap.Internal
+    ( -- * A basic heap type
+      HeapT(..)
+      -- * Query
+    , isEmpty, rank, size
+      -- * Construction
+    , empty, singleton, union, unions
+      -- * Deconstruction
+    , view
+      -- * Filter
+    , partition
+      -- * Subranges
+    , splitAt, span
+      -- * Conversion
+    , fromList, toList
+    , fromDescList, toAscList
+    ) where
+
+import Control.Exception
+import Data.Foldable ( Foldable(..), foldl' )
+import Data.List ( groupBy, sortBy )
+import Data.Monoid
+import Data.Ord
+import Data.Typeable
+import Prelude hiding ( foldl, span, splitAt )
+import Text.Read
+
+-- | The basic heap type. It stores priority-value pairs @(prio, val)@ and
+-- always keeps the pair with minimal priority on top. The value associated to
+-- the priority does not have any influence on the ordering of elements.
+data HeapT prio val
+    = Empty  -- ^ An empty 'HeapT'.
+    | Tree { _rank     :: {-# UNPACK #-} !Int -- ^ Rank of the leftist heap.
+           , _size     :: {-# UNPACK #-} !Int -- ^ Number of elements in the heap.
+           , _priority :: !prio               -- ^ Priority of the entry.
+           , _value    :: val                 -- ^ Value of the entry.
+           , _left     :: !(HeapT prio val)   -- ^ Left subtree.
+           , _right    :: !(HeapT prio val)   -- ^ Right subtree.
+           } -- ^ A tree node of a non-empty 'HeapT'.
+    deriving (Typeable)
+
+instance (Read prio, Read val, Ord prio) => Read (HeapT prio val) where
+    readPrec     = parens $ prec 10 $ do
+        Ident "fromList" <- lexP
+        fmap fromList readPrec
+    readListPrec = readListPrecDefault
+
+instance (Show prio, Show val) => Show (HeapT prio val) where
+    showsPrec d heap = showParen (d > 10)
+        $ showString "fromList " . (showsPrec 11 (toList heap))
+
+instance (Ord prio, Ord val) => Eq (HeapT prio val) where
+    heap1 == heap2 = size heap1 == size heap2 && EQ == compare heap1 heap2
+
+instance (Ord prio, Ord val) => Ord (HeapT prio val) where
+    compare = comparing toPairAscList
+
+instance (Ord prio) => Monoid (HeapT prio val) where
+    mempty  = empty
+    mappend = union
+    mconcat = unions
+
+instance Functor (HeapT prio) where
+    fmap _ Empty = Empty
+    fmap f heap  = heap { _value = f (_value heap)
+                        , _left  = fmap f (_left heap)
+                        , _right = fmap f (_right heap)
+                        }
+
+instance (Ord prio) => Foldable (HeapT prio) where
+    foldMap f = foldMap f . fmap snd . toAscList
+    foldr f z = foldl (flip f) z . fmap snd . reverse . toAscList
+    foldl f z = foldl f z . fmap snd . toAscList
+
+-- | /O(1)/. Is the 'HeapT' empty?
+isEmpty :: HeapT prio val -> Bool
+isEmpty Empty = True
+isEmpty _     = False
+
+-- | /O(1)/. Find the rank of a 'HeapT' (the length of its right spine).
+rank :: HeapT prio val -> Int
+rank Empty = 0
+rank heap  = _rank heap
+
+-- | /O(1)/. The total number of elements in the 'HeapT'.
+size :: HeapT prio val -> Int
+size Empty = 0
+size heap  = _size heap
+
+-- | /O(1)/. Construct an empty 'HeapT'.
+empty :: HeapT prio val
+empty = Empty
+
+-- | /O(1)/. Create a singleton 'HeapT'.
+singleton :: prio -> val -> HeapT prio val
+singleton p v = Tree { _rank     = 1
+                     , _size     = 1
+                     , _priority = p
+                     , _value    = v
+                     , _left     = empty
+                     , _right    = empty
+                     }
+{-# INLINE singleton #-}
+
+-- | /O(1)/. Insert an priority-value pair into the 'HeapT', whose /priority is
+-- less or equal/ to all other priorities on the 'HeapT', i. e. a pair that is a
+-- valid head of the 'HeapT'.
+--
+-- /The precondition is not checked/.
+uncheckedCons :: (Ord prio) => prio -> val -> HeapT prio val -> HeapT prio val
+uncheckedCons p v heap = assert (maybe True (\(p', _, _) -> p <= p') (view heap))
+    Tree { _rank     = 1
+         , _size     = 1 + size heap
+         , _priority = p
+         , _value    = v
+         , _left     = heap
+         , _right    = empty
+         }
+{-# INLINE uncheckedCons #-}
+
+-- | /O(log max(n, m))/. Form the union of two 'HeapT's.
+union :: (Ord prio) => HeapT prio val -> HeapT prio val -> HeapT prio val
+union heap  Empty = heap
+union Empty heap  = heap
+union heap1 heap2 = let
+    p1 = _priority heap1
+    p2 = _priority heap2
+    in if p1 < p2
+        then makeT p1 (_value heap1) (_left heap1) (union (_right heap1) heap2)
+        else makeT p2 (_value heap2) (_left heap2) (union (_right heap2) heap1)
+
+-- | Build a 'HeapT' from a priority, a value and two more 'HeapT's. Therefore,
+-- the /priority has to be less or equal/ than all priorities in both 'HeapT'
+-- parameters.
+--
+-- /The precondition is not checked/.
+makeT :: (Ord prio) => prio -> val -> HeapT prio val -> HeapT prio val -> HeapT prio val
+makeT p v a b = let
+    ra = rank a
+    rb = rank b
+    s  = size a + size b + 1
+    in assert (checkPrio a && checkPrio b) $ if ra > rb
+        then Tree (rb + 1) s p v a b
+        else Tree (ra + 1) s p v b a
+    where
+    checkPrio = maybe True (\(p', _, _) -> p <= p') . view
+{-# INLINE makeT #-}
+
+-- | Build the union of all given 'HeapT's.
+unions :: (Ord prio) => [HeapT prio val] -> HeapT prio val
+unions heaps = case tournamentFold' heaps of
+    []  -> empty
+    [h] -> h
+    hs  -> unions hs
+    where
+    tournamentFold' :: (Monoid m) => [m] -> [m]
+    tournamentFold' (x1:x2:xs) = (: tournamentFold' xs) $! mappend x1 x2
+    tournamentFold' xs         = xs
+
+-- | /O(log n)/ for the tail, /O(1)/ for the head. Find the priority-value pair
+-- with minimal priority and delete it from the 'HeapT' (i. e. find head and tail
+-- of the heap) if it is not empty. Otherwise, 'Nothing' is returned.
+view :: (Ord prio) => HeapT prio val -> Maybe (prio, val, HeapT prio val)
+view Empty = Nothing
+view heap  = Just (_priority heap, _value heap, union (_left heap) (_right heap))
+{-# INLINE view #-}
+
+-- | Partition the 'HeapT' into two. @'partition' p h = (h1, h2)@: All
+-- priority-value pairs in @h1@ fulfil the predicate @p@, those in @h2@ don't.
+-- @'union' h1 h2 = h@.
+partition :: (Ord prio) => ((prio, val) -> Bool) -> HeapT prio val
+    -> (HeapT prio val, HeapT prio val)
+partition _ Empty  = (empty, empty)
+partition f heap
+    | f (p, v)  = (makeT p v l1 r1, union l2 r2)
+    | otherwise = (union l1 r1, makeT p v l2 r2)
+    where
+    (p, v)   = (_priority heap, _value heap)
+    (l1, l2) = partition f (_left heap)
+    (r1, r2) = partition f (_right heap)
+{-# INLINE partition #-}
+
+-- | @'splitAt' n h@: A list of the lowest @n@ priority-value pairs of @h@, in
+--  ascending order of priority, and @h@, with those elements removed.
+splitAt :: (Ord prio) => Int -> HeapT prio val -> ([(prio, val)], HeapT prio val)
+splitAt n heap
+    | n > 0     = case view heap of
+        Nothing         -> ([], empty)
+        Just (p, v, hs) -> let (xs, heap') = splitAt (n-1) hs in ((p, v):xs, heap')
+    | otherwise = ([], heap)
+{-# INLINE splitAt #-}
+
+-- | @'span' p h@: The longest prefix of priority-value pairs of @h@, in
+-- ascending order of priority, that satisfy @p@ and @h@, with those elements
+-- removed.
+span :: (Ord prio) => ((prio, val) -> Bool) -> HeapT prio val
+     -> ([(prio, val)], HeapT prio val)
+span f heap = case view heap of
+    Nothing         -> ([], empty)
+    Just (p, v, hs) -> let pv = (p, v)
+        in if f pv
+            then let (xs, heap') = span f hs in (pv:xs, heap')
+            else ([], heap)
+{-# INLINE span #-}
+
+-- | /O(n log n)/. Build a 'HeapT' from the given priority-value pairs.
+fromList :: (Ord prio) => [(prio, val)] -> HeapT prio val
+fromList = fromDescList . sortBy (flip (comparing fst))
+{-# INLINE fromList #-}
+
+-- | /O(n log n)/. List all priority-value pairs of the 'HeapT' in no specific
+-- order.
+toList :: HeapT prio val -> [(prio, val)]
+toList Empty = []
+toList heap  = let
+    left  = _left heap
+    right = _right heap
+    in
+    (_priority heap, _value heap) : if (size right) < (size left)
+        then toList right ++ toList left
+        else toList left  ++ toList right
+{-# INLINE toList #-}
+
+-- | /O(n)/. Create a 'HeapT' from a list providing its priority-value pairs in
+-- descending order of priority.
+--
+-- /The precondition is not checked/.
+fromDescList :: (Ord prio) => [(prio, val)] -> HeapT prio val
+fromDescList = foldl' (\h (p, v) -> uncheckedCons p v h) empty
+{-# INLINE fromDescList #-}
+
+-- | /O(n log n)/. List the priority-value pairs of the 'HeapT' in ascending
+-- order of priority.
+toAscList :: (Ord prio) => HeapT prio val -> [(prio, val)]
+toAscList = fst . span (const True)
+{-# INLINE toAscList #-}
+
+-- | List the priority-value pairs of the 'HeapT' just like 'toAscList' does,
+-- but don't ignore the value @val@ when sorting.
+toPairAscList :: (Ord prio, Ord val) => HeapT prio val -> [(prio, val)]
+toPairAscList = concat
+    . fmap (sortBy (comparing snd))
+    . groupBy (\x y -> fst x == fst y)
+    . toAscList
diff --git a/Data/Heap/Item.hs b/Data/Heap/Item.hs
new file mode 100644
--- /dev/null
+++ b/Data/Heap/Item.hs
@@ -0,0 +1,187 @@
+{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances
+  , MultiParamTypeClasses, TypeFamilies
+  #-}
+
+-- | This module provides the 'HeapItem' type family along with necessary
+-- instance declarations used to translate between inserted items and the
+-- priority-value pairs needed by the minimum priority heap of the module
+-- "Data.Heap.Internal".
+module Data.Heap.Item
+    ( -- * Type aliases
+      Heap, MinHeap, MaxHeap, MinPrioHeap, MaxPrioHeap
+      -- * The HeapItem type family
+    , HeapItem(..)
+    , MinPolicy, MaxPolicy, FstMinPolicy, FstMaxPolicy
+      -- * Auxiliary functions
+    , splitF
+    ) where
+
+import Data.Heap.Internal
+import Text.Read
+
+-- | This type alias is an abbreviation for a 'HeapT' which uses the 'HeapItem'
+-- instance of @pol item@ to organise its elements.
+type Heap pol item = HeapT (Prio pol item) (Val pol item)
+
+-- | A 'Heap' which will always extract the minimum first.
+type MinHeap a = Heap MinPolicy a
+
+-- | A 'Heap' which will always extract the maximum first.
+type MaxHeap a = Heap MaxPolicy a
+
+-- | A 'Heap' storing priority-value pairs @(prio, val)@. The order of elements
+-- is solely determined by the priority @prio@, the value @val@ has no influence.
+-- The priority-value pair with minmal priority will always be extracted first.
+type MinPrioHeap prio val = Heap FstMinPolicy (prio, val)
+
+-- | A 'Heap' storing priority-value pairs @(prio, val)@. The order of elements
+-- is solely determined by the priority @prio@, the value @val@ has no influence.
+-- The priority-value pair with maximum priority will always be extracted first.
+type MaxPrioHeap prio val = Heap FstMaxPolicy (prio, val)
+
+-- | @'HeapItem' pol item@ is a type class for items that can be stored in a
+-- 'HeapT'. A raw @'HeapT' prio val@ only provides a minimum priority heap (i. e.
+-- @val@ doesn't influence the ordering of elements and the pair with minimal
+-- @prio@ will be extracted first, see 'HeapT' documentation). The job of this
+-- class is to translate between arbitrary @item@s and priority-value pairs
+-- @('Prio' pol item, 'Val' pol item)@, depending on the policy @pol@ to be used.
+-- This way, we are able to use 'HeapT' not only as 'MinPrioHeap', but also as
+-- 'MinHeap', 'MaxHeap', 'MaxPrioHeap' or a custom implementation. In short: The
+-- job of this class is to deconstruct arbitrary @item@s into a @(prio, val)@
+-- pairs that can be handled by a minimum priority 'HeapT'.
+--
+-- Example: Consider you want to use @'HeapT' prio val@ as a @'MaxHeap' a@. You
+-- would have to invert the order of @a@ (e. g. by introducing @newtype InvOrd a
+-- = InvOrd a@ along with an apropriate 'Ord' instance for it) and then use a
+-- @type 'MaxHeap' a = 'HeapT' (InvOrd a) ()@. You'd also have to translate
+-- every @x@ to @(InvOrd x, ())@ before insertion and back after removal in
+-- order to retrieve your original type @a@.
+--
+-- This functionality is provided by the 'HeapItem' class. In the above example,
+-- you'd use a 'MaxHeap'. The according instance declaration is of course
+-- already provided and looks like this (simplified):
+--
+-- @data 'MaxPolicy'
+--
+-- instance ('Ord' a) => 'HeapItem' 'MaxPolicy' a where
+--     newtype 'Prio' 'MaxPolicy' a = MaxP a deriving ('Eq')
+--     type    'Val'  'MaxPolicy' a = ()
+--     'split' x           = (MaxP x, ())
+--     'merge' (MaxP x, _) = x
+--
+-- instance ('Ord' a) => 'Ord' ('Prio' 'MaxPolicy' a) where
+--     'compare' (MaxP x) (MaxP y) = 'compare' y x
+-- @
+--
+-- 'MaxPolicy' is a phantom type describing which 'HeapItem' instance is actually
+-- meant (e. g. we have to distinguish between 'MinHeap' and 'MaxHeap', which is
+-- done via 'MinPolicy' and 'MaxPolicy', respectively) and @MaxP@ inverts the
+-- ordering of @a@, so that the maximum will be on top of the 'HeapT'.
+--
+-- The conversion functions 'split' and 'merge' have to make sure that
+--
+-- (1) @forall p v. 'split' ('merge' (p, v)) == (p, v)@ ('merge' and 'split'
+--     don't remove, add or alter anything)
+--
+-- (2) @forall p v f. 'fst' ('split' ('merge' (p, f v)) == 'fst' ('split'
+--     ('merge' (p, v)))@ (modifying the associated value @v@ doesn't alter the
+--      priority @p@)
+class (Ord (Prio pol item)) => HeapItem pol item where
+    -- | The part of @item@ that determines the order of elements on a 'HeapT'.
+    data Prio pol item :: *
+    -- | Everything not part of @'Prio' pol item@
+    type Val  pol item :: *
+
+    -- | Translate an @item@ into a priority-value pair.
+    split :: item -> (Prio pol item, Val pol item)
+    -- | Restore the @item@ from a priority-value pair.
+    merge :: (Prio pol item, Val pol item) -> item
+{-# RULES "split/merge" forall x. split (merge x) = x #-}
+
+-- | Policy type for a 'MinHeap'.
+data MinPolicy
+
+instance (Ord a) => HeapItem MinPolicy a where
+    newtype Prio MinPolicy a = MinP { unMinP :: a } deriving (Eq, Ord)
+    type    Val  MinPolicy a = ()
+
+    split x           = (MinP x, ())
+    merge (MinP x, _) = x
+
+instance (Read a) => Read (Prio MinPolicy a) where
+    readPrec     = fmap MinP readPrec
+    readListPrec = fmap (fmap MinP) readListPrec
+
+instance (Show a) => Show (Prio MinPolicy a) where
+    show        = show . unMinP
+    showsPrec d = showsPrec d . unMinP
+    showList    = showList . (fmap unMinP)
+
+-- | Policy type for a 'MaxHeap'.
+data MaxPolicy
+
+instance (Ord a) => HeapItem MaxPolicy a where
+    newtype Prio MaxPolicy a = MaxP { unMaxP :: a } deriving (Eq)
+    type    Val  MaxPolicy a = ()
+
+    split x           = (MaxP x, ())
+    merge (MaxP x, _) = x
+
+instance (Ord a) => Ord (Prio MaxPolicy a) where
+    compare (MaxP x) (MaxP y) = compare y x
+
+instance (Read a) => Read (Prio MaxPolicy a) where
+    readPrec     = fmap MaxP readPrec
+    readListPrec = fmap (fmap MaxP) readListPrec
+
+instance (Show a) => Show (Prio MaxPolicy a) where
+    show        = show . unMaxP
+    showsPrec d = showsPrec d . unMaxP
+    showList    = showList . (fmap unMaxP)
+
+-- | Policy type for a @(prio, val)@ 'MinPrioHeap'.
+data FstMinPolicy
+
+instance (Ord prio) => HeapItem FstMinPolicy (prio, val) where
+    newtype Prio FstMinPolicy (prio, val) = FMinP { unFMinP :: prio } deriving (Eq, Ord)
+    type    Val  FstMinPolicy (prio, val) = val
+
+    split (p,       v) = (FMinP p, v)
+    merge (FMinP p, v) = (p,       v)
+
+instance (Read prio) => Read (Prio FstMinPolicy (prio, val)) where
+    readPrec     = fmap FMinP readPrec
+    readListPrec = fmap (fmap FMinP) readListPrec
+
+instance (Show prio) => Show (Prio FstMinPolicy (prio, val)) where
+    show        = show . unFMinP
+    showsPrec d = showsPrec d . unFMinP
+    showList    = showList . (fmap unFMinP)
+
+-- | Policy type for a @(prio, val)@ 'MaxPrioHeap'.
+data FstMaxPolicy
+
+instance (Ord prio) => HeapItem FstMaxPolicy (prio, val) where
+    newtype Prio FstMaxPolicy (prio, val) = FMaxP { unFMaxP :: prio } deriving (Eq)
+    type    Val  FstMaxPolicy (prio, val) = val
+
+    split (p,       v) = (FMaxP p, v)
+    merge (FMaxP p, v) = (p,       v)
+
+instance (Ord prio) => Ord (Prio FstMaxPolicy (prio, val)) where
+    compare (FMaxP x) (FMaxP y) = compare y x
+
+instance (Read prio) => Read (Prio FstMaxPolicy (prio, val)) where
+    readPrec     = fmap FMaxP readPrec
+    readListPrec = fmap (fmap FMaxP) readListPrec
+
+instance (Show prio) => Show (Prio FstMaxPolicy (prio, val)) where
+    show        = show . unFMaxP
+    showsPrec d = showsPrec d . unFMaxP
+    showList    = showList . (fmap unFMaxP)
+
+-- | 'split' a function on @item@s to one on priority-value pairs.
+splitF :: (HeapItem pol item) => (item -> a) -> (Prio pol item, Val pol item) -> a
+splitF f pv = f (merge pv)
+{-# INLINE splitF #-}
+{-# RULES "splitF/split" forall f x. splitF f (split x) = f x #-}
diff --git a/Setup.lhs b/Setup.lhs
--- a/Setup.lhs
+++ b/Setup.lhs
@@ -1,6 +1,6 @@
 #! /usr/bin/env runhaskell
 
-> module Main where
+> module Main ( main ) where
 >
 > import Distribution.Simple
 >
diff --git a/Test.hs b/Test.hs
new file mode 100644
--- /dev/null
+++ b/Test.hs
@@ -0,0 +1,19 @@
+module Main where
+
+import Control.Exception ( assert )
+import qualified Test.Heap as Heap
+import qualified Test.Heap.Internal as Internal
+import qualified Test.Heap.Item as Item
+import Test.QuickCheck
+
+main :: IO ()
+main = do
+    putStrLn "Ensuring assertions are not ignored:"
+    result <- quickCheckWithResult (Args Nothing 1 1 1) $ expectFailure (assert False True)
+    putStrLn ""
+    case result of
+        (Success _) -> do
+            putStrLn "Tests for Data.Heap.Internal:" >> Internal.runTests >> putStrLn ""
+            putStrLn "Tests for Data.Heap.Item:"     >> Item.runTests     >> putStrLn ""
+            putStrLn "Tests for Data.Heap:"          >> Heap.runTests
+        _           -> return ()
diff --git a/Test.lhs b/Test.lhs
deleted file mode 100644
--- a/Test.lhs
+++ /dev/null
@@ -1,11 +0,0 @@
-#! /usr/bin/runghc -D__DEBUG__
-
->
-> module Main where
->
-> import Test.Heap
->
-> main :: IO ()
-> main = testHeap
->
-
diff --git a/Test/Heap.hs b/Test/Heap.hs
--- a/Test/Heap.hs
+++ b/Test/Heap.hs
@@ -1,138 +1,90 @@
+{-# LANGUAGE FlexibleContexts #-}
+
 module Test.Heap
-    ( testHeap
+    ( runTests
     ) where
 
-import Data.Heap as Heap
-import Data.List as List
-import Test.QuickCheck
-
-testHeap :: IO ()
-testHeap = do
-    qc "Leftist property of MinHeap Int" (leftistHeapProperty :: MinHeap Int -> Bool)
-    qc "Leftist property of MaxHeap Int" (leftistHeapProperty :: MaxHeap Int -> Bool)
-    qc "Size property" sizeProperty
-    qc "Order property" orderProperty
-    qc "head/tail property" headTailProperty
-    qc "take/drop/splitAt" (takeDropSplitAtProperty :: Int -> MinHeap Int -> Bool)
-    qc "takeWhile/span/break" takeWhileSpanBreakProperty
-    qc "read . show === id" (readShowProperty :: MinHeap Int -> Bool)
-    qc "{from,to}{,Asc,Desc}List" (listProperty :: [Int] -> Bool)
-    qc "toList === elems" (toListProperty :: MaxHeap Int -> Bool)
-    qc "partition and filter" (partitionFilterProperty testProperty :: MinHeap Int -> Bool)
-    qc "ordering property" (orderingProperty :: MinHeap Int -> MinHeap Int -> Bool)
-    where
-    testProperty x = x `mod` 2 == 0
+import Data.Char
+import Data.Heap
+import Prelude hiding ( break, null, span, splitAt )
+import Test.Heap.Common
+import Test.Heap.Internal hiding ( runTests )
+import Test.Heap.Item ()
 
-qc :: (Testable prop) => String -> prop -> IO ()
-qc msg prop = quickCheck
-    $ whenFail (putStrLn msg)
-    $ label msg prop
+runTests :: IO ()
+runTests = do
+    qc "list conversions for MinHeap" (listProperty :: MinHeap Int -> Bool)
+    qc "list conversions for MaxHeap" (listProperty :: MaxHeap Int -> Bool)
+    qc "list conversions for MinPrioHeap" (listProperty :: MinPrioHeap Int Char -> Bool)
+    qc "list conversions for MaxPrioHeap" (listProperty :: MaxPrioHeap Int Char -> Bool)
 
-instance (Arbitrary a, HeapPolicy p a) => Arbitrary (Heap p a) where
-    arbitrary = do
-        len  <- choose (0, 100)
-        list <- vector len
-        return (Heap.fromList list)
+    qc "view for MinHeap" (headTailViewProperty :: MinHeap Int -> Bool)
+    qc "view for MaxHeap" (headTailViewProperty :: MaxHeap Int -> Bool)
+    qc "view for MinPrioHeap" (headTailViewProperty :: MinPrioHeap Int Char -> Bool)
+    qc "view for MaxPrioHeap" (headTailViewProperty :: MaxPrioHeap Int Char -> Bool)
 
-leftistHeapProperty :: (HeapPolicy p a) => Heap p a -> Bool
-leftistHeapProperty Empty                     = True
-leftistHeapProperty h@(Tree r s x left right) = let
-    leftRank  = rank left
-    rightRank = rank right
-    in
-    (maybe True (\(lHead, _) -> LT /= heapCompare (policy h) lHead x) (view left))
-        && (maybe True (\(rHead, _) -> LT /= heapCompare (policy h) rHead x) (view right))
-        && r == 1 + rightRank              -- rank == length of right spine
-        && leftRank >= rightRank           -- leftist property
-        && s == 1 + size left + size right -- check size
-        && leftistHeapProperty left
-        && leftistHeapProperty right
+    qc "partition for MinHeap" (partitionProperty even :: MinHeap Int -> Bool)
+    qc "partition for MaxHeap" (partitionProperty even :: MaxHeap Int -> Bool)
+    qc "partition for MinPrioHeap" (partitionProperty testProp :: MinPrioHeap Int Char -> Bool)
+    qc "partition for MaxPrioHeap" (partitionProperty testProp :: MaxPrioHeap Int Char -> Bool)
 
-sizeProperty :: Int -> Bool
-sizeProperty n = let
-    n' = abs n `mod` 100
-    h  = Heap.fromList [1..n'] :: MaxHeap Int
-    in
-    Heap.size h == n' && (if n' == 0 then Heap.isEmpty h && Heap.null h else True)
+    qc "splitAt for MinHeap" (splitAtProperty :: Int -> MinHeap Int -> Bool)
+    qc "splitAt for MaxHeap" (splitAtProperty :: Int -> MaxHeap Int -> Bool)
+    qc "splitAt for MinPrioHeap" (splitAtProperty :: Int -> MinPrioHeap Int Char -> Bool)
+    qc "splitAt for MaxPrioHeap" (splitAtProperty :: Int -> MaxPrioHeap Int Char -> Bool)
 
-orderProperty :: Int -> [Int] -> Bool
-orderProperty n list = let
-    n'          = signum n * (n `mod` 100)
-    heap        = Heap.fromList list :: MaxHeap Int
-    (a,  b)     = List.splitAt n' (sortBy (heapCompare (policy heap)) list)
-    (a', heap') = Heap.splitAt n' heap
-    in
-    (Heap.fromList b == heap') && equal heap a a'
+    qc "span for MinHeap" (spanProperty even :: MinHeap Int -> Bool)
+    qc "span for MaxHeap" (spanProperty even :: MaxHeap Int -> Bool)
+    qc "span for MinPrioHeap" (spanProperty testProp :: MinPrioHeap Int Char -> Bool)
+    qc "span for MaxPrioHeap" (spanProperty testProp :: MaxPrioHeap Int Char -> Bool)
     where
-    equal _ [] [] = True
-    equal _ _  [] = False
-    equal _ [] _  = False
-    equal h (x:xs) (y:ys) = EQ == heapCompare (policy h) x y && equal h xs ys
-
-headTailProperty :: [Int] -> Bool
-headTailProperty []   = True
-headTailProperty list = let
-    heap  = fromList list :: MaxHeap Int
-    list' = sortBy (heapCompare (policy heap)) list
-    in case view heap of
-        Nothing      -> False -- list is not empty
-        Just (h, hs) -> h == List.head list' && hs == (fromAscList (List.tail list'))
-
-takeDropSplitAtProperty :: (Ord a) => Int -> MinHeap a -> Bool
-takeDropSplitAtProperty n heap = let
-    n'           = signum n * (n `mod` 100)
-    (begin, end) = Heap.splitAt n heap
-    begin'       = Heap.take n heap
-    end'         = Heap.drop n heap
-    in
-    begin == begin' && end == end'
-
-takeWhileSpanBreakProperty :: Int -> Int -> Bool
-takeWhileSpanBreakProperty len index = let
-    length'      = abs (len `mod` 100)
-    index'       = abs (index `mod` 100)
-    xs           = [1..(max length' index')]
-    heap         = Heap.fromAscList xs :: MinHeap Int
-    p1 x         = x <= index'
-    p2 x         = x > index'
-    (xs', heap') = Heap.span p1 heap
-    in
-    xs' == Heap.takeWhile p1 heap
-        && heap' == Heap.dropWhile p1 heap
-        && (xs', heap') == Heap.break p2 heap
-
-readShowProperty :: (HeapPolicy p a, Show a, Read a) => Heap p a -> Bool
-readShowProperty heap = heap == read (show heap)
+    testProp :: (Int, Char) -> Bool
+    testProp (i, c) = even i /= isLetter c
 
-listProperty :: [Int] -> Bool
-listProperty xs = let
-    xsAsc  = sort xs
-    xsDesc = reverse xsAsc
-    h1     = fromList xs         :: MinHeap Int
-    h2     = fromAscList xsAsc   :: MinHeap Int
-    h3     = fromDescList xsDesc :: MinHeap Int
-    in
-    (h1 == h2) && (h2 == h3)
-        && (and (map leftistHeapProperty [h1, h2, h3]))
-        && (and (map ((== xsAsc) . toAscList) [h1, h2, h3]))
-        && (and (map ((== xsDesc) . toDescList) [h1, h2, h3]))
+listProperty :: (HeapItem pol item, Ord (Val pol item)) => Heap pol item -> Bool
+listProperty heap = let
+    pairs = toList heap
+    asc   = toAscList heap
+    desc  = toDescList heap
+    heap2 = fromList pairs
+    heap3 = fromAscList asc
+    heap4 = fromDescList desc
+    in and (fmap leftistHeapProperty [heap2, heap3, heap4])
+        && heap == heap2
+        && heap == heap3
+        && heap == heap4
 
-toListProperty :: (HeapPolicy p a, Eq a) => Heap p a -> Bool
-toListProperty heap = toList heap == elems heap
+headTailViewProperty :: (HeapItem pol item, Eq item, Ord (Val pol item))
+    => Heap pol item -> Bool
+headTailViewProperty heap = if null heap
+    then isEmpty heap
+        && Nothing == view heap
+        && Nothing == viewHead heap
+        && Nothing == viewTail heap
+    else case view heap of
+        Just (h, heap') -> viewHead heap == Just h && viewTail heap == Just heap'
+        Nothing         -> False
 
-partitionFilterProperty :: (HeapPolicy p a) => (a -> Bool) -> Heap p a -> Bool
-partitionFilterProperty p heap = let
-    (yes,  no)  = Heap.partition p heap
-    (yes', no') = List.partition p (toList heap)
-    in
-    yes == fromList yes'
-        && no == fromList no'
-        && (Heap.filter p heap) == fromList yes'
+partitionProperty :: (HeapItem pol item, Ord (Val pol item))
+    => (item -> Bool) -> Heap pol item -> Bool
+partitionProperty p heap = let
+    (yes, no) = partition p heap
+    in and (fmap p (toList yes))
+        && and (fmap (not . p) (toList no))
+        && heap == yes `union` no
 
-orderingProperty :: (Ord a) => MinHeap a -> MinHeap a -> Bool
-orderingProperty heap1 heap2 = let
-    list1 = toAscList heap1
-    list2 = toAscList heap2
-    in
-    compare heap1 heap2 == compare list1 list2
+splitAtProperty :: (HeapItem pol item, Ord (Val pol item))
+    => Int -> Heap pol item -> Bool
+splitAtProperty n heap = let
+    (before, after) = splitAt n heap
+    in n < 0 || length before == n || isEmpty after
+        && heap == fromAscList before `union` after
 
+spanProperty :: (HeapItem pol item) => (item -> Bool) -> Heap pol item -> Bool
+spanProperty p heap = let
+    (yes, heap') = span p heap
+    (no, heap'') = break p heap
+    in and (fmap p yes)
+        && and (fmap (not . p) no)
+        && maybe True (not . p) (viewHead heap')
+        && maybe True p (viewHead heap'')
diff --git a/Test/Heap/Common.hs b/Test/Heap/Common.hs
new file mode 100644
--- /dev/null
+++ b/Test/Heap/Common.hs
@@ -0,0 +1,53 @@
+module Test.Heap.Common
+    ( qc
+    , eqProperty, ordProperty
+    , readShowProperty
+    , monoidProperty
+    , functorProperty
+    , foldableProperty
+    ) where
+
+import Data.Foldable ( Foldable(..) )
+import Data.Monoid
+import Prelude hiding ( foldl, foldr )
+import Test.QuickCheck
+
+qc :: (Testable prop) => String -> prop -> IO ()
+qc msg prop = quickCheck
+    $ whenFail (putStrLn msg)
+    $ label msg prop
+
+eqProperty :: (Eq a) => a -> a -> a -> Bool
+eqProperty x y z = (x == y) == (y == x)
+    && ((not (x == y && y == z)) || x == z)
+
+ordProperty :: (Ord a) => a -> a -> a -> Bool
+ordProperty x y z = let
+    _min = minimum [x, y, z]
+    _max = maximum [x, y, z]
+    in case compare x y of
+            LT -> x < y && x <= y && not (x > y) && not (x >= y)
+            EQ -> x == y && x <= y && x >= y && not (x < y) && not (x > y)
+            GT -> x > y && x >= y && not (x < y) && not (x <= y)
+        && _min <= x && _min <= y && _min <= z
+        && _max >= x && _max >= y && _max >= z
+
+readShowProperty :: (Read a, Show a, Eq a) => [a] -> Bool
+readShowProperty x = x == read (show x)
+    && (null x || head x == read (show (head x)))
+
+monoidProperty :: (Monoid m, Eq m) => m -> m -> m -> Bool
+monoidProperty m1 m2 m3 = let
+    result = mconcat [m1, m2, m3]
+    in
+    result == (m1 `mappend` m2) `mappend` m3
+        && result == m1 `mappend` (m2 `mappend` m3)
+        && m1 == mempty `mappend` m1
+        && m1 == m1 `mappend` mempty
+
+functorProperty :: (Functor f, Eq (f a), Eq (f c)) => (b -> c) -> (a -> b) -> f a -> Bool
+functorProperty f g fun = fun == fmap id fun
+    && fmap (f . g) fun == fmap f (fmap g fun)
+
+foldableProperty :: (Foldable f, Eq a) => f a -> Bool
+foldableProperty xs = foldl (flip (:)) [] xs == reverse (foldr (:) [] xs)
diff --git a/Test/Heap/Internal.hs b/Test/Heap/Internal.hs
new file mode 100644
--- /dev/null
+++ b/Test/Heap/Internal.hs
@@ -0,0 +1,127 @@
+module Test.Heap.Internal
+    ( runTests
+    , leftistHeapProperty
+    ) where
+
+import Data.Char
+import Data.Heap.Internal as Heap
+import qualified Data.List as List
+import Test.Heap.Common
+import Test.QuickCheck
+
+runTests :: IO ()
+runTests = do
+    qc "Eq" (eqProperty :: HeapT Int Char -> HeapT Int Char -> HeapT Int Char -> Bool)
+    qc "Ord" (ordProperty :: HeapT Int Char -> HeapT Int Char -> HeapT Int Char -> Bool)
+    qc "leftist heap" (leftistHeapProperty :: HeapT Int Char -> Bool)
+    qc "read/show" (readShowProperty :: [HeapT Int Char] -> Bool)
+    qc "Monoid" (monoidProperty :: HeapT Int Char -> HeapT Int Char -> HeapT Int Char -> Bool)
+    qc "union" (unionProperty :: HeapT Int Char -> HeapT Int Char -> Bool)
+    qc "Functor" (functorProperty (subtract 1000) (*42) :: HeapT Char Int -> Bool)
+    qc "fmap" (fmapProperty (subtract 1000) :: HeapT Char Int -> Bool)
+    qc "Foldable" (foldableProperty :: HeapT Char Int -> Bool)
+    qc "size" sizeProperty
+    qc "view" viewProperty
+    qc "singleton" (singletonProperty :: Char -> Int -> Bool)
+    qc "partition" (partitionProperty testProp :: HeapT Char Int -> Bool)
+    qc "splitAt" splitAtProperty
+    qc "span" spanProperty
+    qc "fromList/toList" (listProperty :: [Char] -> Bool)
+    qc "fromDescList/toAscList" (sortedListProperty :: [Char] -> Bool)
+    where
+    testProp :: Char -> Int -> Bool
+    testProp c i = even i && isLetter c
+
+instance (Arbitrary prio, Arbitrary val, Ord prio) => Arbitrary (HeapT prio val) where
+    arbitrary = fmap (fromList . take 100) arbitrary
+    shrink    = fmap fromList . shrink . toList
+
+leftistHeapProperty :: (Ord prio) => HeapT prio val -> Bool
+leftistHeapProperty Empty = True
+leftistHeapProperty heap  =
+    (maybe True (\(p, _, _) -> p >= _priority heap) (view (_left heap)))
+        && (maybe True (\(p, _, _) -> p >= _priority heap) (view (_right heap)))
+        && _rank heap == 1 + rank (_right heap)    -- rank == length of right spine
+        && rank (_left heap) >= rank (_right heap) -- leftist property
+        && _size heap == 1 + size (_left heap) + size (_right heap)
+        && leftistHeapProperty (_left heap)
+        && leftistHeapProperty (_right heap)
+
+unionProperty :: (Ord prio, Ord val) => HeapT prio val -> HeapT prio val -> Bool
+unionProperty a b = let ab = a `union` b
+    in leftistHeapProperty ab && size ab == size a + size b
+        && ab == ab `union` empty
+        && ab == empty `union` ab
+        && a == unions (fmap (uncurry singleton) (toList a))
+
+fmapProperty :: (Ord prio) => (val -> val) -> HeapT prio val -> Bool
+fmapProperty f = leftistHeapProperty . fmap f
+
+sizeProperty :: Int -> Bool
+sizeProperty n = let
+    n' = abs n `mod` 100
+    h  = fromList (zip [1..n'] (repeat ())) :: HeapT Int ()
+    in
+    size h == n' && if n' == 0 then isEmpty h else not (isEmpty h)
+
+viewProperty :: [Int] -> Bool
+viewProperty []   = True
+viewProperty list = let
+    heap = fromList (zip list (repeat ()))
+    m    = minimum list
+    in case view heap of
+        Nothing          -> False -- list is not empty
+        Just (p, (), hs) -> p == m
+            && heap == union (singleton p ()) hs
+            && viewProperty (tail list)
+
+singletonProperty :: (Ord prio, Ord val) => prio -> val -> Bool
+singletonProperty p v = let
+    heap = singleton p v
+    in
+    leftistHeapProperty heap && size heap == 1 && view heap == Just (p, v, empty)
+
+partitionProperty :: (Ord prio, Ord val) => (prio -> val -> Bool) -> HeapT prio val -> Bool
+partitionProperty p heap = let
+    (yes,  no)  = partition (uncurry p) heap
+    (yes', no') = List.partition (uncurry p) (toList heap)
+    in
+    (heap, empty) == partition (const True) heap
+        && (empty, heap) == partition (const False) heap
+        && yes == fromList yes'
+        && no == fromList no'
+        && yes `union` no == heap -- nothing gets lost
+
+splitAtProperty :: Int -> Int -> Bool
+splitAtProperty i n = let
+    i'     = i `mod` 100
+    n'     = n `mod` 100
+    ab     = [1..n']
+    (a, b) = List.splitAt i' ab
+    heap   = fromList $ zip ab (repeat ())
+    in
+    Heap.splitAt i' heap == (zip a (repeat ()), fromList (zip b (repeat ())))
+
+spanProperty :: Int -> Int -> Bool
+spanProperty i n = let
+    i'      = i `mod` 100
+    n'      = n `mod` 100
+    ab      = [1..n']
+    (a, b)  = List.span (<= i') ab
+    (a', h) = Heap.span ((<=i') . fst) $ fromList (zip ab (repeat ()))
+    in
+    a == (fmap fst a') && h == fromList (zip b (repeat ()))
+
+listProperty :: (Ord prio) => [prio] -> Bool
+listProperty xs = let
+    list = List.sort xs
+    heap = fromList (zip xs [(1 :: Int) ..])
+    in
+    list == fmap fst (List.sort (toList heap))
+
+sortedListProperty :: (Ord prio) => [prio] -> Bool
+sortedListProperty xs = let
+    list = List.sort xs
+    heap = fromDescList (zip (reverse list) [(1 :: Int) ..])
+    in
+    list == fmap fst (toAscList heap)
diff --git a/Test/Heap/Item.hs b/Test/Heap/Item.hs
new file mode 100644
--- /dev/null
+++ b/Test/Heap/Item.hs
@@ -0,0 +1,80 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Test.Heap.Item
+    ( runTests
+    ) where
+
+import Data.Heap.Item
+import Test.Heap.Common
+import Test.QuickCheck
+
+runTests :: IO ()
+runTests = do
+    qc "Eq for MinPolicy" (eqProperty
+        :: Prio MinPolicy Int -> Prio MinPolicy Int -> Prio MinPolicy Int -> Bool)
+    qc "Eq for MaxPolicy" (eqProperty
+        :: Prio MaxPolicy Int -> Prio MaxPolicy Int -> Prio MaxPolicy Int -> Bool)
+    qc "Eq for FstMinPolicy" (eqProperty
+        :: Prio FstMinPolicy (Int, Char) -> Prio FstMinPolicy (Int, Char)
+        -> Prio FstMinPolicy (Int, Char) -> Bool)
+    qc "Eq for FstMaxPolicy" (eqProperty
+        :: Prio FstMaxPolicy (Int, Char) -> Prio FstMaxPolicy (Int, Char)
+        -> Prio FstMaxPolicy (Int, Char) -> Bool)
+    qc "Ord for MinPolicy" (ordProperty
+        :: Prio MinPolicy Int -> Prio MinPolicy Int -> Prio MinPolicy Int -> Bool)
+    qc "Ord for MaxPolicy" (ordProperty
+        :: Prio MaxPolicy Int -> Prio MaxPolicy Int -> Prio MaxPolicy Int -> Bool)
+    qc "Ord for FstMinPolicy" (ordProperty
+        :: Prio FstMinPolicy (Int, Char) -> Prio FstMinPolicy (Int, Char)
+        -> Prio FstMinPolicy (Int, Char) -> Bool)
+    qc "Ord for FstMaxPolicy" (ordProperty
+        :: Prio FstMaxPolicy (Int, Char) -> Prio FstMaxPolicy (Int, Char)
+        -> Prio FstMaxPolicy (Int, Char) -> Bool)
+
+    qc "read/show for MinPolicy" (readShowProperty :: [Prio MinPolicy Int] -> Bool)
+    qc "read/show for MaxPolicy" (readShowProperty :: [Prio MaxPolicy Int] -> Bool)
+    qc "read/show for FstMinPolicy" (readShowProperty :: [Prio FstMinPolicy (Int, Char)] -> Bool)
+    qc "read/show for FstMaxPolicy" (readShowProperty :: [Prio FstMaxPolicy (Int, Char)] -> Bool)
+
+    qc "split/merge for MinPolicy" (splitMergeProperty
+        :: Prio MinPolicy Int -> Val MinPolicy Int -> Bool)
+    qc "split/merge for MaxPolicy" (splitMergeProperty
+        :: Prio MaxPolicy Int -> Val MaxPolicy Int -> Bool)
+    qc "split/merge for FstMinPolicy" (splitMergeProperty
+        :: Prio FstMinPolicy (Int, Char) -> Val FstMinPolicy (Int, Char) -> Bool)
+    qc "split/merge for FstMaxPolicy" (splitMergeProperty
+        :: Prio FstMaxPolicy (Int, Char) -> Val FstMaxPolicy (Int, Char) -> Bool)
+
+    qc "priority/value for MinPolicy" (priorityValueProperty succ
+        :: Prio MinPolicy Int -> Val MinPolicy Int -> Bool)
+    qc "priority/value for MaxPolicy" (priorityValueProperty succ
+        :: Prio MaxPolicy Int -> Val MaxPolicy Int -> Bool)
+    qc "priority/value for FstMinPolicy" (priorityValueProperty succ
+        :: Prio FstMinPolicy (Int, Char) -> Val FstMinPolicy (Int, Char) -> Bool)
+    qc "priority/value for FstMaxPolicy" (priorityValueProperty succ
+        :: Prio FstMaxPolicy (Int, Char) -> Val FstMaxPolicy (Int, Char) -> Bool)
+
+    qc "splitF for MinPolicy" (splitFProperty (\x -> 4 * x - 7)
+        :: Prio MinPolicy Int -> Val MinPolicy Int -> Bool)
+    qc "splitF for MaxPolicy" (splitFProperty (\x -> 4 * x - 7)
+        :: Prio MaxPolicy Int -> Val MaxPolicy Int -> Bool)
+    qc "splitF for FstMinPolicy" (splitFProperty (\(x, y) -> (pred x, succ y))
+        :: Prio FstMinPolicy (Int, Char) -> Val FstMinPolicy (Int, Char) -> Bool)
+    qc "splitF for FstMaxPolicy" (splitFProperty (\(x, y) -> (pred x, succ y))
+        :: Prio FstMaxPolicy (Int, Char) -> Val FstMaxPolicy (Int, Char) -> Bool)
+
+instance (Arbitrary item, HeapItem pol item) => Arbitrary (Prio pol item) where
+    arbitrary = fmap (fst . split) arbitrary
+
+splitMergeProperty :: (HeapItem pol item, Eq (Prio pol item), Eq (Val pol item))
+    => Prio pol item -> Val pol item -> Bool
+splitMergeProperty p v = (p, v) == split (merge (p, v))
+
+priorityValueProperty :: (HeapItem pol item, Eq (Prio pol item))
+    => (Val pol item -> Val pol item) -> Prio pol item -> Val pol item -> Bool
+priorityValueProperty f p v = p == fst (split (merge (p, v)))
+    && p == fst (split (merge (p, f v)))
+
+splitFProperty :: (HeapItem pol item, Eq a)
+    => (item -> a) -> Prio pol item -> Val pol item -> Bool
+splitFProperty f p v = f (merge (p, v)) == splitF f (p, v)
diff --git a/heap.cabal b/heap.cabal
--- a/heap.cabal
+++ b/heap.cabal
@@ -1,27 +1,55 @@
-
 Name:                heap
-Version:             0.6.0
-Stability:           beta
+Version:             1.0.0
 
 Category:            Data Structures
 Synopsis:            Heaps in Haskell
-Description:         A flexible Haskell heap implementation
+Description:         A flexible Haskell implementation of minimum, maximum,
+                     minimum-priority, maximum-priority and custom-ordered
+                     heaps.
 
 License:             BSD3
 License-File:        LICENSE
 Copyright:           (c) 2008-2009, Stephan Friedrichs
-
 Author:              Stephan Friedrichs
 Maintainer:          Stephan Friedrichs (deduktionstheorem at web dot de)
 
 Build-Type:          Simple
-Cabal-Version:       >= 1.2
-Extra-Source-Files:  Test.lhs, Test/Heap.hs
-Tested-With:         GHC, Hugs
+Cabal-Version:       >= 1.2.3
+Tested-With:         GHC == 6.10.2, GHC == 6.10.3
 
+Flag Test
+  Description:       Build a binary running test cases
+  Default:           False
+
 Library
-  Build-Depends:     base
-  Exposed-Modules:   Data.Heap
+  Build-Depends:     base >= 3 && < 5
+  Exposed-Modules:
+      Data.Heap
+  Other-Modules:
+      Data.Heap.Internal
+    , Data.Heap.Item
   GHC-Options:       -Wall -fwarn-tabs
-  Extensions:        CPP, EmptyDataDecls, FlexibleInstances, MultiParamTypeClasses
+  Extensions:
+      DeriveDataTypeable
+    , EmptyDataDecls
+    , FlexibleContexts
+    , FlexibleInstances
+    , MultiParamTypeClasses
+    , TypeFamilies
 
+Executable heap-tests
+  if !flag( Test )
+    Buildable:       False
+  Main-Is:
+      Test.hs
+  Other-Modules:
+      Data.Heap
+    , Data.Heap.Internal
+    , Data.Heap.Item
+    , Test.Heap
+    , Test.Heap.Common
+    , Test.Heap.Internal
+    , Test.Heap.Item
+  Build-Depends:     QuickCheck >= 2 && < 3
+  CPP-Options:       -D__TEST__
+  GHC-Options:       -Wall -fwarn-tabs -fno-ignore-asserts