module Data.Queue.Pairing
(Pairing(..))
where
import Data.Queue.Class
import Control.DeepSeq (NFData(rnf))
import Data.Data (Data)
import Data.Typeable (Typeable)
import GHC.Generics (Generic, Generic1)
data Pairing a
= E
| T a [Pairing a]
deriving (Functor,Foldable,Traversable,Data,Typeable,Generic,Generic1)
instance Ord a => Monoid (Pairing a) where
mempty = E
mappend E ys = ys
mappend xs E = xs
mappend h1@(T x xs) h2@(T y ys)
| x <= y = T x (h2 : xs)
| otherwise = T y (h1 : ys)
instance Ord a => Queue Pairing a where
singleton a = T a []
insert = mappend . singleton
minView (T x hs) = Just (x, mergePairs hs)
minView E = Nothing
empty = mempty
instance Ord a => MeldableQueue Pairing a where
merge = mappend
mergePairs :: Ord a => [Pairing a] -> Pairing a
mergePairs [] = E
mergePairs [h] = h
mergePairs (h1 : h2 : hs) =
mappend (mappend h1 h2) (mergePairs hs)
instance NFData a =>
NFData (Pairing a) where
rnf E = ()
rnf (T x xs) = rnf x `seq` rnf xs
instance Ord a => Eq (Pairing a) where
(==) = eqQueue
instance Ord a => Ord (Pairing a) where
compare = cmpQueue
instance (Show a, Ord a) => Show (Pairing a) where
showsPrec = showsPrecQueue
instance (Read a, Ord a) => Read (Pairing a) where
readsPrec = readPrecQueue