module Data.Queue.Class
(Queue(..)
,MeldableQueue(..)
,showsPrecQueue
,readPrecQueue
,eqQueue
,cmpQueue)
where
import Data.List (unfoldr)
import Data.Function (on)
import Data.Coerce (Coercible,coerce)
import Data.Set (Set)
import qualified Data.Set as Set
class Queue h a where
minView
:: h a -> Maybe (a, h a)
insert
:: a -> h a -> h a
empty
:: h a
singleton
:: a -> h a
singleton = flip insert empty
toList :: h a -> [a]
toList = unfoldr minView
fromList :: [a] -> h a
fromList = foldr insert empty
heapSort :: p h -> [a] -> [a]
heapSort (_ :: p h) = toList . (fromList :: [a] -> h a)
class Queue h a => MeldableQueue h a where
merge :: h a -> h a -> h a
fromFoldable :: (Foldable f) => f a -> h a
fromFoldable = runQueueWrapper #. foldMap (QueueWrapper #. singleton)
newtype QueueWrapper h a = QueueWrapper
{ runQueueWrapper :: h a
}
instance MeldableQueue h a =>
Monoid (QueueWrapper h a) where
mempty = QueueWrapper empty
mappend =
(coerce :: (h a -> h a -> h a) -> QueueWrapper h a -> QueueWrapper h a -> QueueWrapper h a)
merge
showsPrecQueue :: (Queue h a, Show a) => Int -> h a -> ShowS
showsPrecQueue d xs =
showParen (d >= 11) (showString "fromList " . showList (toList xs))
readPrecQueue
:: (Read a, Queue h a) => Int -> ReadS (h a)
readPrecQueue d =
readParen
(d > 10)
(\xs ->
[ (fromList x, zs)
| ("fromList",ys) <- lex xs
, (x,zs) <- readList ys ])
eqQueue :: (Eq a, Queue h a) => h a -> h a -> Bool
eqQueue = (==) `on` toList
cmpQueue :: (Ord a, Queue h a) => h a -> h a -> Ordering
cmpQueue = compare `on` toList
infixr 9 #.
(#.) :: Coercible b c => (b -> c) -> (a -> b) -> a -> c
(#.) _ = coerce
instance Ord a => Queue Set a where
insert = Set.insert
empty = Set.empty
fromList = Set.fromList
singleton = Set.singleton
minView = Set.minView
toList = Set.toList
instance Ord a => MeldableQueue Set a where
merge = Set.union
instance Queue [] a where
insert = (:)
empty = []
fromList = id
singleton = (:[])
minView [] = Nothing
minView (x:xs) = Just (x,xs)
toList = id
instance MeldableQueue [] a where
merge = (++)
fromFoldable = foldr (:) []