Map.hs

{-# 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)