associative-0.0.4: src/Data/Associative/PartialMonoidOp.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall -Werror #-}

-- |
-- A partial monoid operation is an associative binary operation with an identity
-- element that is not defined for all pairs of inputs.
module Data.Associative.PartialMonoidOp
  ( -- * Types
    PartialMonoidOpT (..),
    PartialMonoidOp,
    PartialMonoidOpT',
    PartialMonoidOp',

    -- * Isomorphisms
    iPartialMonoidOpT,
    iPartialMonoidOp,
    nonPartialMonoid,
    defaultMonoidOp,

    -- * Running
    runPartialMonoidOpT,
    runPartialMonoidOp,
    identityPartialMonoidOpT,
    identityPartialMonoidOp,

    -- * Smart constructors
    pmonoid,

    -- * Laws
    pmonoidLawAssociative,
    pmonoidLawLeftIdentity,
    pmonoidLawRightIdentity,

    -- * Classy optics
    HasPartialMonoidOpT (..),
    AsPartialMonoidOpT (..),

    -- * Values (via pmonoid)
    pmonoidUnit,
    pmonoidOrdering,
    pmonoidList,
    pmonoidProxy,
    pmonoidMaybe,
    pmonoidDual,
    pmonoidDown,
    pmonoidIdentity,
    pmonoidTuple,
    pmonoidWrappedMonoid,
    pmonoidFunction,
    pmonoidAlt,
    pmonoidAlternative,
    pmonoidLiftF2,
    pmonoidLiftA2,

    -- * Values (via PartialMonoidOpT)
    pmonoidMin,
    pmonoidMax,
    pmonoidAll,
    pmonoidAny,
    pmonoidAddition,
    pmonoidMultiplication,
    pmonoidEndo,
    pmonoidAnd,
    pmonoidIor,
    pmonoidXor,
    pmonoidIff,

    -- * Collection values
    pmonoidSetUnion,
    pmonoidIntSetUnion,
    pmonoidHashSetUnion,
    pmonoidMapUnion,
    pmonoidIntMapUnion,
    pmonoidHashMapUnion,
  )
where

import Control.Applicative (Alternative (..))
import Control.Lens
  ( Iso,
    Lens',
    Prism',
    iso,
    lens,
    review,
    view,
  )
import Data.Associative.MonoidOp (MonoidOp', MonoidOpT (..))
import Data.Associative.PartialSemigroupOp
  ( HasPartialSemigroupOpT (..),
    PartialSemigroupOpT,
    defaultSemigroupOpT,
    iPartialSemigroupOp,
    iPartialSemigroupOpT,
    nonPartialSemigroup,
    psemigroupDown,
    psemigroupDual,
    psemigroupFunction,
    psemigroupIdentity,
    psemigroupLawAssociative,
    psemigroupLiftA2,
    psemigroupMaybe,
    psemigroupSemigroup,
    psemigroupTuple,
    psemigroupWrappedMonoid,
    runPartialSemigroupOp,
    runPartialSemigroupOpT,
    total,
  )
import Data.Associative.SemigroupOp (SemigroupOp')
import Data.Bits (Bits, FiniteBits, complement, xor, zeroBits, (.&.), (.|.))
import Data.Functor.Alt (Alt (..))
import Data.Functor.Const (Const)
import Data.Functor.Identity (Identity (..))
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Data.Hashable (Hashable)
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Ord (Down (..))
import Data.Proxy (Proxy (..))
import Data.Semigroup (Dual (..), WrappedMonoid (..))
import Data.Set (Set)
import qualified Data.Set as Set
import GHC.Generics (Generic)

-- $setup
-- >>> import Data.Associative.SemigroupOp (SemigroupOp', op, semigroupList)
-- >>> import Data.Associative.MonoidOp (MonoidOpT(..), MonoidOp', monoidList, runMonoidOp, identityMonoidOp)
-- >>> import Data.Associative.PartialSemigroupOp (PartialSemigroupOpT(..), total)
-- >>> import Control.Lens (view, review)
-- >>> import Data.Functor.Identity (Identity(..))
-- >>> import Data.Ord (Down(..))
-- >>> import Data.Proxy (Proxy(..))
-- >>> import Data.Semigroup (Dual(..), WrappedMonoid(..))
-- >>> import Data.Word (Word8)
-- >>> import qualified Data.Set as Set
-- >>> import qualified Data.IntSet as IntSet
-- >>> import qualified Data.HashSet as HashSet
-- >>> import qualified Data.Map as Map
-- >>> import qualified Data.IntMap as IntMap
-- >>> import qualified Data.HashMap.Strict as HashMap
-- >>> import Data.List (sort)
-- >>> let add = PartialMonoidOpT (total (+)) 0 :: PartialMonoidOp' Int
-- >>> let run = runPartialMonoidOp
-- >>> let runT = runPartialMonoidOpT

-- | A partial monoid transformer. The wrapped operation must be associative
-- (see 'pmonoidLawAssociative') with an identity element.
--
-- >>> run add 3 4
-- Just 7
-- >>> identityPartialMonoidOp add
-- 0
data PartialMonoidOpT f a b i = PartialMonoidOpT (PartialSemigroupOpT f a b) i
  deriving (Generic)

-- | A partial monoid using 'Identity' as the base functor.
type PartialMonoidOp a b i = PartialMonoidOpT Identity a b i

-- | A partial monoid transformer where input, output, and identity types coincide.
type PartialMonoidOpT' f x = PartialMonoidOpT f x x x

-- | A partial monoid where input, output, and identity types coincide.
type PartialMonoidOp' x = PartialMonoidOp x x x

-- | Iso between 'PartialMonoidOpT' and its underlying function paired with identity.
--
-- >>> let (f, e) = view iPartialMonoidOpT add
-- >>> f 3 4
-- Identity (Just 7)
-- >>> e
-- 0
iPartialMonoidOpT :: Iso (PartialMonoidOpT f a b i) (PartialMonoidOpT f' a' b' i') (a -> a -> f (Maybe b), i) (a' -> a' -> f' (Maybe b'), i')
iPartialMonoidOpT =
  iso
    (\(PartialMonoidOpT s e) -> (runPartialSemigroupOpT s, e))
    (\(f, e) -> PartialMonoidOpT (review iPartialSemigroupOpT f) e)
{-# INLINE iPartialMonoidOpT #-}

-- | Iso between 'PartialMonoidOp' and a pure partial function paired with identity.
--
-- >>> let (f, e) = view iPartialMonoidOp add
-- >>> f 3 4
-- Just 7
-- >>> e
-- 0
iPartialMonoidOp :: Iso (PartialMonoidOp a b i) (PartialMonoidOp a' b' i') (a -> a -> Maybe b, i) (a' -> a' -> Maybe b', i')
iPartialMonoidOp =
  iso
    (\(PartialMonoidOpT s e) -> (runPartialSemigroupOp s, e))
    (\(f, e) -> PartialMonoidOpT (review iPartialSemigroupOp f) e)
{-# INLINE iPartialMonoidOp #-}

nonPartialMonoid :: Iso (PartialMonoidOpT (Const a) a a a) (PartialMonoidOpT (Const a') a' a' a') (MonoidOp' a) (MonoidOp' a')
nonPartialMonoid =
  iso
    (\(PartialMonoidOpT s e) -> MonoidOpT (view nonPartialSemigroup s) e)
    (\(MonoidOpT s e) -> PartialMonoidOpT (review nonPartialSemigroup s) e)
{-# INLINE nonPartialMonoid #-}

-- | Convert a partial monoid operation to a total one by providing a default
-- value for the undefined case.
--
-- >>> runMonoidOp (defaultMonoidOp 0 add) 3 4
-- 7
-- >>> identityMonoidOp (defaultMonoidOp 0 add)
-- 0
defaultMonoidOp :: a -> PartialMonoidOp' a -> MonoidOp' a
defaultMonoidOp x (PartialMonoidOpT s e) = MonoidOpT (defaultSemigroupOpT (Identity x) s) e
{-# INLINE defaultMonoidOp #-}

-- | Unwrap a 'PartialMonoidOpT' to run its underlying partial operation.
--
-- >>> runT add 3 4
-- Identity (Just 7)
runPartialMonoidOpT :: PartialMonoidOpT f a b i -> a -> a -> f (Maybe b)
runPartialMonoidOpT (PartialMonoidOpT s _) = runPartialSemigroupOpT s
{-# INLINE runPartialMonoidOpT #-}

-- | Run a 'PartialMonoidOp' (specialised to 'Identity').
--
-- >>> run add 3 4
-- Just 7
runPartialMonoidOp :: PartialMonoidOp a b i -> a -> a -> Maybe b
runPartialMonoidOp (PartialMonoidOpT s _) = runPartialSemigroupOp s
{-# INLINE runPartialMonoidOp #-}

-- | Extract the identity element from a 'PartialMonoidOpT'.
--
-- >>> identityPartialMonoidOpT add
-- 0
-- >>> identityPartialMonoidOpT pmonoidList
-- []
identityPartialMonoidOpT :: PartialMonoidOpT f a b i -> i
identityPartialMonoidOpT (PartialMonoidOpT _ e) = e
{-# INLINE identityPartialMonoidOpT #-}

-- | Extract the identity element from a 'PartialMonoidOp'.
--
-- >>> identityPartialMonoidOp add
-- 0
-- >>> identityPartialMonoidOp pmonoidList
-- []
identityPartialMonoidOp :: PartialMonoidOp a b i -> i
identityPartialMonoidOp (PartialMonoidOpT _ e) = e
{-# INLINE identityPartialMonoidOp #-}

-- | Build a 'PartialMonoidOp'' from any 'Monoid' instance.
--
-- >>> run (pmonoid :: PartialMonoidOp' [Int]) [1,2] [3,4]
-- Just [1,2,3,4]
-- >>> identityPartialMonoidOp (pmonoid :: PartialMonoidOp' [Int])
-- []
pmonoid :: (Monoid a) => PartialMonoidOp' a
pmonoid = PartialMonoidOpT psemigroupSemigroup mempty
{-# INLINE pmonoid #-}

-- | Classy lens giving access to the underlying 'PartialSemigroupOpT'.
--
-- >>> import Data.Associative.PartialSemigroupOp (runPartialSemigroupOp)
-- >>> runPartialSemigroupOp (view partialSemigroupOpT add) 3 4
-- Just 7
instance HasPartialSemigroupOpT (PartialMonoidOpT f a b i) f a b where
  partialSemigroupOpT = lens (\(PartialMonoidOpT s _) -> s) (\(PartialMonoidOpT _ e) s' -> PartialMonoidOpT s' e)

{- HLINT ignore "Monoid law, left identity" -}
{- HLINT ignore "Monoid law, right identity" -}

----
-- Law-checking functions
----

-- | Associativity of the partial monoid operation.
--
-- Left- and right-association of three values must agree:
-- both 'Nothing' or both the same 'Just'.
--
-- >>> runIdentity $ pmonoidLawAssociative add 1 2 3
-- True
pmonoidLawAssociative :: (Monad f, Eq a) => PartialMonoidOpT' f a -> a -> a -> a -> f Bool
pmonoidLawAssociative (PartialMonoidOpT s _) = psemigroupLawAssociative s

-- | Left identity: @f e a == Just a@
--
-- >>> runIdentity $ pmonoidLawLeftIdentity add 42
-- True
-- >>> runIdentity $ pmonoidLawLeftIdentity pmonoidList [1,2,3 :: Int]
-- True
pmonoidLawLeftIdentity :: (Monad f, Eq a) => PartialMonoidOpT' f a -> a -> f Bool
pmonoidLawLeftIdentity m a = do
  r <- runPartialMonoidOpT m (identityPartialMonoidOpT m) a
  pure (r == Just a)

-- | Right identity: @f a e == Just a@
--
-- >>> runIdentity $ pmonoidLawRightIdentity add 42
-- True
-- >>> runIdentity $ pmonoidLawRightIdentity pmonoidList [1,2,3 :: Int]
-- True
pmonoidLawRightIdentity :: (Monad f, Eq a) => PartialMonoidOpT' f a -> a -> f Bool
pmonoidLawRightIdentity m a = do
  r <- runPartialMonoidOpT m a (identityPartialMonoidOpT m)
  pure (r == Just a)

-- | Classy lens for types that contain a 'PartialMonoidOpT'.
--
-- >>> run (view partialMonoidOpT add) 3 4
-- Just 7
class HasPartialMonoidOpT c f a b i | c -> f a b i where
  partialMonoidOpT :: Lens' c (PartialMonoidOpT f a b i)

instance HasPartialMonoidOpT (PartialMonoidOpT f a b i) f a b i where
  partialMonoidOpT = id

-- | Classy prism for types that can be constructed from a 'PartialMonoidOpT'.
--
-- >>> run (review _PartialMonoidOpT add) 3 4
-- Just 7
class AsPartialMonoidOpT c f a b i | c -> f a b i where
  _PartialMonoidOpT :: Prism' c (PartialMonoidOpT f a b i)

instance AsPartialMonoidOpT (PartialMonoidOpT f a b i) f a b i where
  _PartialMonoidOpT = id

----
-- PartialMonoidOp' values via pmonoid
----

-- | >>> run pmonoidUnit () ()
-- Just ()
-- >>> identityPartialMonoidOp pmonoidUnit
-- ()
pmonoidUnit :: PartialMonoidOp' ()
pmonoidUnit = pmonoid

-- | Lexicographic composition of orderings.
--
-- >>> run pmonoidOrdering LT GT
-- Just LT
-- >>> run pmonoidOrdering EQ GT
-- Just GT
-- >>> identityPartialMonoidOp pmonoidOrdering
-- EQ
pmonoidOrdering :: PartialMonoidOp' Ordering
pmonoidOrdering = pmonoid

-- | List concatenation.
--
-- >>> run pmonoidList [1,2] [3,4 :: Int]
-- Just [1,2,3,4]
-- >>> identityPartialMonoidOp pmonoidList
-- []
pmonoidList :: PartialMonoidOp' [a]
pmonoidList = pmonoid

-- | >>> run pmonoidProxy Proxy (Proxy :: Proxy Int)
-- Just Proxy
-- >>> identityPartialMonoidOp pmonoidProxy
-- Proxy
pmonoidProxy :: PartialMonoidOp' (Proxy a)
pmonoidProxy = pmonoid

-- | 'Nothing' is identity; 'Just' values are combined.
--
-- >>> run (pmonoidMaybe semigroupList) (Just [1]) (Just [2 :: Int])
-- Just (Just [1,2])
-- >>> run (pmonoidMaybe semigroupList) Nothing (Just [2 :: Int])
-- Just (Just [2])
-- >>> identityPartialMonoidOp (pmonoidMaybe semigroupList)
-- Nothing
pmonoidMaybe :: SemigroupOp' a -> PartialMonoidOp' (Maybe a)
pmonoidMaybe s = PartialMonoidOpT (psemigroupMaybe s) Nothing

-- | Reverses the inner monoid.
--
-- >>> run (pmonoidDual monoidList) (Dual [1]) (Dual [2 :: Int])
-- Just (Dual {getDual = [2,1]})
-- >>> identityPartialMonoidOp (pmonoidDual (monoidList :: MonoidOp' [Int]))
-- Dual {getDual = []}
pmonoidDual :: MonoidOp' a -> PartialMonoidOp' (Dual a)
pmonoidDual (MonoidOpT s e) = PartialMonoidOpT (psemigroupDual s) (Dual e)

-- | Delegates through 'Down'.
--
-- >>> run (pmonoidDown monoidList) (Down [1]) (Down [2 :: Int])
-- Just (Down [1,2])
pmonoidDown :: MonoidOp' a -> PartialMonoidOp' (Down a)
pmonoidDown (MonoidOpT s e) = PartialMonoidOpT (psemigroupDown s) (Down e)

-- | Delegates through 'Identity'.
--
-- >>> run (pmonoidIdentity monoidList) (Identity [1]) (Identity [2 :: Int])
-- Just (Identity [1,2])
pmonoidIdentity :: MonoidOp' a -> PartialMonoidOp' (Identity a)
pmonoidIdentity (MonoidOpT s e) = PartialMonoidOpT (psemigroupIdentity s) (Identity e)

-- | Pairwise combination.
--
-- >>> run (pmonoidTuple monoidList monoidList) ([1 :: Int], [10]) ([2], [20 :: Int])
-- Just ([1,2],[10,20])
-- >>> identityPartialMonoidOp (pmonoidTuple monoidList monoidList :: PartialMonoidOp' ([Int], [Int]))
-- ([],[])
pmonoidTuple :: MonoidOp' a -> MonoidOp' b -> PartialMonoidOp' (a, b)
pmonoidTuple (MonoidOpT sa ea) (MonoidOpT sb eb) = PartialMonoidOpT (psemigroupTuple sa sb) (ea, eb)

-- | Uses the underlying monoid operation.
--
-- >>> run (pmonoidWrappedMonoid monoidList) (WrapMonoid [1]) (WrapMonoid [2 :: Int])
-- Just (WrapMonoid {unwrapMonoid = [1,2]})
pmonoidWrappedMonoid :: MonoidOp' a -> PartialMonoidOp' (WrappedMonoid a)
pmonoidWrappedMonoid (MonoidOpT s e) = PartialMonoidOpT (psemigroupWrappedMonoid s) (WrapMonoid e)

-- | Pointwise combination.
--
-- >>> fmap ($ "x") (run (pmonoidFunction monoidList) (++ "a") ((++ "b") :: String -> String))
-- Just "xaxb"
pmonoidFunction :: MonoidOp' b -> PartialMonoidOp' (a -> b)
pmonoidFunction (MonoidOpT s e) = PartialMonoidOpT (psemigroupFunction s) (const e)

-- | First-success on 'Maybe' via 'Alt'.
--
-- >>> run pmonoidAlt (Just 1) (Just 2 :: Maybe Int)
-- Just (Just 1)
-- >>> run pmonoidAlt Nothing (Just 2 :: Maybe Int)
-- Just (Just 2)
-- >>> identityPartialMonoidOp pmonoidAlt
-- Nothing
pmonoidAlt :: PartialMonoidOp' (Maybe a)
pmonoidAlt = PartialMonoidOpT (total (<!>)) Nothing

-- | First-success on 'Maybe' via 'Alternative'.
--
-- >>> run pmonoidAlternative (Just 1) (Just 2 :: Maybe Int)
-- Just (Just 1)
-- >>> run pmonoidAlternative Nothing (Just 2 :: Maybe Int)
-- Just (Just 2)
-- >>> identityPartialMonoidOp pmonoidAlternative
-- Nothing
pmonoidAlternative :: PartialMonoidOp' (Maybe a)
pmonoidAlternative = PartialMonoidOpT (total (<|>)) Nothing

-- | Lift a monoid operation through an 'Data.Functor.Apply.Apply' functor via 'Data.Functor.Apply.liftF2'.
-- Requires 'Applicative' for 'pure' to construct the identity element.
--
-- >>> run (pmonoidLiftF2 monoidList) (Just [1,2]) (Just [3,4 :: Int])
-- Just (Just [1,2,3,4])
-- >>> identityPartialMonoidOp (pmonoidLiftF2 monoidList :: PartialMonoidOp' (Maybe [Int]))
-- Just []
pmonoidLiftF2 :: (Applicative f) => MonoidOp' a -> PartialMonoidOp' (f a)
pmonoidLiftF2 (MonoidOpT s e) = PartialMonoidOpT (psemigroupLiftA2 s) (pure e)

-- | Lift a monoid operation through an 'Applicative' functor via 'Control.Applicative.liftA2'.
--
-- >>> run (pmonoidLiftA2 monoidList) (Just [1,2]) (Just [3,4 :: Int])
-- Just (Just [1,2,3,4])
-- >>> identityPartialMonoidOp (pmonoidLiftA2 monoidList :: PartialMonoidOp' (Maybe [Int]))
-- Just []
pmonoidLiftA2 :: (Applicative f) => MonoidOp' a -> PartialMonoidOp' (f a)
pmonoidLiftA2 (MonoidOpT s e) = PartialMonoidOpT (psemigroupLiftA2 s) (pure e)

----
-- PartialMonoidOp' values via PartialMonoidOpT constructor
----

-- | Takes the minimum ('Min'). Requires 'Bounded' for 'maxBound' identity.
--
-- >>> run pmonoidMin (3 :: Int) 4
-- Just 3
-- >>> identityPartialMonoidOp pmonoidMin == (maxBound :: Int)
-- True
pmonoidMin :: (Ord a, Bounded a) => PartialMonoidOp' a
pmonoidMin = PartialMonoidOpT (total min) maxBound

-- | Takes the maximum ('Max'). Requires 'Bounded' for 'minBound' identity.
--
-- >>> run pmonoidMax (3 :: Int) 4
-- Just 4
-- >>> identityPartialMonoidOp pmonoidMax == (minBound :: Int)
-- True
pmonoidMax :: (Ord a, Bounded a) => PartialMonoidOp' a
pmonoidMax = PartialMonoidOpT (total max) minBound

-- | Logical conjunction ('All'). Identity is 'True'.
--
-- >>> run pmonoidAll True True
-- Just True
-- >>> run pmonoidAll True False
-- Just False
-- >>> identityPartialMonoidOp pmonoidAll
-- True
pmonoidAll :: PartialMonoidOp' Bool
pmonoidAll = PartialMonoidOpT (total (&&)) True

-- | Logical disjunction ('Any'). Identity is 'False'.
--
-- >>> run pmonoidAny False False
-- Just False
-- >>> run pmonoidAny False True
-- Just True
-- >>> identityPartialMonoidOp pmonoidAny
-- False
pmonoidAny :: PartialMonoidOp' Bool
pmonoidAny = PartialMonoidOpT (total (||)) False

-- | Addition ('Sum'). Identity is 0.
--
-- >>> run pmonoidAddition (3 :: Int) 4
-- Just 7
-- >>> identityPartialMonoidOp pmonoidAddition
-- 0
pmonoidAddition :: (Num a) => PartialMonoidOp' a
pmonoidAddition = PartialMonoidOpT (total (+)) 0

-- | Multiplication ('Product'). Identity is 1.
--
-- >>> run pmonoidMultiplication (3 :: Int) 4
-- Just 12
-- >>> identityPartialMonoidOp pmonoidMultiplication
-- 1
pmonoidMultiplication :: (Num a) => PartialMonoidOp' a
pmonoidMultiplication = PartialMonoidOpT (total (*)) 1

-- | Function composition ('Endo'). Identity is 'id'.
--
-- >>> fmap ($ 3) (run pmonoidEndo (+1) ((*10) :: Int -> Int))
-- Just 31
-- >>> identityPartialMonoidOp pmonoidEndo 42
-- 42
pmonoidEndo :: PartialMonoidOp' (a -> a)
pmonoidEndo = PartialMonoidOpT (total (.)) id

-- | Bitwise AND. Identity is all ones ('complement' 'zeroBits').
--
-- >>> run pmonoidAnd (0xFF :: Word8) 0x0F
-- Just 15
-- >>> identityPartialMonoidOp pmonoidAnd == (0xFF :: Word8)
-- True
pmonoidAnd :: (Bits a) => PartialMonoidOp' a
pmonoidAnd = PartialMonoidOpT (total (.&.)) (complement zeroBits)

-- | Bitwise inclusive OR. Identity is 'zeroBits'.
--
-- >>> run pmonoidIor (0xF0 :: Word8) 0x0F
-- Just 255
-- >>> identityPartialMonoidOp pmonoidIor == (0 :: Word8)
-- True
pmonoidIor :: (Bits a) => PartialMonoidOp' a
pmonoidIor = PartialMonoidOpT (total (.|.)) zeroBits

-- | Bitwise exclusive OR. Identity is 'zeroBits'.
--
-- >>> run pmonoidXor (0xFF :: Word8) 0x0F
-- Just 240
-- >>> identityPartialMonoidOp pmonoidXor == (0 :: Word8)
-- True
pmonoidXor :: (Bits a) => PartialMonoidOp' a
pmonoidXor = PartialMonoidOpT (total xor) zeroBits

-- | Bitwise equivalence / XNOR. Identity is all ones ('complement' 'zeroBits').
--
-- >>> run pmonoidIff (0xFF :: Word8) 0x0F
-- Just 15
-- >>> identityPartialMonoidOp pmonoidIff == (0xFF :: Word8)
-- True
pmonoidIff :: (FiniteBits a) => PartialMonoidOp' a
pmonoidIff = PartialMonoidOpT (total (\a b -> complement (xor a b))) (complement zeroBits)

----
-- Collection values
----

-- | Set union. Identity is 'Set.empty'.
--
-- >>> run pmonoidSetUnion (Set.fromList [1,2]) (Set.fromList [2,3 :: Int])
-- Just (fromList [1,2,3])
-- >>> identityPartialMonoidOp pmonoidSetUnion == (Set.empty :: Set Int)
-- True
pmonoidSetUnion :: (Ord a) => PartialMonoidOp' (Set a)
pmonoidSetUnion = PartialMonoidOpT (total Set.union) Set.empty

-- | IntSet union. Identity is 'IntSet.empty'.
--
-- >>> run pmonoidIntSetUnion (IntSet.fromList [1,2]) (IntSet.fromList [2,3])
-- Just (fromList [1,2,3])
-- >>> identityPartialMonoidOp pmonoidIntSetUnion == IntSet.empty
-- True
pmonoidIntSetUnion :: PartialMonoidOp' IntSet
pmonoidIntSetUnion = PartialMonoidOpT (total IntSet.union) IntSet.empty

-- | HashSet union. Identity is 'HashSet.empty'.
--
-- >>> fmap sort (fmap HashSet.toList (run pmonoidHashSetUnion (HashSet.fromList [1,2]) (HashSet.fromList [2,3 :: Int])))
-- Just [1,2,3]
pmonoidHashSetUnion :: (Eq a, Hashable a) => PartialMonoidOp' (HashSet a)
pmonoidHashSetUnion = PartialMonoidOpT (total HashSet.union) HashSet.empty

-- | Map union (left-biased on overlapping keys). Identity is 'Map.empty'.
--
-- >>> run pmonoidMapUnion (Map.fromList [(1 :: Int,'a'),(2,'b')]) (Map.fromList [(2,'x'),(3,'c')])
-- Just (fromList [(1,'a'),(2,'b'),(3,'c')])
pmonoidMapUnion :: (Ord k) => PartialMonoidOp' (Map k v)
pmonoidMapUnion = PartialMonoidOpT (total Map.union) Map.empty

-- | IntMap union (left-biased on overlapping keys). Identity is 'IntMap.empty'.
--
-- >>> run pmonoidIntMapUnion (IntMap.fromList [(1,'a'),(2,'b')]) (IntMap.fromList [(2,'x'),(3,'c')])
-- Just (fromList [(1,'a'),(2,'b'),(3,'c')])
pmonoidIntMapUnion :: PartialMonoidOp' (IntMap v)
pmonoidIntMapUnion = PartialMonoidOpT (total IntMap.union) IntMap.empty

-- | HashMap union (left-biased on overlapping keys). Identity is 'HashMap.empty'.
--
-- >>> fmap sort (fmap HashMap.toList (run pmonoidHashMapUnion (HashMap.fromList [(1 :: Int,'a'),(2,'b')]) (HashMap.fromList [(2,'x'),(3,'c')])))
-- Just [(1,'a'),(2,'b'),(3,'c')]
pmonoidHashMapUnion :: (Eq k, Hashable k) => PartialMonoidOp' (HashMap k v)
pmonoidHashMapUnion = PartialMonoidOpT (total HashMap.union) HashMap.empty