{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
module Data.Semigroup.Union
    ( module Data.Semigroup.Reducer
    -- * Unions of Containers
    , HasUnion(..)
    , HasUnion0(..)
    , Union(Union,getUnion)
    -- * Unions of Containers of Semigroups
    , HasUnionWith(..)
    , HasUnionWith0(..)
    , UnionWith(UnionWith,getUnionWith)
    ) where

import qualified Data.HashMap.Lazy as HashMap
import Data.HashMap.Lazy (HashMap)

import qualified Data.IntMap as IntMap
import Data.IntMap (IntMap)

import qualified Data.IntSet as IntSet
import Data.IntSet (IntSet)

import qualified Data.HashSet as HashSet
import Data.HashSet (HashSet)

import qualified Data.Map as Map
import Data.Map (Map)

import qualified Data.Set as Set
import Data.Set (Set)

import qualified Data.List as List

import Data.Hashable
#if __GLASGOW_HASKELL__ < 710
import Data.Functor
import Data.Foldable
import Data.Traversable
#endif
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup
#endif
import Data.Semigroup.Foldable
import Data.Semigroup.Traversable
import Data.Semigroup.Reducer
import Data.Semigroup.Instances ()

-- | A Container suitable for the 'Union' 'Monoid'
class HasUnion f where
  union :: f -> f -> f

{-# SPECIALIZE union :: IntMap a -> IntMap a -> IntMap a #-}
{-# SPECIALIZE union :: Ord k => Map k a -> Map k a -> Map k a #-}
{-# SPECIALIZE union :: Eq a => [a] -> [a] -> [a] #-}
{-# SPECIALIZE union :: Ord a => Set a -> Set a -> Set a #-}
{-# SPECIALIZE union :: IntSet -> IntSet -> IntSet #-}
{-# SPECIALIZE union :: Eq a => HashSet a -> HashSet a -> HashSet a #-}
{-# SPECIALIZE union :: Eq k => HashMap k a -> HashMap k a -> HashMap k a #-}

class HasUnion f => HasUnion0 f where
  empty :: f

instance HasUnion (IntMap a) where
  union :: IntMap a -> IntMap a -> IntMap a
union = IntMap a -> IntMap a -> IntMap a
forall a. IntMap a -> IntMap a -> IntMap a
IntMap.union

instance HasUnion0 (IntMap a) where
  empty :: IntMap a
empty = IntMap a
forall a. IntMap a
IntMap.empty

instance (Eq k, Hashable k) => HasUnion (HashMap k a) where
  union :: HashMap k a -> HashMap k a -> HashMap k a
union = HashMap k a -> HashMap k a -> HashMap k a
forall k a.
(Eq k, Hashable k) =>
HashMap k a -> HashMap k a -> HashMap k a
HashMap.union

instance (Eq k, Hashable k) => HasUnion0 (HashMap k a) where
  empty :: HashMap k a
empty = HashMap k a
forall k v. HashMap k v
HashMap.empty

instance Ord k => HasUnion (Map k a) where
  union :: Map k a -> Map k a -> Map k a
union = Map k a -> Map k a -> Map k a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union

instance Ord k => HasUnion0 (Map k a) where
  empty :: Map k a
empty = Map k a
forall k a. Map k a
Map.empty

instance Eq a => HasUnion [a] where
  union :: [a] -> [a] -> [a]
union = [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
List.union

instance Eq a => HasUnion0 [a] where
  empty :: [a]
empty = []

instance Ord a => HasUnion (Set a) where
  union :: Set a -> Set a -> Set a
union = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union

instance Ord a => HasUnion0 (Set a) where
  empty :: Set a
empty = Set a
forall a. Set a
Set.empty

instance HasUnion IntSet where
  union :: IntSet -> IntSet -> IntSet
union = IntSet -> IntSet -> IntSet
IntSet.union

instance HasUnion0 IntSet where
  empty :: IntSet
empty = IntSet
IntSet.empty

instance (Eq a, Hashable a) => HasUnion (HashSet a) where
  union :: HashSet a -> HashSet a -> HashSet a
union = HashSet a -> HashSet a -> HashSet a
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
HashSet.union

instance (Eq a, Hashable a) => HasUnion0 (HashSet a) where
  empty :: HashSet a
empty = HashSet a
forall a. HashSet a
HashSet.empty


-- | The 'Monoid' @('union','empty')@
newtype Union f = Union { Union f -> f
getUnion :: f }
  deriving (Union f -> Union f -> Bool
(Union f -> Union f -> Bool)
-> (Union f -> Union f -> Bool) -> Eq (Union f)
forall f. Eq f => Union f -> Union f -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Union f -> Union f -> Bool
$c/= :: forall f. Eq f => Union f -> Union f -> Bool
== :: Union f -> Union f -> Bool
$c== :: forall f. Eq f => Union f -> Union f -> Bool
Eq,Eq (Union f)
Eq (Union f)
-> (Union f -> Union f -> Ordering)
-> (Union f -> Union f -> Bool)
-> (Union f -> Union f -> Bool)
-> (Union f -> Union f -> Bool)
-> (Union f -> Union f -> Bool)
-> (Union f -> Union f -> Union f)
-> (Union f -> Union f -> Union f)
-> Ord (Union f)
Union f -> Union f -> Bool
Union f -> Union f -> Ordering
Union f -> Union f -> Union f
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall f. Ord f => Eq (Union f)
forall f. Ord f => Union f -> Union f -> Bool
forall f. Ord f => Union f -> Union f -> Ordering
forall f. Ord f => Union f -> Union f -> Union f
min :: Union f -> Union f -> Union f
$cmin :: forall f. Ord f => Union f -> Union f -> Union f
max :: Union f -> Union f -> Union f
$cmax :: forall f. Ord f => Union f -> Union f -> Union f
>= :: Union f -> Union f -> Bool
$c>= :: forall f. Ord f => Union f -> Union f -> Bool
> :: Union f -> Union f -> Bool
$c> :: forall f. Ord f => Union f -> Union f -> Bool
<= :: Union f -> Union f -> Bool
$c<= :: forall f. Ord f => Union f -> Union f -> Bool
< :: Union f -> Union f -> Bool
$c< :: forall f. Ord f => Union f -> Union f -> Bool
compare :: Union f -> Union f -> Ordering
$ccompare :: forall f. Ord f => Union f -> Union f -> Ordering
$cp1Ord :: forall f. Ord f => Eq (Union f)
Ord,Int -> Union f -> ShowS
[Union f] -> ShowS
Union f -> String
(Int -> Union f -> ShowS)
-> (Union f -> String) -> ([Union f] -> ShowS) -> Show (Union f)
forall f. Show f => Int -> Union f -> ShowS
forall f. Show f => [Union f] -> ShowS
forall f. Show f => Union f -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Union f] -> ShowS
$cshowList :: forall f. Show f => [Union f] -> ShowS
show :: Union f -> String
$cshow :: forall f. Show f => Union f -> String
showsPrec :: Int -> Union f -> ShowS
$cshowsPrec :: forall f. Show f => Int -> Union f -> ShowS
Show,ReadPrec [Union f]
ReadPrec (Union f)
Int -> ReadS (Union f)
ReadS [Union f]
(Int -> ReadS (Union f))
-> ReadS [Union f]
-> ReadPrec (Union f)
-> ReadPrec [Union f]
-> Read (Union f)
forall f. Read f => ReadPrec [Union f]
forall f. Read f => ReadPrec (Union f)
forall f. Read f => Int -> ReadS (Union f)
forall f. Read f => ReadS [Union f]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Union f]
$creadListPrec :: forall f. Read f => ReadPrec [Union f]
readPrec :: ReadPrec (Union f)
$creadPrec :: forall f. Read f => ReadPrec (Union f)
readList :: ReadS [Union f]
$creadList :: forall f. Read f => ReadS [Union f]
readsPrec :: Int -> ReadS (Union f)
$creadsPrec :: forall f. Read f => Int -> ReadS (Union f)
Read)

instance HasUnion f => Semigroup (Union f) where
  Union f
a <> :: Union f -> Union f -> Union f
<> Union f
b = f -> Union f
forall f. f -> Union f
Union (f
a f -> f -> f
forall f. HasUnion f => f -> f -> f
`union` f
b)

instance HasUnion0 f => Monoid (Union f) where
#if !(MIN_VERSION_base(4,11,0))
  Union a `mappend` Union b = Union (a `union` b)
#endif
  mempty :: Union f
mempty = f -> Union f
forall f. f -> Union f
Union f
forall f. HasUnion0 f => f
empty

instance HasUnion f => Reducer f (Union f) where
  unit :: f -> Union f
unit = f -> Union f
forall f. f -> Union f
Union

instance Functor Union where
  fmap :: (a -> b) -> Union a -> Union b
fmap a -> b
f (Union a
a) = b -> Union b
forall f. f -> Union f
Union (a -> b
f a
a)

instance Foldable Union where
 foldMap :: (a -> m) -> Union a -> m
foldMap a -> m
f (Union a
a) = a -> m
f a
a

instance Traversable Union where
  traverse :: (a -> f b) -> Union a -> f (Union b)
traverse a -> f b
f (Union a
a) = b -> Union b
forall f. f -> Union f
Union (b -> Union b) -> f b -> f (Union b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a

instance Foldable1 Union where
  foldMap1 :: (a -> m) -> Union a -> m
foldMap1 a -> m
f (Union a
a) = a -> m
f a
a

instance Traversable1 Union where
  traverse1 :: (a -> f b) -> Union a -> f (Union b)
traverse1 a -> f b
f (Union a
a) = b -> Union b
forall f. f -> Union f
Union (b -> Union b) -> f b -> f (Union b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a

-- | Polymorphic containers that we can supply an operation to handle unions with
class Functor f => HasUnionWith f where
  unionWith :: (a -> a -> a) -> f a -> f a -> f a

{-# SPECIALIZE unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a #-}
{-# SPECIALIZE unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a #-}
{-# SPECIALIZE unionWith :: Eq k => (a -> a -> a) -> HashMap k a -> HashMap k a -> HashMap k a #-}

class HasUnionWith f => HasUnionWith0 f where
  emptyWith :: f a

instance HasUnionWith IntMap where
  unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
unionWith = (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IntMap.unionWith

instance HasUnionWith0 IntMap where
  emptyWith :: IntMap a
emptyWith = IntMap a
forall a. IntMap a
IntMap.empty

instance Ord k => HasUnionWith (Map k) where
  unionWith :: (a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWith = (a -> a -> a) -> Map k a -> Map k a -> Map k a
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith

instance Ord k => HasUnionWith0 (Map k) where
  emptyWith :: Map k a
emptyWith = Map k a
forall k a. Map k a
Map.empty

instance (Eq k, Hashable k) => HasUnionWith (HashMap k) where
  unionWith :: (a -> a -> a) -> HashMap k a -> HashMap k a -> HashMap k a
unionWith = (a -> a -> a) -> HashMap k a -> HashMap k a -> HashMap k a
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith

instance (Eq k, Hashable k) => HasUnionWith0 (HashMap k) where
  emptyWith :: HashMap k a
emptyWith = HashMap k a
forall k v. HashMap k v
HashMap.empty

-- | The 'Monoid' @('unionWith mappend','empty')@ for containers full of monoids.
newtype UnionWith f m = UnionWith { UnionWith f m -> f m
getUnionWith :: f m }

instance (HasUnionWith f, Semigroup m) => Semigroup (UnionWith f m) where
    UnionWith f m
a <> :: UnionWith f m -> UnionWith f m -> UnionWith f m
<> UnionWith f m
b = f m -> UnionWith f m
forall (f :: * -> *) m. f m -> UnionWith f m
UnionWith ((m -> m -> m) -> f m -> f m -> f m
forall (f :: * -> *) a.
HasUnionWith f =>
(a -> a -> a) -> f a -> f a -> f a
unionWith m -> m -> m
forall a. Semigroup a => a -> a -> a
(<>) f m
a f m
b)

instance (HasUnionWith0 f, Monoid m) => Monoid (UnionWith f m) where
    mempty :: UnionWith f m
mempty = f m -> UnionWith f m
forall (f :: * -> *) m. f m -> UnionWith f m
UnionWith f m
forall (f :: * -> *) a. HasUnionWith0 f => f a
emptyWith
#if !(MIN_VERSION_base(4,11,0))
    UnionWith a `mappend` UnionWith b = UnionWith (unionWith mappend a b)
#endif

instance (HasUnionWith f, Semigroup m, Monoid m) => Reducer (f m) (UnionWith f m) where
    unit :: f m -> UnionWith f m
unit = f m -> UnionWith f m
forall (f :: * -> *) m. f m -> UnionWith f m
UnionWith