diff --git a/Data/Queue/Fuse/Map.hs b/Data/Queue/Fuse/Map.hs
new file mode 100644
--- /dev/null
+++ b/Data/Queue/Fuse/Map.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE TypeFamilies, PatternGuards #-}
+module Data.Queue.Fuse.Map where
+
+import Data.Semigroup
+import Data.Queue.Class
+import Data.Map
+import qualified Data.Map as Map
+
+newtype FuseMapQ k v = FMQ (Map k v) deriving (Show)
+
+instance (Ord k, Semigroup v) => IQueue (FuseMapQ k v) where
+	type QueueKey (FuseMapQ k v) = (k, v)
+	empty = FMQ Map.empty
+	singleton = FMQ . uncurry Map.singleton
+	fromList = FMQ . Map.fromListWith sappend
+
+	null (FMQ m) = Map.null m
+	size (FMQ m) = Map.size m
+	extract (FMQ m) = fmap (fmap FMQ) (Map.minViewWithKey m)
+	FMQ m1 `merge` FMQ m2 = FMQ (Map.unionWith sappend m1 m2)
+	mergeAll qs = FMQ (Map.unionsWith sappend [m | FMQ m <- qs])
+	(k, v) `insert` FMQ m = FMQ (Map.insertWith sappend k v m)
+
+extractSingle :: (Ord k, Semigroup v) => FuseMapQ k v -> Maybe (k, v)
+extractSingle (FMQ m)
+	| Map.size m == 1, (k, v) <- findMin m
+		= Just (k, v)
+extractSingle _ = Nothing
+
+replace :: (Ord k, Semigroup v) => v -> FuseMapQ k v -> FuseMapQ k v
+replace v (FMQ m) = FMQ (updateMin (\ _ -> Just v) m)
diff --git a/Data/Queue/Fuse/PHeap.hs b/Data/Queue/Fuse/PHeap.hs
new file mode 100644
--- /dev/null
+++ b/Data/Queue/Fuse/PHeap.hs
@@ -0,0 +1,101 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}
+{-# OPTIONS -fno-liberate-case #-}
+
+{- |
+This module implements the functionality of a /monoid queue/, which is essentially a priority queue that merges values with equal keys.  
+Several implementations were considered:
+
+* A pairing heap which, as part of its merging operation, merges any identical-keyed values it encounters.
+	This may result in partial merging of equal-keyed values for several different keys during a single 
+	delete-min operation, decreasing the number of nodes in the queue without costing any additional 
+	comparisons (and -- since the merged values are stored lazily -- the actual merged value is not computed
+	until it actually gets demanded).  Various specialized implementations of bulk merging operations are also
+	possible.
+* A skew heap constructed along the same lines: an extremely simple, vanilla implementation of a heap fundamentally
+	based on its merge operation, modified appropriately.
+* A considerably simpler bootstrap on a vanilla @PQueue@, which keeps the totally merged value associated with its very minimum key and performs no partial merging until a
+	key becomes the minimum. (The fact that no partial merging is performed allows an optimized and balanced 'mconcat' to be used on all the values associated with a key at once.)
+* A simple wrapper over Data.Map, which includes a variant for every one of its methods to use a combination operation
+	(i.e. sappend).
+
+Each of these implementations are included in the Cabal distribution of queuelike.
+
+-}
+module Data.Queue.Fuse.PHeap (FusePHeap, extractSingle, replace) where
+
+import Data.Queue.Class
+import Data.Queue.QueueHelpers
+import Data.Semigroup
+import Data.Maybe
+
+data PHeap k v = PH k v [PHeap k v] deriving (Show)
+newtype FusePHeap k v = FPH (Point (PHeap k v)) deriving (Show, Monoid)
+
+data Merge k v = Mrg k v [v] [PHeap k v]
+
+extractSingle :: FusePHeap k v -> Maybe (k, v)
+extractSingle (FPH (Pt (Just (PH k v [])))) = Just (k,v)
+extractSingle _ = Nothing
+
+replace :: v -> FusePHeap k v -> FusePHeap k v
+replace v (FPH (Pt (Just (PH k _ ts)))) = fph (Just (PH k v ts))
+replace _ h = h
+
+instance (Ord k, Semigroup v) => Semigroup (PHeap k v) where
+	sappend = mergePH
+	sconcat = mergePHs
+	sconcat_ = mergePHs_
+	
+mergePH :: (Ord k, Semigroup v) => Endo (PHeap k v)
+h1@(PH k1 v1 hs1) `mergePH` h2@(PH k2 v2 hs2) = case compare k1 k2 of
+	LT	-> PH k1 v1 (h2:hs1)
+	EQ	-> PH k1 (v1 `sappend` v2) (hs1 ++ hs2)
+	GT	-> PH k2 v2 (h1:hs2)
+
+mergePHs :: (Ord k, Semigroup v) => [PHeap k v] -> Maybe (PHeap k v)
+mergePHs [] = Nothing
+mergePHs (h:hs) = Just (mergePHs_ h hs)
+
+mergePHs_ :: (Ord k, Semigroup v) => PHeap k v -> [PHeap k v] -> PHeap k v
+h@(PH k0 v0 hs0) `mergePHs_` hs = case hs of
+	[]	-> h
+	_	-> merger k0 v0 [] hs0 hs
+	where	--{-# NOINLINE merger #-}
+		{-# NOINLINE cmp #-}
+		cmp = compare
+		{-# NOINLINE (<<|) #-}
+		(<<|) = sconcat_
+		merger k0 v0 vs0 hs0 (h@(PH k v hs):hss) = case cmp k k0 of
+			LT	-> merger k v [] (PH k0 (v0 <<| vs0) hs0:hs) hss
+			EQ	-> merger k0 v0 (v:vs0) (hs ++ hs0) hss
+			GT	-> merger k0 v0 vs0 (h:hs0) hss
+		merger k v vs hs [] = PH k (v <<| vs) hs
+
+instance (Ord k, Semigroup v) => IQueue (FusePHeap k v) where
+	type QueueKey (FusePHeap k v) = (k, v)
+	empty = FPH pNothing --mempty
+	merge = mappend
+	mergeAll = mconcat
+
+	insertAll = mappend . fph . sconcat . map single
+--	insertAll = mappend . fph . fusing . map single
+
+	singleton = fph . Just . single
+--	fromList = fph . fusing . map single
+	fromList = fph . sconcat . map single
+
+	top (FPH (Pt h)) = fmap peek' h where peek' (PH k v _) = (k, v)
+	delete (FPH (Pt h)) = fmap delete' h where
+		delete' (PH _ _ hs) = fph $ fusing hs
+
+	null (FPH (Pt Nothing)) = True
+	null _ = False
+
+	toList_ (FPH (Pt h)) = maybe [] (unfoldList unHeap) h where
+		unHeap (PH k v hs) = ((k, v), hs)
+
+single :: (k, v) -> PHeap k v
+single (k, v) = PH k v []
+
+fph = FPH . Pt
+
diff --git a/Data/Queue/Fuse/PHeap2.hs b/Data/Queue/Fuse/PHeap2.hs
new file mode 100644
--- /dev/null
+++ b/Data/Queue/Fuse/PHeap2.hs
@@ -0,0 +1,76 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}
+
+module Data.Queue.Fuse.PHeap2 (FusePHeap, extractSingle, replace) where
+
+import Data.Queue.Class
+import Data.Semigroup
+import Data.Maybe
+
+data PHeap k v = PH k v [PHeap k v] deriving (Show)
+newtype FusePHeap k v = FPH (Point (PHeap k v)) deriving (Show, Monoid)
+
+data Merge k v = Mrg v [v] [PHeap k v]
+
+extractSingle :: FusePHeap k v -> Maybe (k, v)
+extractSingle (FPH (Pt (Just (PH k v [])))) = Just (k,v)
+extractSingle _ = Nothing
+
+replace :: v -> FusePHeap k v -> FusePHeap k v
+replace v (FPH (Pt (Just (PH k _ ts)))) = fph (Just (PH k v ts))
+replace _ h = h
+
+instance Functor (PHeap k) where
+	fmap f (PH k v hs) = PH k (f v) (map (fmap f) hs)
+
+instance Semigroup (Merge k v) where
+	Mrg v1 vs1 qs1 `sappend` Mrg v2 vs2 qs2 = Mrg v1 (v2:vs1 ++ vs2) (qs1 ++ qs2)
+
+merger :: (v -> v -> v) -> v -> [v] -> v
+merger (><) h hs = case merger' h hs of (h', hs') -> foldl (><) h' hs ; where
+	merger' h [] = (h, [])
+	merger' h1 (h2:hs) = (h1 >< h2, case hs of
+		[]	-> []
+		(h3:hs)	-> case merger' h3 hs of (h, hs) -> h:hs)
+
+instance (Ord k, Semigroup v) => Semigroup (PHeap k v) where
+	sappend = mergePH
+	sconcat_ = merger mergePH
+	sconcat [] = Nothing
+	sconcat (h:hs) = Just (merger mergePH h hs)
+
+mergePH :: (Ord k, Semigroup v) => Endo (PHeap k v)
+h1@(PH k1 v1 hs1) `mergePH` h2@(PH k2 v2 hs2) = case compare k1 k2 of
+	LT	-> PH k1 v1 (h2:hs1)
+	EQ	-> PH k1 (v1 `sappend` v2) (hs1 ++ hs2)
+	GT	-> PH k2 v2 (h1:hs2)
+	--sconcat = fusePHs sconcat_
+
+{-# NOINLINE fusePHs #-}
+fusePHs :: (Ord k) => (v -> [v] -> v) -> Fusion (PHeap k v)
+fusePHs scat hs = {-cmp hs `seq`-} fmap fromMrg (fusing [single (k, Mrg v [] qs) | PH k v qs <- hs]) where
+	fromMrg (PH k (Mrg v vs qs) qs0) = PH k (scat v vs) (map fromMrg qs0 ++ qs)
+	cmp :: Ord k => [PHeap k v] -> k -> k -> Ordering
+	cmp _ = compare
+
+instance (Ord k, Semigroup v) => IQueue (FusePHeap k v) where
+	type QueueKey (FusePHeap k v) = (k, v)
+	empty = FPH pNothing --mempty
+	merge = mappend
+	mergeAll = mconcat
+
+	insertAll = merge . fph . fusing . map single
+	singleton = fph . Just . single
+	fromList = fph . fusing . map single
+	
+	{-# INLINE extract #-}
+	extract (FPH (Pt h)) = fmap extract' h where extract' (PH k v hs) = ((k, v), fph $ fusing hs)
+--	top (FPH (Pt h)) = fmap top' h where top' (PH k v _) = (k, v)
+--	delete (FPH (Pt h)) = fmap delete' h where delete' (PH _ _ hs) = fph $ fusing hs
+
+	null (FPH (Pt Nothing)) = True
+	null _ = False
+
+single :: (k, v) -> PHeap k v
+single (k, v) = PH k v []
+
+fph = FPH . Pt
diff --git a/Data/Queue/Fuse/SkewHeap.hs b/Data/Queue/Fuse/SkewHeap.hs
new file mode 100644
--- /dev/null
+++ b/Data/Queue/Fuse/SkewHeap.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-}
+{-# OPTIONS -fspec-constr -fspec-constr-count=8 -fspec-constr-threshold=50 #-}
+
+module Data.Queue.Fuse.SkewHeap (FuseSHeap, extractSingle, replace) where
+
+import Data.Semigroup
+import Data.Maybe
+import Data.Queue.Class
+import Data.Queue.QueueHelpers
+import Data.Queue.Fuse.SplitList
+
+data SHeap k v = SH k v (MSHeap k v) (MSHeap k v) deriving (Show)
+type MSHeap k v = Point (SHeap k v)
+newtype FuseSHeap k v = FSH (MSHeap k v) deriving (Monoid, Show)
+
+type Comparator e = e -> e -> Ordering
+
+instance (Ord k, Semigroup v) => Semigroup (SHeap k v) where
+	sappend = mergeSH
+	sconcat = mergeSHs
+
+{-# INLINE mergeSH #-}
+mergeSH :: (Ord k, Semigroup v) => Endo (SHeap k v)
+mergeSH = (mergeFuncs compare sappend)
+
+mergeFuncs :: Comparator k -> Endo v -> Endo (SHeap k v)
+mergeFuncs cmp (><) = (>!<) where
+	(>?<) = endoPoint (>!<)
+	h1@(SH k1 v1 l1 r1) >!< h2@(SH k2 v2 l2 r2) = case cmp k1 k2 of
+		LT	-> SH k1 v1 (pJust h2 >?< r1) l1
+		EQ	-> SH k1 (v1 >< v2) (l1 >?< r2) (l2 >?< r1)
+		GT	-> SH k2 v2 (pJust h1 >?< r2) l2
+
+data Merge k v = Mrg k v [v] {-# UNPACK #-} !(Split (SHeap k v)) 
+
+{-# INLINE sh #-}
+sh :: k -> v -> Maybe (SHeap k v) -> Maybe (SHeap k v) -> SHeap k v
+sh k v l r = SH k v (Pt l) (Pt r)
+
+{-# INLINE mergeSHs #-}
+mergeSHs :: (Ord k, Semigroup v) => Fusion (SHeap k v)
+mergeSHs = mergeSHs0 compare sappend sconcat
+
+mergeSHs0 :: Comparator k -> Endo v -> Fusion v -> Fusion (SHeap k v)
+mergeSHs0 cmp (><) cat0 = mergeSHs' where
+	mergeSHs' [] = Nothing
+	mergeSHs' (SH k v l r:hs0) = Just $ mrgToSH $ foldl merger (Mrg k v [] (consLR l r emptySpl)) hs0
+	consLR l r spl = [q | Pt (Just q) <- [l,r]] <<| spl
+	(>!<) = mergeFuncs cmp (><)
+	v `cat` vs = fromJust (cat0 (v:vs))
+	{-# INLINE mrgToSH #-}
+	mrgToSH (Mrg k v vs subTs) = let (ls, rs) = split subTs in 
+		sh k (v `cat` vs) (mergeSHs' ls) (mergeSHs' rs)
+	mrg@(Mrg k0 v0 vs0 subTs) `merger` h@(SH k v l r) = case cmp k k0 of
+		LT	-> let (ls, rs) = split subTs in
+			Mrg k v [] $ singleSpl (mrgToSH mrg)
+		EQ	-> Mrg k0 v0 (v:vs0) (consLR l r subTs)
+		GT	-> Mrg k0 v0 vs0 (h <| subTs)
+
+instance (Ord k, Semigroup v) => IQueue (FuseSHeap k v) where
+	type QueueKey (FuseSHeap k v) = (k, v)
+	empty = mempty
+	merge = mappend
+	mergeAll = mconcat
+
+	singleton = FSH . pJust . single
+	fromList = fsh . sconcat . map single
+
+	extract (FSH (Pt h)) = fmap extract' h where
+		extract' (SH k v l r) = ((k,v), FSH (l `mappend` r))
+
+	null (FSH (Pt Nothing)) = True
+	null _ = False
+
+	toList_ (FSH (Pt h)) = maybe [] (unfoldList unHeap) h where
+		unHeap (SH k v l r) = ((k, v), [t | Pt (Just t) <- [l,r]])
+
+single :: (Ord k, Semigroup v) => (k, v) -> SHeap k v
+single (k, v) = SH k v mempty mempty
+
+extractSingle :: FuseSHeap k v -> Maybe (k, v)
+extractSingle (FSH (Pt (Just (SH k v (Pt Nothing) (Pt Nothing)))))
+	= Just (k, v)
+extractSingle _ = Nothing
+
+replace :: v -> FuseSHeap k v -> FuseSHeap k v
+replace v (FSH (Pt (Just (SH k _ l r)))) = FSH (pJust (SH k v l r))
+
+fsh = FSH . Pt
diff --git a/Data/Queue/Fuse/Vanilla.hs b/Data/Queue/Fuse/Vanilla.hs
new file mode 100644
--- /dev/null
+++ b/Data/Queue/Fuse/Vanilla.hs
@@ -0,0 +1,81 @@
+{-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving #-}
+
+module Data.Queue.Fuse.Vanilla (FuseVHeap, extractSingle, replace) where
+
+import Data.Queue.Class
+import Data.Queue.PQueue
+import Data.Semigroup
+import Prelude hiding (null)
+
+data Assoc k v = A k v deriving (Show)
+data VHeap k v = VH k v {-# UNPACK #-} !(PQueue (Assoc k v)) deriving (Show)
+newtype FuseVHeap k v = FVH (Point (VHeap k v)) deriving (Monoid, Show)
+
+instance Eq k => Eq (Assoc k v) where
+	A x _ == A y _ = x == y
+
+instance Ord k => Ord (Assoc k v) where
+	A x _ `compare` A y _ = x `compare` y
+	A x _ <= A y _ = x <= y
+
+instance (Ord k, Semigroup v) => Semigroup (VHeap k v) where
+	sappend = mergeVH
+	sconcat [] = Nothing
+	sconcat (q:qs) = Just (mergeVHs q qs)
+	sconcat_ = mergeVHs
+
+mergeVH :: (Ord k, Semigroup v) => Endo (VHeap k v)
+VH k1 v1 q1 `mergeVH` VH k2 v2 q2 = case compare k1 k2 of
+	LT	-> VH k1 v1 (A k2 v2 `insert` q)
+	EQ	-> VH k1 (v1 `sappend` v2) q
+	GT	-> VH k2 v2 (A k1 v1 `insert` q)
+	where	q = q1 `merge` q2
+
+data Acc k v = Ac k v [v] [Assoc k v] [PQueue (Assoc k v)]
+
+mergeVHs :: (Ord k, Semigroup v) => VHeap k v -> [VHeap k v] -> VHeap k v
+mergeVHs (VH k0 v0 q0) hs = case foldl merger (Ac k0 v0 [] [] []) hs of
+	Ac k v vs as qs	-> VH k (v <<| vs) (as `insertAll` mergeAll qs)
+	where	Ac k v vs as qs `merger` VH k' v' q' = let qs' = q':qs in case compare k' k of
+			LT -> Ac k' v' [] (A k (v <<| vs):as) qs'
+			EQ -> Ac k v (v':vs) as qs'
+			GT -> Ac k v vs (A k' v':as) qs'
+		{-# NOINLINE (<<|) #-}
+		(<<|) = sconcat_
+
+toVH :: (Ord k, Semigroup v) => PQueue (Assoc k v) -> Maybe (VHeap k v)
+toVH = fmap toVH1 . extract where
+	toVH1 (A k v, q) = let	toVH' vs q = case extract q of	Just (A k' v', q') | k == k'
+									-> toVH' (v':vs) q'
+								_	-> VH k (sconcat_ v vs) q
+				in toVH' [] q
+
+instance (Ord k, Semigroup v) => IQueue (FuseVHeap k v) where
+	type QueueKey (FuseVHeap k v) = (k, v)
+	empty = fvh Nothing
+	merge = mappend
+	mergeAll = mconcat
+
+	singleton = fvh . Just . single
+	fromList = fvh . fusing . map single
+
+	null (FVH (Pt Nothing)) = True
+	null _ = False
+
+	extract (FVH (Pt h)) = fmap extract' h where
+		extract' (VH k v q) = ((k, v), fvh $ toVH q)
+
+single :: (Ord k, Semigroup v) => (k, v) -> VHeap k v
+single (k, v) = VH k v empty
+
+fvh :: (Ord k, Semigroup v) => Maybe (VHeap k v) -> FuseVHeap k v
+fvh = FVH . Pt
+
+extractSingle :: Ord k => FuseVHeap k v -> Maybe (k, v)
+extractSingle (FVH (Pt (Just (VH k v q))))
+	| null q	= Just (k, v)
+extractSingle _ = Nothing
+
+replace :: (Ord k, Semigroup v) => v -> FuseVHeap k v -> FuseVHeap k v
+replace v (FVH (Pt (Just (VH k _ q)))) = fvh (Just (VH k v q))
+replace _ q = q
diff --git a/Data/Queue/PQueue.hs b/Data/Queue/PQueue.hs
--- a/Data/Queue/PQueue.hs
+++ b/Data/Queue/PQueue.hs
@@ -13,7 +13,8 @@
 import qualified Data.Tree as T
 	
 import Data.Maybe
-import Data.Monoid
+import Data.Semigroup
+--import Data.Monoid
 
 import Control.Monad
 
@@ -26,11 +27,10 @@
 	show = drawQueue
 
 drawQueue :: Show e => PQueue e -> String
-drawQueue (PQ (HQ _ t)) = maybe "" (T.drawTree . fmap show . T.unfoldTree (\ (T x ts) -> (x, ts))) t
+drawQueue (PQ (HQ _ (Pt t))) = maybe "" (T.drawTree . fmap show . T.unfoldTree (\ (T x ts) -> (x, ts))) t
 
-instance Ord e => Monoid (Tree e) where
-	-- no actual mzero instance, but induces a correct Monoid instance for Heap e
-	t1@(T x1 ts1) `mappend` t2@(T x2 ts2)
+instance Ord e => Semigroup (Tree e) where
+	t1@(T x1 ts1) `sappend` t2@(T x2 ts2)
 		| x1 <= x2	= T x1 (t2:ts1)
 		| otherwise	= T x2 (t1:ts2)
 
@@ -41,25 +41,25 @@
 
 	type QueueKey (PQueue e) = e
 
-	empty = mempty
+	empty = PQ mempty
 	singleton = PQ . single
-	fromList xs = PQ $ fuseMergeM [single x | x <- xs]
+	fromList xs = PQ (HQ (length xs) (Pt $ sconcat [T x [] | x <- xs]))
 
 	xs `insertAll` q = q `mappend` fromList xs
 	merge = mappend
-	mergeAll qs = PQ (fuseMergeM [h | PQ h <- qs])
+	mergeAll = mconcat
 
-	extract (PQ (HQ n t)) = fmap (fmap (PQ . HQ (n-1)) . extract') t
+	extract (PQ (HQ n (Pt t))) = fmap (fmap (PQ . HQ (n-1) . Pt) . extract') t
 		where	extract' (T x ts) = (x, fusing ts)
-	toList_ (PQ (HQ _ t)) = maybe [] flatten t
+	toList_ (PQ (HQ _ (Pt t))) = maybe [] flatten t
 		where	flatten (T x ts) = x:concatMap flatten ts
 
-	null (PQ (HQ _ Nothing)) = True
+	null (PQ (HQ _ (Pt Nothing))) = True
 	null _ = False
 	size (PQ (HQ n _)) = n
 
 single :: e -> HeapQ (Tree e)
-single x = HQ 1 $ Just (T x [])
+single x = HQ 1 $ pJust (T x [])
 
 {-# RULES
 -- 	"singleton/PQueue" forall (x :: Ord e => e) . singleton x = PQ (single x);
diff --git a/Data/Queue/QueueHelpers.hs b/Data/Queue/QueueHelpers.hs
--- a/Data/Queue/QueueHelpers.hs
+++ b/Data/Queue/QueueHelpers.hs
@@ -1,5 +1,5 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# OPTIONS -fno-warn-name-shadowing #-}
+{-# LANGUAGE FlexibleContexts, ViewPatterns #-}
+{-# OPTIONS -fno-warn-name-shadowing -fno-warn-overlapping-patterns #-}
 
 {------------------
 
@@ -23,16 +23,21 @@
 monoid merging operation used by nearly every priority queue implementation in this package.
 -------------------}
 
-module Data.Queue.QueueHelpers (MonoidQ (..), HeapQ, fusing', endoMaybe, order, fusing, fuseMerge, fuseMergeM) where
+module Data.Queue.QueueHelpers (MonoidQ (..), HeapQ, order, unfoldList) where
 
-import Data.Monoid
+import Data.Semigroup
+--import Data.Monoid
 import Data.Maybe
 import Data.List(unfoldr)
 import GHC.Exts(build)
 
 data MonoidQ m = HQ {elts :: Int, heap :: m} deriving (Eq, Ord, Show)
-type HeapQ m = MonoidQ (Maybe m)
+type HeapQ m = MonoidQ (Point m)
 
+instance Semigroup m => Semigroup (MonoidQ m) where
+	HQ n1 h1 `sappend` HQ n2 h2 = HQ (n1 + n2) (h1 `sappend` h2)
+	sconcat qs = fmap (HQ $ sum [n | HQ n _ <- qs]) (sconcat [q | HQ _ q <- qs])
+
 instance Functor MonoidQ where
 	fmap f (HQ n m) = HQ n (f m)
 
@@ -56,35 +61,6 @@
 -- decr f (HQ 0 x) = Nothing
 
 
-{-# INLINE endoMaybe #-}
-endoMaybe :: (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a
-endoMaybe f (Just a) (Just b)	= Just (f a b)
-endoMaybe _ ma mb		= maybe mb Just ma
-
-fusing' :: (m -> m -> m) -> [m] -> Maybe m
-fusing' (><) = let
-		fuser [] = Nothing
-		fuser [t] = Just t
-		fuser ts = fuser (fuser' ts)
-		fuser' (t1:t2:t3:t4:ts) =
-			(t1 >< t2) >< (t3 >< t4) : fuser' ts
-		fuser' [t1,t2,t3]	= [t1 >< t2 >< t3]
-		fuser' [t1,t2]		= [t1 >< t2]
-		fuser' ts		= ts
-	in fuser
-
-fusing :: Monoid m => [m] -> Maybe m
-fusing = fusing' mappend
-
-{-
-fusing [] = Nothing
-fusing [t] = Just t
-fusing ts = fusing (fuse ts) where
-	fuse [] = []
-	fuse [t] = [t]
-	fuse (t1:t2:ts) = (t1 `mappend` t2):fuse ts
--}
-
 {-# INLINE order #-}
 order :: (e -> e -> Ordering) -> e -> e -> (e, e)
 order cmp x y	| cmp x y == GT	= (y, x)
@@ -94,28 +70,33 @@
 
 {-# INLINE [2] fuseMerge #-}
 fuseMerge :: Monoid m => [MonoidQ m] -> MonoidQ m
-fuseMerge qs = let	merger (HQ size t) (IA n ts) = IA (n + size) (t:ts)
-			in case foldr merger (IA 0 []) qs of
-			IA n ts -> HQ n (fromMaybe mempty (fusing ts))
+fuseMerge qs = HQ (sum [n | HQ n _ <- qs]) (mconcat [t | HQ _ t <- qs])
 
-{-# INLINE fuseMergeM #-}
-fuseMergeM :: Monoid m => [HeapQ m] -> HeapQ m
+--{-# INLINE fuseMergeM #-}
+{-fuseMergeM :: Monoid m => [HeapQ m] -> HeapQ m
 fuseMergeM qs = let	merger (HQ size (Just t)) (IA n ts) = IA (n + size) (t:ts)
 			merger _ (IA n ts) = IA n ts
 			in case foldr merger (IA 0 []) qs of
 			IA n ts -> HQ n (fusing ts)
-
-{-# INLINE [0] unfoldFB #-}
-unfoldFB :: (b -> Maybe (a, b)) -> b -> (a -> c -> c) -> c -> c
+-}
+--{-# INLINE [0] unfoldFB #-}
+{-unfoldFB :: (b -> Maybe (a, b)) -> b -> (a -> c -> c) -> c -> c
 unfoldFB suc s0 c nil = unfold' s0 where
 	unfold' s = case suc s of
 		Nothing	-> nil
-		Just (x, s') -> x `c` unfold' s'
+		Just (x, s') -> x `c` unfold' s'-}
 
+{-# INLINE unfoldList #-}
+unfoldList :: (b -> (a, [b])) -> b -> [a]
+unfoldList branch root = build (\ c n -> unfoldToList c n branch root)
+	where	unfoldToList cons nil branch root = unfold' root nil where
+			unfold' (branch -> (x, ts)) nil = x `cons` foldr unfold' nil ts
+
+
 {-# RULES
 	"[] ++" forall l . [] ++ l = l;
 	"++ []" forall l . l ++ [] = l;
-	"fuseMerge/HeapQ" forall (qs :: Monoid m => [MonoidQ (Maybe m)]) . fuseMerge qs = fuseMergeM qs;
+--	"fuseMerge/HeapQ" forall (qs :: Monoid m => [MonoidQ (Maybe m)]) . fuseMerge qs = fuseMergeM qs;
 --	"unfold" [~1] forall suc s0 . unfoldr suc s0 = build (unfoldrFB suc s0)
 	#-}
 
diff --git a/Data/Queue/TrieQueue.hs b/Data/Queue/TrieQueue.hs
--- a/Data/Queue/TrieQueue.hs
+++ b/Data/Queue/TrieQueue.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeFamilies, PatternGuards #-}
+{-# LANGUAGE TypeFamilies, PatternGuards, GeneralizedNewtypeDeriving #-}
 
 -- | @TrieQueue e@ is a priority queue @IQueue@ instance satisfying @QueueKey (TrieQueue e) ~ [e]@, with the property that this queue frequently performs better than any other queue
 -- implementation in this package for keys of type @[e]@.  
@@ -11,14 +11,16 @@
 
 import Control.Arrow((***))
 import Control.Monad
-import Data.Monoid
+import Data.Semigroup
+--import Data.Monoid
 import Data.Maybe
 
 import Data.Queue.Class
-import Data.Queue.QueueHelpers(fusing')
+import Data.Queue.QueueHelpers
 
-import Data.Queue.TrieQueue.Edge
-import Data.Queue.TrieQueue.MonoidQueue
+import Data.Queue.Fuse.PHeap
+--import Data.Queue.TrieQueue.Edge
+--import Data.Queue.TrieQueue.MonoidQueue
 import Data.Queue.TrieQueue.TrieLabel
 
 import GHC.Exts
@@ -28,7 +30,7 @@
 -- On the back end it uses something called a /monoid queue/,
 -- which takes ordered keys associated with monoid values and returns (k, m') pairs where m' is the concatenation of every monoid value associated with k,
 -- with no guarantees made upon the order of the concatenation.  Essentially, it is a priority queue which internally "merges" values with equal keys.
--- See Data.Queue.TrieQueue.MonoidQueue for details and a list of alternative implementations.
+-- See Data.Queue.Fuse.PHeap for details and a list of alternative implementations.
 
 -- After some experimentation, trie edge labels are currently implemented as vanilla lists; however, the implementation is modularized in
 -- Data.Queue.TrieQueue.EdgeLabel.  (Other possible implementations include mergeable deques and Data.Sequence finger trees.)
@@ -38,20 +40,19 @@
 -- random-access string lookup is not required in a priority queue: only extract-min and insert, operations perfectly well suited to a monoid queue.
 -- Note that the monoid values in the monoid queue are themselves tries, which get recursively merged as necessary.
 
-data Trie e = Trie (Label e) {-# UNPACK #-} !Int (MQueue e (Trie e)) deriving (Show)
-data TrieQueue e = TQ Int (Maybe (Trie e)) deriving (Show)
+data Trie e = Trie (Label e) {-# UNPACK #-} !Int (FusePHeap e (Trie e)) deriving (Show)
+newtype TrieQueue e = TQ (HeapQ (Trie e)) deriving (Monoid, Show)
 
 -- This monoid instance can now get exploited for great justice by the monoid queue.
-instance Ord e => Monoid (Trie e) where
-	mempty = Trie mempty 0 mempty
-	mappend = mergeTrie
-	mconcat = fromMaybe mempty . mergeTries
+instance Ord e => Semigroup (Trie e) where
+	sappend = mergeTrie
+	sconcat = mergeTries
 
-{-# INLINE forceOrd #-}
-forceOrd :: Ord e => Trie e -> x -> x
+--{-# INLINE forceOrd #-}
+{-forceOrd :: Ord e => Trie e -> x -> x
 forceOrd t x = cmp t `seq` x where
 	cmp :: Ord e => Trie e -> (e -> e -> Ordering)
-	cmp _ = compare
+	cmp _ = compare-}
 
 catTrie :: Ord e => Label e -> Trie e -> Trie e
 xs `catTrie` Trie ys yn yQ = Trie (xs `mappend` ys) yn yQ
@@ -59,32 +60,34 @@
 consTrie :: Ord e => e -> Trie e -> Trie e
 x `consTrie` Trie xs xn xQ = Trie (x `cons` xs) xn xQ
 
-mergeTrie :: Ord e => Trie e -> Trie e -> Trie e
+mergeTrie :: Ord e => Endo (Trie e)
 xT@(Trie xs0 xn xQ) `mergeTrie` yT@(Trie ys0 yn yQ) = merging xs0 ys0 split (tail xT yT) (tail yT xT) xy where
-	end (Trie _ xn xQ) x xs = x :- Trie xs xn xQ
+	end (Trie _ xn xQ) x xs = (x, Trie xs xn xQ)
 	split pfx x xs y ys = let xEnd = end xT x xs; yEnd = end yT y ys in Trie pfx 0 (xEnd `insert` singleton yEnd)
 	tail (Trie xs xn xQ) yT y ys = let yEnd = end yT y ys in Trie xs xn (yEnd `insert` xQ)
 	xy = Trie xs0 (xn + yn) (xQ `merge` yQ)
 
-{-# INLINE compactTrie #-}
+--{-# INLINE compactTrie #-}
 compactTrie :: Ord e => Trie e -> Maybe (Trie e)
 compactTrie (Trie xs 0 xQ)
 	| null xQ	= Nothing
-	| Just (y :- t) <- extractSingle xQ
+	| Just (y, t) <- extractSingle xQ
 			= Just (xs `catTrie` (y `consTrie` t))
 compactTrie t = Just t
 
-data Acc e = A {-# UNPACK #-} !Int e
+data Acc e f = A {-# UNPACK #-} !Int e f
 
 -- Note that a monoid queue is built up and (sometimes) torn down for each character.  If every label on every trie being merged matches
 -- on the first character, then the monoid queue simply automatically becomes a singleton, a case handled by compactTrie with a specialized
 -- implementation based on extractSingle.  If the labels do not match, or there are tries being merged with empty labels,
 -- then the monoid queue is exactly what we needed anyway.
-mergeTries :: Ord e => [Trie e] -> Maybe (Trie e)
-mergeTries ts0 = compactTrie (Trie mempty nEmpty ([x :- Trie xs xn xQ | Trie (x:xs) xn xQ <- ts0] `insertAll` mergeAll qs))
-	where	A nEmpty qs = foldr procEmpty (A 0 []) ts0
-		procEmpty (Trie [] n q) (A nEmpty qs) = A (n + nEmpty) (q:qs)
-		procEmpty _ acc = acc 
+mergeTries :: Ord e => Fusion (Trie e)
+mergeTries ts0 = compactTrie (Trie mempty nEmpty (combine es qs))
+	where	combine es qs = es `insertAll` mergeAll qs
+		A nEmpty qs es = foldl procEmpty (A 0 [] []) ts0
+		A nEmpty qs es `procEmpty` Trie xs n q = case uncons xs of
+			Nothing	-> A (n + nEmpty) (q:qs) es
+			Just (x, xs) -> A nEmpty qs ((x, Trie xs n q):es)
 --mergeTries = fusing' mergeTrie
 
 {-# INLINE fin #-}
@@ -98,35 +101,35 @@
 extractTrie :: Ord e => Trie e -> (Label e, Maybe (Trie e))
 extractTrie (Trie xs (n+1) xQ) = (xs, inline compactTrie (Trie xs n xQ))
 extractTrie (Trie xs 0 xQ)
-	| Just (y :- t, xQ') <- extract xQ, (ys, t') <- extractTrie t
+	| Just (y, t) <- top xQ, (ys, t') <- extractTrie t
 		= (xs `mappend` (y `cons` ys), case t' of
-			Nothing	-> inline compactTrie (Trie xs 0 xQ')
-			Just t'	-> fin (Trie xs 0 $ replace (y :- t') xQ))
+			Nothing	-> delete xQ >>= inline compactTrie . Trie xs 0
+			Just t'	-> Just (Trie xs 0 $ replace t' xQ))
 extractTrie _ = error "Failure to detect empty queue"
 
-instance Ord e => Monoid (TrieQueue e) where
-	mempty = TQ 0 Nothing
-	TQ n1 t1 `mappend` TQ n2 t2 = TQ (n1 + n2) (t1 `mappend` t2)
-	mconcat ts = TQ (sum [n | TQ n _ <- ts]) (mergeTries [t | TQ _ (Just t) <- ts])
-
 instance Ord e => IQueue (TrieQueue e) where
 	type QueueKey (TrieQueue e) = [e]
 	empty = mempty
 	merge = mappend
 	mergeAll = mconcat
 	
-	singleton = TQ 1 . Just . single
+	singleton = TQ . HQ 1 . pJust . single
 	insertAll = mappend . fromListTrie
 	fromList = fromListTrie
 
-	extract (TQ n t) = fmap ((labelToList *** TQ (n-1)) . extractTrie) t
-	null (TQ _ Nothing) = True
+	extract (TQ (HQ n (Pt t))) = fmap ((labelToList *** (TQ . HQ (n-1) . Pt)) . extractTrie) t
+	null (TQ (HQ _ (Pt Nothing))) = True
 	null _ = False
 
-	size (TQ n _) = n
+	size (TQ (HQ n _)) = n
 
+	toList (TQ (HQ _ (Pt t))) = maybe [] trieToList t where
+		trieToList (Trie xs xn xQ) = replicate xn xs ++ [xs ++ y:ys | (y, t) <- toList xQ, ys <- trieToList t]
+	toList_ (TQ (HQ _ (Pt t))) = maybe [] trieToList_ t where
+		trieToList_ (Trie xs xn xQ) = replicate xn xs ++ [xs ++ y:ys | (y, t) <- toList_ xQ, ys <- trieToList_ t]
+
 fromListTrie :: Ord e => [[e]] -> TrieQueue e
-fromListTrie = liftM2 TQ length (mergeTries . map single)
+fromListTrie = TQ . liftM2 HQ length (Pt . mergeTries . map single)
 
 single :: Ord e => [e] -> Trie e
-single xs = Trie (labelFromList xs) 1 mempty
+single xs = Trie (labelFromList xs) 1 empty
diff --git a/Data/Queue/TrieQueue/Edge.hs b/Data/Queue/TrieQueue/Edge.hs
deleted file mode 100644
--- a/Data/Queue/TrieQueue/Edge.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-{-# LANGUAGE TypeFamilies, TypeOperators #-}
-
--- | As simple as it looks: an edge type constructor that performs comparisons only on its key.
-module Data.Queue.TrieQueue.Edge ((:-)(..)) where
-
-data k :- m = k :- m deriving (Show)
-
-instance Eq k => Eq (k :- m) where
-	(x :- _) == (y :- _) = x == y
-
-instance Ord k => Ord (k :- m) where
-	(x :- _) `compare` (y :- _) = x `compare` y
-	(x :- _) <= (y :- _) = x <= y
-
diff --git a/Data/Queue/TrieQueue/MonoidQueue.hs b/Data/Queue/TrieQueue/MonoidQueue.hs
deleted file mode 100644
--- a/Data/Queue/TrieQueue/MonoidQueue.hs
+++ /dev/null
@@ -1,111 +0,0 @@
-{-# LANGUAGE TypeFamilies, TypeOperators, PatternGuards #-}
-{-# OPTIONS -fno-warn-missing-methods #-}
-
-{- |
-This module implements the functionality of a /monoid queue/, which is essentially a priority queue that merges values with equal keys.  Several implementations were considered:
-
-* A pairing heap which, as part of its merging operation, merges any identical-keyed values it encounters.  This may result in partial merging of equal-keyed values for several different keys
-	during a single delete-min operation, decreasing the number of nodes in the queue without costing any additional comparisons.  In addition, it naturally falls out that
-	the values associated with the minimum key are always fully merged.  Disadvantages include no control over the balancedness of complete merges, and possible extra polymorphism overhead.
-* This considerably simpler bootstrap on a vanilla @PQueue@, which keeps the totally merged value associated with its very minimum key and performs no partial merging until a
-	key becomes the minimum. (The fact that no partial merging is performed allows an optimized and balanced 'mconcat' to be used on all the values associated with a key at once.)
-
-The primary difference between these two is the compromise between /performance of the heap itself/ and /performance of the merging of the monoids/:
-	* The first implementation speculatively takes advantage of opportunities to merge nodes with equal keys.  No actual extra work is being done -- the same number of comparisons
-		is made, and the actual merging is performed lazily.  As a result, truly the only disadvantages of this approach are the completely uncontrolled balance of the merges,
-		and possible polymorphism overhead that can be carefully hand-removed.
-	* The second implementation allows an optimized bulk merge operation, which -- in the case of tries, which is what after all the motivation for this structure --
-		has extremely significant advantages.
-
-A version of the second implementation is included with the Cabal distribution in 
-"Data.Queue.TrieQueue.MonoidQueue2", and can serve as a literal drop-in replacement for this module.
-See its implementation notes for further details.
-
--}
-module Data.Queue.TrieQueue.MonoidQueue (MQueue, extractSingle, replace) where
-
-import Data.Queue.Class
-import Data.Queue.QueueHelpers(fusing')
-import Data.Maybe
-import Data.Monoid
-import qualified Data.Tree as Tree
-
-import Data.Queue.TrieQueue.Edge
-
--- | A pairing heap node in the monoid queue; nonempty.
-data MNode k m = Node k m (MForest k m)
-type MForest k m = [MNode k m]
--- | A full-fledged priority queue, including empty queues.
-newtype MQueue k m = MQ (Maybe (MNode k m)) deriving (Show)
-
-instance (Show k, Show m) => Show (MNode k m) where
-	show = Tree.drawTree . Tree.unfoldTree (\ (Node k m ts) -> (show (k :- m), ts))
-
--- | A @Functor@ instance exploited for great justice in @mergeNodes@.
-instance Functor (MNode k) where
-	fmap f (Node k m ns) = Node k (f m) (map (fmap f) ns)
-
-instance (Ord k, Monoid m) => Monoid (MNode k m) where
-	-- no mempty declaration
-	mappend = mergeMNode $! mappend
-
-instance (Ord k, Monoid m) => Monoid (MQueue k m) where
-	mempty = MQ Nothing
-	MQ n1 `mappend` MQ n2 = MQ (n1 `mappend` n2)
-	 -- This is the straightforward implementation:
-	 -- mconcat qs = MQ $ fusing [n | MQ (Just n) <- qs]
-	 -- This implementation allows optimized mass mconcats rather than just using individual mappends,
-	 -- and exploits the flexible monoid structure.
-	mconcat qs = mergeNodes [n | MQ (Just n) <- qs]
-
-
-mergeMNode :: Ord k => (m -> m -> m) -> MNode k m -> MNode k m -> MNode k m
-mergeMNode (><) n1@(Node k1 m1 ns1) n2@(Node k2 m2 ns2) = case compare k1 k2 of
-	LT	-> Node k1 m1 (n2:ns1)
-	EQ	-> Node k1 (m1 >< m2) (ns1 ++ ns2)
-	GT	-> Node k2 m2 (n1:ns2)
-
-{-# INLINE mergeNodes' #-}
--- | Merges a collection of nodes by performing a balanced fuse and performing an mconcat on all blocks of equal-keyed monoid values.
-mergeNodes' :: (Ord k) => (k -> k -> Ordering) -> (m -> m -> m) -> MForest k m -> MQueue k m
---mergeNodes ns = MQ (fmap (fmap mconcat) $ fusing (map (fmap $ \ m -> [m]) ns))
-mergeNodes' _ (><) = MQ . fusing' (mergeMNode (><))
-
-{-# INLINE mergeNodes #-}
-mergeNodes :: (Ord k, Monoid m) => MForest k m -> MQueue k m
-mergeNodes = (mergeNodes' $! compare) $! mappend
-
-instance (Ord k, Monoid m) => IQueue (MQueue k m) where
-	type QueueKey (MQueue k m) = k :- m
-	empty = mempty
-	merge = mappend
-	mergeAll = mconcat
-
-	singleton (k :- m) = MQ (Just (Node k m []))
-	insertAll = merge . fromListMQ
-	fromList = fromListMQ
-	extract = extractMQ
-
-	null (MQ Nothing) = True
-	null _ = False
-
-{-# INLINE single #-}
-single :: k :- m -> MNode k m
-single (k :- m) = Node k m []
-
-extractMQ :: (Ord k, Monoid m) => MQueue k m -> Maybe (k :- m, MQueue k m)
-extractMQ (MQ t) = fmap extract' t where
-	extract' (Node k m ns) = (k :- m, mergeNodes ns)
-
-fromListMQ :: (Ord k, Monoid m) => [k :- m] -> MQueue k m
-fromListMQ ks = mergeNodes $ map single ks
-
-{-# INLINE extractSingle #-}
-extractSingle :: (Ord k, Monoid m) => MQueue k m -> Maybe (k :- m)
-extractSingle (MQ (Just (Node k m []))) = Just (k :- m)
-extractSingle _ = Nothing
-
--- UNSAFE.  Do not use unless you know the key you're putting in is less than or equal to the minimum key.
-replace :: (Ord k, Monoid m) => (k :- m) -> MQueue k m -> MQueue k m
-replace km@(k :- m) (MQ t) = MQ $ Just (maybe (single km) (\ (Node _ _ ns) -> Node k m ns) t)
-
diff --git a/Data/Queue/TrieQueue/MonoidQueue2.hs b/Data/Queue/TrieQueue/MonoidQueue2.hs
deleted file mode 100644
--- a/Data/Queue/TrieQueue/MonoidQueue2.hs
+++ /dev/null
@@ -1,84 +0,0 @@
-{-# LANGUAGE TypeFamilies, TypeOperators, PatternGuards #-}
-
-module Data.Queue.TrieQueue.MonoidQueue2 (MQueue, extractSingle, replace) where
-
-import Data.Queue.PQueue
-import Data.Queue.Class
-import Data.Queue.QueueHelpers (fusing, fusing')
-
-import Data.Queue.TrieQueue.Edge
-
-import Data.Maybe
-import Data.Monoid
-import Prelude hiding (null)
-
-data MQueue k m = Nil | MQ {-# UNPACK #-} !(k :- m) {-# UNPACK #-} !(PQueue (k :- m)) deriving (Show)
-
-instance (Ord k, Monoid m) => Monoid (MQueue k m) where
-	mempty = Nil
-	mappend = mergeMQ
-{-
-Here we organize on the queues themselves.  We require that fromList not be defined in terms of mergeAll, of course -- in fact, if it is defined using toQueue as it is below,
-this gives us the best of both worlds -- balanced merging both on the values associated with the minimum key (provided by fromList), and balanced merging on the remaining queues.
-We lose some partial merging opportunities, but this implementation does none, so that's not an issue.
--}
-	mconcat qs = case mkMQueue [k :- (m, q) | MQ (k :- m) q <- qs] of
-		Nil	-> Nil
-		MQ (k :- (m, pq)) qOfMQs -> 
-			let q' = pq `merge` mergeAll 
-					[(k :- m) `insert` q | k :- (m, q) <- toList_ qOfMQs]
-				in MQ (k :- m) q'
-		where	mkMQueue :: (Ord k, Monoid m) => [k :- m] -> MQueue k m
-			mkMQueue = fromList
-
---	mconcat = fromMaybe Nil . fusing' mergeMQ
-
-mergeMQ' :: Ord k => (k -> k -> Ordering) -> (m -> m -> m) -> MQueue k m -> MQueue k m -> MQueue k m
-mergeMQ' cmp (><) (MQ x1@(k1 :- m1) q1) (MQ x2@(k2 :- m2) q2) = case cmp k1 k2 of
-	LT	-> MQ x1 (x2 `insert` q)
-	EQ	-> MQ (k1 :- (m1 >< m2)) q
-	GT	-> MQ x2 (x1 `insert` q)
-	where	q = q1 `merge` q2
-mergeMQ' _ _ q Nil = q
-mergeMQ' _ _ Nil q = q
-
-mergeMQ :: (Ord k, Monoid m) => MQueue k m -> MQueue k m -> MQueue k m
-mergeMQ = mergeMQ' compare mappend
-
-instance (Ord k, Monoid m) => IQueue (MQueue k m) where
-	type QueueKey (MQueue k m) = (k :- m)
-	empty = Nil
-	singleton = (`MQ` empty)
-	fromList = toQueue . fromList
-
-	merge = mappend
-	mergeAll = mconcat
-
-	null Nil = True
-	null _ = False
-	
-	extract Nil = Nothing
-	extract (MQ x q) = Just (x, toQueue q)
-
-	toList_ Nil = []
-	toList_ (MQ x q) = x:toList_ q
-
--- This version ignores balancing and does a totally simple merge on values with the minimal key in common.
-toQueue :: (Ord k, Monoid m) => PQueue (k :- m) -> MQueue k m
-toQueue q = case extract q of
-	Nothing		-> Nil
-	Just (k :- m, q') -> let toQueue' ms q = case extract q of	Just (k' :- m', q')
-										| k == k'	-> toQueue' (m':ms) q'
---									_			-> MQ (k :- maybe m (mappend m) (fusing ms)) q
-									_	| [] <- ms	-> MQ (k :- m) q
-										| otherwise	-> MQ (k :- (m `mappend` mconcat ms)) q
-					in toQueue' [] q'
-
-extractSingle :: Ord k => MQueue k m -> Maybe (k :- m)
-extractSingle (MQ x q)
-	| null q	= Just x
-extractSingle _ = Nothing
-
-replace :: (Ord k, Monoid m) => (k :- m) -> MQueue k m -> MQueue k m
-replace (k :- m) (MQ _ q) = MQ (k :- m) q
-replace _ Nil = error "Attempt to modify head of an empty queue"
diff --git a/Data/Queue/TrieQueue/TrieLabel.hs b/Data/Queue/TrieQueue/TrieLabel.hs
--- a/Data/Queue/TrieQueue/TrieLabel.hs
+++ b/Data/Queue/TrieQueue/TrieLabel.hs
@@ -17,20 +17,23 @@
 
 {-# INLINE merging #-}
 -- | Performs partial matching of two labels and applies an appropriate function upon completing a partial match.
-merging :: Eq e => Label e		-- ^ A label, @xs@.
-			-> Label e	-- ^ A label, @ys@.
-			-> Split e x	-- ^ A function to be applied when the two strings share some (possibly empty) common prefix and mismatchng tails.
-			-> Tail e x	-- ^ A function to be applied when @xs@ is a prefix of @ys@.
-			-> Tail e x 	-- ^ A function to be applied when @ys@ is a prefix of @xs@.
-			-> x		-- ^ A value to be returned when @xs == ys@.
+merging :: Eq e => Label e		-- A label, @xs@.
+			-> Label e	-- A label, @ys@.
+			-> Split e x	-- A function to be applied when the two strings share some (possibly empty) common prefix and mismatchng tails.
+			-> Tail e x	-- A function to be applied when @xs@ is a prefix of @ys@.
+			-> Tail e x 	-- A function to be applied when @ys@ is a prefix of @xs@.
+			-> x		-- A value to be returned when @xs == ys@.
 			-> x
 
 cons :: e -> Label e -> Label e
+{-# INLINE uncons #-}
+uncons :: Label e -> Maybe (e, Label e)
 
 labelToList :: Label e -> [e]
 
 labelFromList :: [e] -> Label e
 
+
 merging xs0 ys0 split xEnd yEnd xy = merging' 0 xs0 ys0 where
 	merging' n xs ys = let pfx = take n xs0 in case (xs, ys) of
 		(x:xs, y:ys)	| x == y	-> merging' (n+1) xs ys
@@ -41,10 +44,17 @@
 type Label e = [e]
 
 cons = (:)
+
+uncons [] = Nothing
+uncons (x:xs) = Just (x,xs)
+
 labelToList = id
 labelFromList = id
+
+
 {-
 
+
 type Label e = Seq e
 
 merging xs0 ys0 split xEnd yEnd xy = merging' 0 (Fold.toList xs0) (Fold.toList ys0) where
@@ -55,15 +65,22 @@
 		([], y:ys)			-> xEnd y yT
 		([], [])			-> xy
 
+uncons xs = case viewl xs of
+	x :< xs	-> Just (x, xs)
+	EmptyL	-> Nothing
+
 cons = (<|)
 
 labelToList = Fold.toList
 
 labelFromList = Seq.fromList
--}
 
+
 testMerging :: (Eq e, Show e) => Label e -> Label e -> String
 testMerging xs0 ys0 = merging xs0 ys0 (\ pfx x xs y ys -> "Split " ++ show pfx ++ " (" ++ show x ++ " -> " ++ show xs ++ ") (" ++ show y ++ " -> " ++ show ys ++ ")")
 				(\ y ys -> "Break " ++ show xs0 ++ " = " ++ show y ++ " -> " ++ show ys)
 				(\ x xs -> "Break " ++ show ys0 ++ " = " ++ show x ++ " -> " ++ show xs)
 				("Equal " ++ show xs0)
+
+
+-}
diff --git a/Data/Semigroup.hs b/Data/Semigroup.hs
new file mode 100644
--- /dev/null
+++ b/Data/Semigroup.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE MagicHash, UnboxedTuples, GeneralizedNewtypeDeriving, FlexibleInstances, UndecidableInstances, OverlappingInstances #-}
+
+module Data.Semigroup (Monoid(..), Endo, Fusion, Point(..), Semigroup(..), endoMaybe, endoPoint, fusing', fusing, fuseCat, scatPoints', scatPoints, pJust, pNothing) where
+
+import Data.Monoid(Monoid(..))
+import Data.Maybe
+import GHC.Exts
+
+type Endo a = a -> a -> a
+type Fusion a = [a] -> Maybe a
+newtype Point a = Pt (Maybe a) deriving (Functor, Eq, Show, Read)
+
+class Semigroup a where
+	sappend :: Endo a
+	sconcat :: Fusion a
+	sconcat = fusing
+	sconcat_ :: a -> [a] -> a
+	sconcat_ x xs = fromJust (sconcat (x:xs))
+
+instance Monoid a => Semigroup a where
+	sappend = mappend
+	sconcat = Just . mconcat
+	sconcat_ x xs = mconcat (x:xs)
+
+{-instance Semigroup a => Semigroup (Maybe a) where
+	sappend = endoMaybe sappend
+	sconcat xs = Just (sconcat [x | Just x <- xs])-}
+
+instance Semigroup a => Monoid (Point a) where
+	mempty = Pt Nothing
+	mappend = endoPoint sappend
+	mconcat = Pt . scatPoints
+
+{-# INLINE [1] endoMaybe #-}
+endoMaybe :: Endo a -> Endo (Maybe a)
+endoMaybe (><) (Just a) = Just . maybe a (a ><)
+endoMaybe _ Nothing = id
+
+{-# RULES "endoMaybe/Just" forall f a b . endoMaybe f a (Just b) = Just (maybe b (`f` b) a) #-}
+
+{-# INLINE endoPoint #-}
+endoPoint :: Endo a -> Endo (Point a)
+endoPoint (><) (Pt a) (Pt b) = Pt (endoMaybe (><) a b)
+
+fusing' :: Endo a -> Fusion a
+fusing' _ [] = Nothing
+fusing' (><) (q:qs) = Just $ fuseCat (><) q qs
+
+fuseCat :: Endo a -> a -> [a] -> a
+fuseCat (><) = fuseCat' where
+	fuseCat' x [] = x
+	fuseCat' x xs = case fuse1 x xs of ( x', xs' ) -> fuseCat' x' xs'
+	fuse1 x1 (x2:x3:x4:xs) = ( (x1 >< x2) >< (x3 >< x4), fuser xs )
+	fuse1 x1 [x2,x3] = ( x1 >< x2 >< x3, [] )
+	fuse1 x1 [x2] = ( x1 >< x2, [] )
+	fuse1 x1 [] = ( x1, [] )
+	fuser [] = []
+	fuser (x:xs) = case fuse1 x xs of ( x, xs ) -> x:xs
+
+fusing :: Semigroup a => Fusion a
+fusing = fusing' sappend
+
+{-# INLINE scatPoints' #-}
+scatPoints' :: Fusion a -> [Point a] -> Maybe a
+scatPoints' cat xs = cat [x | Pt (Just x) <- xs]
+
+{-# INLINE scatPoints #-}
+scatPoints :: Semigroup a => [Point a] -> Maybe a
+scatPoints = scatPoints' sconcat
+
+pJust :: a -> Point a
+pJust = Pt . Just
+
+pNothing :: Point a
+pNothing = Pt Nothing
diff --git a/queuelike.cabal b/queuelike.cabal
--- a/queuelike.cabal
+++ b/queuelike.cabal
@@ -1,5 +1,5 @@
 name:		queuelike
-version:	1.0.6
+version:	1.0.7
 synopsis:	A library of queuelike data structures, both functional and stateful.
 description:	Contains several implementations of data structures implementing a /single-in, single-out/ paradigm.  Intended to be a better, more useful replacement for pqueue-mtl.
 		In particular, includes an experimental and possibly genuinely new trie-based priority queue on strings.  Feedback is appreciated.
@@ -27,11 +27,21 @@
 	Data.MQueue.Chan
 	Data.MQueue
 other-modules: 
+	Data.Semigroup
 	Data.Queue.QueueHelpers
-	Data.Queue.TrieQueue.Edge
-	Data.Queue.TrieQueue.MonoidQueue
+--	Data.Queue.TrieQueue.Edge
+--	Data.Queue.TrieQueue.MonoidQueue
+	Data.Queue.Fuse.PHeap
+--	Data.Queue.Fuse.PHeap2
+--	Data.Queue.Fuse.SkewHeap
+--	Data.Queue.Fuse.SplitList
 	Data.Queue.TrieQueue.TrieLabel
 	Data.MQueue.MonadHelpers
 extra-source-files:
-	Data/Queue/TrieQueue/MonoidQueue2.hs
+--	Data/Queue/TrieQueue/MonoidQueue2.hs
+-- various implementations of fusing queues
+	Data/Queue/Fuse/PHeap2.hs
+	Data/Queue/Fuse/Vanilla.hs
+	Data/Queue/Fuse/SkewHeap.hs
+	Data/Queue/Fuse/Map.hs
 ghc-options: