SemigroupOp.hs

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

-- |
-- A semigroup operation is an associative binary operation that is defined
-- for all pairs of inputs.
module Data.Associative.SemigroupOp
  ( -- * Types
    SemigroupOpT (..),
    SemigroupOp,
    SemigroupOpT',
    SemigroupOp',

    -- * Isomorphisms
    iSemigroupOpT,
    iSemigroupOp,

    -- * Running
    runSemigroupOpT,
    runSemigroupOp,

    -- * Smart constructors
    op,
    semigroupSemigroup,

    -- * Laws
    semigroupLawAssociative,
    semigroupLawSemigroupAssociative,
    semigroupLawMonoidLeftIdentity,
    semigroupLawMonoidRightIdentity,
    semigroupLawFunctorIdentity,
    semigroupLawFunctorComposition,
    semigroupLawProfunctorIdentity,
    semigroupLawExtendAssociative,
    semigroupLawSemigroupoidAssociative,

    -- * Classy optics
    HasSemigroupOpT (..),
    AsSemigroupOpT (..),

    -- * Values (via semigroup)
    semigroupUnit,
    semigroupVoid,
    semigroupOrdering,
    semigroupList,
    semigroupNonEmpty,
    semigroupEither,
    semigroupProxy,
    semigroupMaybe,
    semigroupDual,
    semigroupDown,
    semigroupIdentity,
    semigroupTuple,
    semigroupWrappedMonoid,
    semigroupFunction,
    semigroupAlt,
    semigroupAlternative,
    semigroupApplyThen,
    semigroupApplyFirst,
    semigroupApplicativeThen,
    semigroupApplicativeFirst,
    semigroupLiftF2,
    semigroupLiftA2,

    -- * Values (via op)
    semigroupFirst,
    semigroupLast,
    semigroupMin,
    semigroupMax,
    semigroupAll,
    semigroupAny,
    semigroupAddition,
    semigroupMultiplication,
    semigroupEndo,
    semigroupAnd,
    semigroupIor,
    semigroupXor,
    semigroupIff,

    -- * Collection values
    semigroupSetUnion,
    semigroupSetIntersection,
    semigroupIntSetUnion,
    semigroupIntSetIntersection,
    semigroupHashSetUnion,
    semigroupHashSetIntersection,
    semigroupMapUnion,
    semigroupMapIntersection,
    semigroupIntMapUnion,
    semigroupIntMapIntersection,
    semigroupHashMapUnion,
    semigroupHashMapIntersection,
  )
where

import Control.Applicative (Alternative (..))
import Control.Lens
  ( Iso,
    Lens',
    Prism',
    Rewrapped,
    Wrapped (..),
    iso,
    review,
    view,
    _Wrapped,
  )
import Control.Monad.Cont.Class (MonadCont (..))
import Control.Monad.Error.Class (MonadError (..))
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.RWS.Class (MonadRWS)
import Control.Monad.Reader.Class (MonadReader (..))
import Control.Monad.State.Class (MonadState (..))
import Control.Monad.Writer.Class (MonadWriter (..))
import Control.Selective (Selective (..), selectM)
import Data.Bits (Bits, FiniteBits, complement, xor, (.&.), (.|.))
import Data.Functor.Alt (Alt (..))
import Data.Functor.Apply (Apply (..), liftF2)
import Data.Functor.Bind (Bind (..))
import Data.Functor.Extend (Extend (..))
import Data.Functor.Identity (Identity (..))
import Data.Functor.Plus (Plus (..))
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.List.NonEmpty (NonEmpty)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Ord (Down (..))
import Data.Profunctor (Choice (..), Profunctor (..), Strong (..))
import Data.Proxy (Proxy)
import Data.Semigroup (Dual (..), WrappedMonoid (..))
import Data.Semigroupoid (Semigroupoid (..))
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Void (Void)
import GHC.Generics (Generic, Generic1)

-- $setup
-- >>> import Control.Lens (view, review)
-- >>> import Data.Functor.Apply (liftF2)
-- >>> import Data.Functor.Bind ((>>-))
-- >>> import Data.Functor.Extend (extended)
-- >>> import Data.Functor.Identity (Identity(..))
-- >>> import Data.Profunctor (dimap, lmap, rmap, first', left')
-- >>> import Data.Semigroupoid (o)
-- >>> import Data.List.NonEmpty (NonEmpty(..))
-- >>> 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 = SemigroupOpT (\a b -> Identity (a + b)) :: SemigroupOp' Int
-- >>> let cat = op (++) :: SemigroupOp' [Int]
-- >>> let run = runSemigroupOp

-- | A semigroup operation transformer. The wrapped operation must be associative
-- (see 'semigroupLawAssociative').
--
-- >>> run add 3 4
-- 7
newtype SemigroupOpT f a b = SemigroupOpT (a -> a -> f b)
  deriving (Generic, Generic1)

-- | A semigroup operation using 'Identity' as the base functor.
type SemigroupOp a b = SemigroupOpT Identity a b

-- | A semigroup operation transformer where input and output types coincide.
type SemigroupOpT' f x = SemigroupOpT f x x

-- | A semigroup operation where input and output types coincide.
type SemigroupOp' x = SemigroupOp x x

-- | Iso between 'SemigroupOpT' and its underlying function.
--
-- >>> view iSemigroupOpT add 3 4
-- Identity 7
iSemigroupOpT :: Iso (SemigroupOpT f a b) (SemigroupOpT f' a' b') (a -> a -> f b) (a' -> a' -> f' b')
iSemigroupOpT = _Wrapped
{-# INLINE iSemigroupOpT #-}

-- | Iso between 'SemigroupOp' and a pure function.
--
-- >>> view iSemigroupOp add 3 4
-- 7
iSemigroupOp :: Iso (SemigroupOp a b) (SemigroupOp a' b') (a -> a -> b) (a' -> a' -> b')
iSemigroupOp =
  iso
    (\(SemigroupOpT j) a1 a2 -> runIdentity (j a1 a2))
    (\k -> SemigroupOpT (\a1 a2 -> Identity (k a1 a2)))
{-# INLINE iSemigroupOp #-}

-- | Unwrap a 'SemigroupOpT' to its underlying function.
--
-- >>> runSemigroupOpT add 3 4
-- Identity 7
runSemigroupOpT :: SemigroupOpT f a b -> a -> a -> f b
runSemigroupOpT = view iSemigroupOpT
{-# INLINE runSemigroupOpT #-}

-- | Run a 'SemigroupOp' (specialised to 'Identity').
--
-- >>> runSemigroupOp add 3 4
-- 7
runSemigroupOp :: SemigroupOp a b -> a -> a -> b
runSemigroupOp = view iSemigroupOp
{-# INLINE runSemigroupOp #-}

-- | Lift a pure binary operation into 'SemigroupOp'.
--
-- >>> run (op (+) :: SemigroupOp' Int) 3 4
-- 7
op :: (a -> a -> b) -> SemigroupOp a b
op = review iSemigroupOp
{-# INLINE op #-}

-- | The 'Semigroup' class operation as a 'SemigroupOp''.
--
-- >>> run (semigroupSemigroup :: SemigroupOp' [Int]) [1,2] [3,4]
-- [1,2,3,4]
semigroupSemigroup :: (Semigroup a) => SemigroupOp' a
semigroupSemigroup = op (<>)
{-# INLINE semigroupSemigroup #-}

instance
  (SemigroupOpT f a b ~ t) =>
  Rewrapped (SemigroupOpT f' a' b') t

instance Wrapped (SemigroupOpT f a b) where
  type Unwrapped (SemigroupOpT f a b) = a -> a -> f b
  _Wrapped' = iso (\(SemigroupOpT x) -> x) SemigroupOpT

-- | >>> run (fmap (*10) add) 3 4
-- 70
instance (Functor f) => Functor (SemigroupOpT f a) where
  fmap g (SemigroupOpT k) =
    SemigroupOpT (\a1 a2 -> fmap g (k a1 a2))

-- | >>> run (liftF2 (+) add add) 3 4
-- 14
instance (Apply f) => Apply (SemigroupOpT f a) where
  liftF2 g (SemigroupOpT kx) (SemigroupOpT ky) =
    SemigroupOpT (\a1 a2 -> liftF2 g (kx a1 a2) (ky a1 a2))

-- | >>> run (pure 42 :: SemigroupOp' Int) 0 0
-- 42
-- >>> run (liftA2 (+) add add) 3 4
-- 14
instance (Applicative f) => Applicative (SemigroupOpT f a) where
  pure b = SemigroupOpT (\_ _ -> pure b)
  liftA2 g (SemigroupOpT kx) (SemigroupOpT ky) =
    SemigroupOpT (\a1 a2 -> liftA2 g (kx a1 a2) (ky a1 a2))

-- | >>> run (add >>- \n -> pure (n * 10)) 3 4
-- 70
instance (Bind f) => Bind (SemigroupOpT f a) where
  SemigroupOpT ka >>- g =
    SemigroupOpT
      ( \a1 a2 ->
          ka a1 a2 >>- \x -> let SemigroupOpT kb = g x in kb a1 a2
      )

-- | >>> run (add >>= \n -> pure (n * 10)) 3 4
-- 70
instance (Monad f) => Monad (SemigroupOpT f a) where
  SemigroupOpT ka >>= g =
    SemigroupOpT
      ( \a1 a2 ->
          ka a1 a2 >>= \x -> let SemigroupOpT kb = g x in kb a1 a2
      )

-- | >>> run (lmap negate add) (-3) (-4)
-- 7
-- >>> run (rmap (*10) add) 3 4
-- 70
-- >>> run (dimap negate (*10) add) (-3) (-4)
-- 70
instance (Functor f) => Profunctor (SemigroupOpT f) where
  dimap f g (SemigroupOpT k) =
    SemigroupOpT (\a1 a2 -> fmap g (k (f a1) (f a2)))
  lmap f (SemigroupOpT k) =
    SemigroupOpT (\a1 a2 -> k (f a1) (f a2))
  rmap g (SemigroupOpT k) =
    SemigroupOpT (\a1 a2 -> fmap g (k a1 a2))

-- | Pairs the first input's extra component with the result.
--
-- >>> run (first' add) (3, "x") (4, "y")
-- (7,"x")
instance (Functor f) => Strong (SemigroupOpT f) where
  first' (SemigroupOpT k) =
    SemigroupOpT (\(a1, c) (a2, _) -> fmap (,c) (k a1 a2))
  second' (SemigroupOpT k) =
    SemigroupOpT (\(c, a1) (_, a2) -> fmap (c,) (k a1 a2))

-- | Routes matching 'Either' branches; passes through the other.
--
-- >>> run (left' add) (Left 3 :: Either Int String) (Left 4)
-- Left 7
-- >>> run (left' add) (Right "x" :: Either Int String) (Left 4)
-- Right "x"
-- >>> run (left' add) (Left 3 :: Either Int String) (Right "x")
-- Right "x"
instance (Applicative f) => Choice (SemigroupOpT f) where
  left' (SemigroupOpT k) =
    SemigroupOpT
      ( \e1 e2 -> case (e1, e2) of
          (Left a1, Left a2) -> fmap Left (k a1 a2)
          (Right c, _) -> pure (Right c)
          (Left _, Right c) -> pure (Right c)
      )
  right' (SemigroupOpT k) =
    SemigroupOpT
      ( \e1 e2 -> case (e1, e2) of
          (Right a1, Right a2) -> fmap Right (k a1 a2)
          (Left c, _) -> pure (Left c)
          (Right _, Left c) -> pure (Left c)
      )

-- | Compose by feeding the result of the second into both arguments of the first.
--
-- >>> let showOp = SemigroupOpT (\a _ -> Identity (show a)) :: SemigroupOpT Identity Int String
-- >>> run (o showOp add) 3 4
-- "7"
instance (Monad f) => Semigroupoid (SemigroupOpT f) where
  o (SemigroupOpT g) (SemigroupOpT h) =
    SemigroupOpT
      ( \a1 a2 ->
          h a1 a2 >>= \b -> g b b
      )

-- | Combines results pointwise via the inner 'Semigroup'.
--
-- >>> run (cat <> cat) [1] [2 :: Int]
-- [1,2,1,2]
instance (Applicative f, Semigroup b) => Semigroup (SemigroupOpT f a b) where
  SemigroupOpT k1 <> SemigroupOpT k2 =
    SemigroupOpT
      ( \a1 a2 ->
          liftA2 (<>) (k1 a1 a2) (k2 a1 a2)
      )

-- | The always-'mempty' semigroup operation.
--
-- >>> run (mempty :: SemigroupOp' [Int]) [1] [2]
-- []
-- >>> run (mempty <> cat) [1] [2 :: Int]
-- [1,2]
instance (Applicative f, Monoid b) => Monoid (SemigroupOpT f a b) where
  mempty = SemigroupOpT (\_ _ -> pure mempty)

-- | Delegates to the underlying 'Alt'.
instance (Alt f) => Alt (SemigroupOpT f a) where
  SemigroupOpT k1 <!> SemigroupOpT k2 = SemigroupOpT (\a1 a2 -> k1 a1 a2 <!> k2 a1 a2)

-- | Delegates to the underlying 'Plus'.
--
-- >>> runSemigroupOpT (zero :: SemigroupOpT Maybe Int Int) 3 4
-- Nothing
instance (Plus f) => Plus (SemigroupOpT f a) where
  zero = SemigroupOpT (\_ _ -> zero)

-- | >>> run (select (pure (Left 5)) (pure (+10)) :: SemigroupOp' Int) 0 0
-- 15
-- >>> run (select (pure (Right 42)) (pure (+10)) :: SemigroupOp' Int) 0 0
-- 42
instance (Monad f) => Selective (SemigroupOpT f a) where
  select = selectM

-- | @'duplicated' w = w '<$' w@: preserves the structure,
-- replacing each value with the original semigroup operation.
--
-- >>> run (extended (\s -> runSemigroupOp s 10 20) add) 3 4
-- 30
instance (Functor f) => Extend (SemigroupOpT f a) where
  duplicated w = w <$ w

-- | Delegates to the underlying 'MonadReader'.
--
-- >>> import Control.Monad.Reader (Reader, runReader)
-- >>> runReader (runSemigroupOpT (ask :: SemigroupOpT (Reader Int) () Int) () ()) 42
-- 42
instance (MonadReader r f) => MonadReader r (SemigroupOpT f a) where
  ask = SemigroupOpT (\_ _ -> ask)
  local g (SemigroupOpT k) = SemigroupOpT (\a1 a2 -> local g (k a1 a2))

-- | Delegates to the underlying 'MonadError'.
--
-- >>> import Control.Monad.Except (Except, runExcept)
-- >>> runExcept (runSemigroupOpT (throwError "oops" :: SemigroupOpT (Except String) () Int) () ())
-- Left "oops"
instance (MonadError e f) => MonadError e (SemigroupOpT f a) where
  throwError e = SemigroupOpT (\_ _ -> throwError e)
  catchError (SemigroupOpT k) h =
    SemigroupOpT
      ( \a1 a2 ->
          catchError (k a1 a2) (\e -> let SemigroupOpT k' = h e in k' a1 a2)
      )

-- | Delegates to the underlying 'MonadState'.
--
-- >>> import Control.Monad.State (State, runState)
-- >>> runState (runSemigroupOpT (get :: SemigroupOpT (State Int) () Int) () ()) 5
-- (5,5)
instance (MonadState s f) => MonadState s (SemigroupOpT f a) where
  get = SemigroupOpT (\_ _ -> get)
  put s = SemigroupOpT (\_ _ -> put s)

-- | Delegates to the underlying 'MonadWriter'.
--
-- >>> import Control.Monad.Writer (Writer, runWriter)
-- >>> runWriter (runSemigroupOpT (tell "hi" :: SemigroupOpT (Writer String) () ()) () ())
-- ((),"hi")
instance (MonadWriter w f) => MonadWriter w (SemigroupOpT f a) where
  tell w = SemigroupOpT (\_ _ -> tell w)
  listen (SemigroupOpT k) = SemigroupOpT (\a1 a2 -> listen (k a1 a2))
  pass (SemigroupOpT k) = SemigroupOpT (\a1 a2 -> pass (k a1 a2))

instance (MonadRWS r w s f) => MonadRWS r w s (SemigroupOpT f a)

-- | Lifts an 'IO' action.
instance (MonadIO f) => MonadIO (SemigroupOpT f a) where
  liftIO io = SemigroupOpT (\_ _ -> liftIO io)

-- | Delegates to the underlying 'MonadCont'.
instance (MonadCont f) => MonadCont (SemigroupOpT f a) where
  callCC g =
    SemigroupOpT
      ( \a1 a2 ->
          callCC
            ( \c ->
                let SemigroupOpT k = g (\b -> SemigroupOpT (\_ _ -> c b))
                 in k a1 a2
            )
      )

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

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

-- | Associativity of the semigroup operation.
--
-- Left- and right-association of three values must agree.
--
-- >>> runIdentity $ semigroupLawAssociative add 1 2 3
-- True
semigroupLawAssociative :: (Monad f, Eq a) => SemigroupOpT' f a -> a -> a -> a -> f Bool
semigroupLawAssociative (SemigroupOpT k) x y z = do
  xy <- k x y
  lhs <- k xy z
  yz <- k y z
  rhs <- k x yz
  pure (lhs == rhs)

-- | 'Semigroup' associativity: @(p '<>' q) '<>' r == p '<>' (q '<>' r)@
--
-- >>> semigroupLawSemigroupAssociative cat cat cat [1] [2 :: Int]
-- True
semigroupLawSemigroupAssociative :: (Applicative f, Semigroup b, Eq (f b)) => SemigroupOpT f a b -> SemigroupOpT f a b -> SemigroupOpT f a b -> a -> a -> Bool
semigroupLawSemigroupAssociative p q r a1 a2 =
  runSemigroupOpT ((p <> q) <> r) a1 a2 == runSemigroupOpT (p <> (q <> r)) a1 a2

-- | 'Monoid' left identity: @'mempty' '<>' p == p@
--
-- >>> semigroupLawMonoidLeftIdentity cat [1] [2 :: Int]
-- True
semigroupLawMonoidLeftIdentity :: (Applicative f, Monoid b, Eq (f b)) => SemigroupOpT f a b -> a -> a -> Bool
semigroupLawMonoidLeftIdentity p a1 a2 =
  runSemigroupOpT (mempty <> p) a1 a2 == runSemigroupOpT p a1 a2

-- | 'Monoid' right identity: @p '<>' 'mempty' == p@
--
-- >>> semigroupLawMonoidRightIdentity cat [1] [2 :: Int]
-- True
semigroupLawMonoidRightIdentity :: (Applicative f, Monoid b, Eq (f b)) => SemigroupOpT f a b -> a -> a -> Bool
semigroupLawMonoidRightIdentity p a1 a2 =
  runSemigroupOpT (p <> mempty) a1 a2 == runSemigroupOpT p a1 a2

-- | 'Functor' identity: @'fmap' 'id' == 'id'@
--
-- >>> semigroupLawFunctorIdentity add 3 4
-- True
semigroupLawFunctorIdentity :: (Functor f, Eq (f b)) => SemigroupOpT f a b -> a -> a -> Bool
semigroupLawFunctorIdentity p a1 a2 =
  runSemigroupOpT (fmap id p) a1 a2 == runSemigroupOpT p a1 a2

-- | 'Functor' composition: @'fmap' (g '.' h) == 'fmap' g '.' 'fmap' h@
--
-- >>> semigroupLawFunctorComposition (*10) (+1) add 3 4
-- True
semigroupLawFunctorComposition :: (Functor f, Eq (f d)) => (c -> d) -> (b -> c) -> SemigroupOpT f a b -> a -> a -> Bool
semigroupLawFunctorComposition g h p a1 a2 =
  runSemigroupOpT (fmap (g . h) p) a1 a2 == runSemigroupOpT (fmap g (fmap h p)) a1 a2

-- | 'Profunctor' identity: @'dimap' 'id' 'id' == 'id'@
--
-- >>> semigroupLawProfunctorIdentity add 3 4
-- True
semigroupLawProfunctorIdentity :: (Functor f, Eq (f b)) => SemigroupOpT f a b -> a -> a -> Bool
semigroupLawProfunctorIdentity p a1 a2 =
  runSemigroupOpT (dimap id id p) a1 a2 == runSemigroupOpT p a1 a2

-- | 'Extend' associativity: @'extended' f '.' 'extended' g == 'extended' (f '.' 'extended' g)@
--
-- >>> semigroupLawExtendAssociative (const True) (const 'x') add 3 4
-- True
semigroupLawExtendAssociative :: (Functor f, Eq (f c)) => (SemigroupOpT f a b -> c) -> (SemigroupOpT f a d -> b) -> SemigroupOpT f a d -> a -> a -> Bool
semigroupLawExtendAssociative f g p a1 a2 =
  runSemigroupOpT (extended f (extended g p)) a1 a2 == runSemigroupOpT (extended (f . extended g) p) a1 a2

-- | 'Semigroupoid' associativity: @'o' f ('o' g h) == 'o' ('o' f g) h@
--
-- >>> semigroupLawSemigroupoidAssociative add add add 3 4
-- True
semigroupLawSemigroupoidAssociative :: (Monad f, Eq (f d)) => SemigroupOpT f c d -> SemigroupOpT f b c -> SemigroupOpT f a b -> a -> a -> Bool
semigroupLawSemigroupoidAssociative f g h x1 x2 =
  runSemigroupOpT (o f (o g h)) x1 x2 == runSemigroupOpT (o (o f g) h) x1 x2

-- | Classy lens for types that contain a 'SemigroupOpT'.
--
-- >>> run (view semigroupOpT add) 3 4
-- 7
class HasSemigroupOpT c f a b | c -> f a b where
  semigroupOpT :: Lens' c (SemigroupOpT f a b)

instance HasSemigroupOpT (SemigroupOpT f a b) f a b where
  semigroupOpT = id

-- | Classy prism for types that can be constructed from a 'SemigroupOpT'.
--
-- >>> run (review _SemigroupOpT add) 3 4
-- 7
class AsSemigroupOpT c f a b | c -> f a b where
  _SemigroupOpT :: Prism' c (SemigroupOpT f a b)

instance AsSemigroupOpT (SemigroupOpT f a b) f a b where
  _SemigroupOpT = id

----
-- SemigroupOp' values via semigroup
----

-- | >>> run semigroupUnit () ()
-- ()
semigroupUnit :: SemigroupOp' ()
semigroupUnit = semigroupSemigroup

-- | Vacuously associative — 'Void' has no inhabitants.
semigroupVoid :: SemigroupOp' Void
semigroupVoid = semigroupSemigroup

-- | Lexicographic composition of orderings.
--
-- >>> run semigroupOrdering LT GT
-- LT
-- >>> run semigroupOrdering EQ GT
-- GT
-- >>> run semigroupOrdering EQ EQ
-- EQ
semigroupOrdering :: SemigroupOp' Ordering
semigroupOrdering = semigroupSemigroup

-- | List concatenation.
--
-- >>> run semigroupList [1,2] [3,4 :: Int]
-- [1,2,3,4]
semigroupList :: SemigroupOp' [a]
semigroupList = semigroupSemigroup

-- | Non-empty list concatenation.
--
-- >>> run semigroupNonEmpty (1 :| [2]) (3 :| [4 :: Int])
-- 1 :| [2,3,4]
semigroupNonEmpty :: SemigroupOp' (NonEmpty a)
semigroupNonEmpty = semigroupSemigroup

-- | First 'Right' wins; 'Left' is absorbed.
--
-- >>> run semigroupEither (Left "a") (Right 1 :: Either String Int)
-- Right 1
-- >>> run semigroupEither (Right 1) (Left "b" :: Either String Int)
-- Right 1
-- >>> run semigroupEither (Left "a") (Left "b" :: Either String Int)
-- Left "b"
semigroupEither :: SemigroupOp' (Either a b)
semigroupEither = semigroupSemigroup

-- | >>> run semigroupProxy Proxy (Proxy :: Proxy Int)
-- Proxy
semigroupProxy :: SemigroupOp' (Proxy a)
semigroupProxy = semigroupSemigroup

-- | 'Nothing' is identity; 'Just' values are combined.
--
-- >>> run (semigroupMaybe cat) (Just [1]) (Just [2 :: Int])
-- Just [1,2]
-- >>> run (semigroupMaybe cat) Nothing (Just [2 :: Int])
-- Just [2]
-- >>> run (semigroupMaybe cat) (Just [1 :: Int]) Nothing
-- Just [1]
semigroupMaybe :: SemigroupOp' a -> SemigroupOp' (Maybe a)
semigroupMaybe s = op (\mx my -> case (mx, my) of
  (Nothing, y) -> y
  (x, Nothing) -> x
  (Just x, Just y) -> Just (runSemigroupOp s x y))

-- | First-success on 'Maybe' via 'Alt'.
--
-- >>> run semigroupAlt (Just 1) (Just 2 :: Maybe Int)
-- Just 1
-- >>> run semigroupAlt Nothing (Just 2 :: Maybe Int)
-- Just 2
semigroupAlt :: SemigroupOp' (Maybe a)
semigroupAlt = op (<!>)

-- | First-success on 'Maybe' via 'Alternative'.
--
-- >>> run semigroupAlternative (Just 1) (Just 2 :: Maybe Int)
-- Just 1
-- >>> run semigroupAlternative Nothing (Just 2 :: Maybe Int)
-- Just 2
semigroupAlternative :: SemigroupOp' (Maybe a)
semigroupAlternative = op (<|>)

-- | Sequence both, keep last result via 'Data.Functor.Apply.Apply'.
--
-- >>> run semigroupApplyThen (Just 1) (Just 2 :: Maybe Int)
-- Just 2
-- >>> run semigroupApplyThen Nothing (Just 2 :: Maybe Int)
-- Nothing
semigroupApplyThen :: (Apply f) => SemigroupOp' (f a)
semigroupApplyThen = op (.>)

-- | Sequence both, keep first result via 'Data.Functor.Apply.Apply'.
--
-- >>> run semigroupApplyFirst (Just 1) (Just 2 :: Maybe Int)
-- Just 1
-- >>> run semigroupApplyFirst Nothing (Just 2 :: Maybe Int)
-- Nothing
semigroupApplyFirst :: (Apply f) => SemigroupOp' (f a)
semigroupApplyFirst = op (<.)

-- | Sequence both, keep last result via 'Applicative'.
--
-- >>> run semigroupApplicativeThen (Just 1) (Just 2 :: Maybe Int)
-- Just 2
-- >>> run semigroupApplicativeThen Nothing (Just 2 :: Maybe Int)
-- Nothing
semigroupApplicativeThen :: (Applicative f) => SemigroupOp' (f a)
semigroupApplicativeThen = op (*>)

-- | Sequence both, keep first result via 'Applicative'.
--
-- >>> run semigroupApplicativeFirst (Just 1) (Just 2 :: Maybe Int)
-- Just 1
-- >>> run semigroupApplicativeFirst Nothing (Just 2 :: Maybe Int)
-- Nothing
semigroupApplicativeFirst :: (Applicative f) => SemigroupOp' (f a)
semigroupApplicativeFirst = op (<*)

-- | Reverses the inner semigroup.
--
-- >>> run (semigroupDual cat) (Dual [1]) (Dual [2 :: Int])
-- Dual {getDual = [2,1]}
semigroupDual :: SemigroupOp' a -> SemigroupOp' (Dual a)
semigroupDual s = op (\(Dual x) (Dual y) -> Dual (runSemigroupOp s y x))

-- | Delegates through 'Down'.
--
-- >>> run (semigroupDown cat) (Down [1]) (Down [2 :: Int])
-- Down [1,2]
semigroupDown :: SemigroupOp' a -> SemigroupOp' (Down a)
semigroupDown s = op (\(Down x) (Down y) -> Down (runSemigroupOp s x y))

-- | Delegates through 'Identity'.
--
-- >>> run (semigroupIdentity cat) (Identity [1]) (Identity [2 :: Int])
-- Identity [1,2]
semigroupIdentity :: SemigroupOp' a -> SemigroupOp' (Identity a)
semigroupIdentity s = op (\(Identity x) (Identity y) -> Identity (runSemigroupOp s x y))

-- | Pairwise combination.
--
-- >>> run (semigroupTuple cat cat) ([1 :: Int], [10]) ([2], [20 :: Int])
-- ([1,2],[10,20])
semigroupTuple :: SemigroupOp' a -> SemigroupOp' b -> SemigroupOp' (a, b)
semigroupTuple sa sb = op (\(a1, b1) (a2, b2) -> (runSemigroupOp sa a1 a2, runSemigroupOp sb b1 b2))

-- | Uses the underlying semigroup operation.
--
-- >>> run (semigroupWrappedMonoid cat) (WrapMonoid [1]) (WrapMonoid [2 :: Int])
-- WrapMonoid {unwrapMonoid = [1,2]}
semigroupWrappedMonoid :: SemigroupOp' a -> SemigroupOp' (WrappedMonoid a)
semigroupWrappedMonoid s = op (\(WrapMonoid x) (WrapMonoid y) -> WrapMonoid (runSemigroupOp s x y))

-- | Pointwise combination.
--
-- >>> run (semigroupFunction semigroupList) (++ "a") ((++ "b") :: String -> String) "x"
-- "xaxb"
semigroupFunction :: SemigroupOp' b -> SemigroupOp' (a -> b)
semigroupFunction s = op (\f g x -> runSemigroupOp s (f x) (g x))

-- | Lift a semigroup operation through an 'Data.Functor.Apply.Apply' functor via 'Data.Functor.Apply.liftF2'.
--
-- >>> run (semigroupLiftF2 add) (Just 3) (Just 4 :: Maybe Int)
-- Just 7
-- >>> run (semigroupLiftF2 add) Nothing (Just 4 :: Maybe Int)
-- Nothing
semigroupLiftF2 :: (Apply f) => SemigroupOp' a -> SemigroupOp' (f a)
semigroupLiftF2 s = op (liftF2 (runSemigroupOp s))

-- | Lift a semigroup operation through an 'Applicative' functor via 'Control.Applicative.liftA2'.
--
-- >>> run (semigroupLiftA2 add) (Just 3) (Just 4 :: Maybe Int)
-- Just 7
-- >>> run (semigroupLiftA2 add) Nothing (Just 4 :: Maybe Int)
-- Nothing
semigroupLiftA2 :: (Applicative f) => SemigroupOp' a -> SemigroupOp' (f a)
semigroupLiftA2 s = op (liftA2 (runSemigroupOp s))

----
-- SemigroupOp' values via op
----

-- | Takes the first value ('First').
--
-- >>> run semigroupFirst 'a' 'b'
-- 'a'
semigroupFirst :: SemigroupOp' a
semigroupFirst = op const

-- | Takes the last value ('Last').
--
-- >>> run semigroupLast 'a' 'b'
-- 'b'
semigroupLast :: SemigroupOp' a
semigroupLast = op (const id)

-- | Takes the minimum ('Min').
--
-- >>> run semigroupMin (3 :: Int) 4
-- 3
semigroupMin :: (Ord a) => SemigroupOp' a
semigroupMin = op min

-- | Takes the maximum ('Max').
--
-- >>> run semigroupMax (3 :: Int) 4
-- 4
semigroupMax :: (Ord a) => SemigroupOp' a
semigroupMax = op max

-- | Logical conjunction ('All').
--
-- >>> run semigroupAll True True
-- True
-- >>> run semigroupAll True False
-- False
semigroupAll :: SemigroupOp' Bool
semigroupAll = op (&&)

-- | Logical disjunction ('Any').
--
-- >>> run semigroupAny False False
-- False
-- >>> run semigroupAny False True
-- True
semigroupAny :: SemigroupOp' Bool
semigroupAny = op (||)

-- | Addition ('Sum').
--
-- >>> run semigroupAddition (3 :: Int) 4
-- 7
semigroupAddition :: (Num a) => SemigroupOp' a
semigroupAddition = op (+)

-- | Multiplication ('Product').
--
-- >>> run semigroupMultiplication (3 :: Int) 4
-- 12
semigroupMultiplication :: (Num a) => SemigroupOp' a
semigroupMultiplication = op (*)

-- | Function composition ('Endo').
--
-- >>> run semigroupEndo (+1) ((*10) :: Int -> Int) 3
-- 31
semigroupEndo :: SemigroupOp' (a -> a)
semigroupEndo = op (.)

-- | Bitwise AND ('Data.Bits.And').
--
-- >>> run semigroupAnd (0xFF :: Word8) 0x0F
-- 15
semigroupAnd :: (Bits a) => SemigroupOp' a
semigroupAnd = op (.&.)

-- | Bitwise inclusive OR ('Data.Bits.Ior').
--
-- >>> run semigroupIor (0xF0 :: Word8) 0x0F
-- 255
semigroupIor :: (Bits a) => SemigroupOp' a
semigroupIor = op (.|.)

-- | Bitwise exclusive OR ('Data.Bits.Xor').
--
-- >>> run semigroupXor (0xFF :: Word8) 0x0F
-- 240
semigroupXor :: (Bits a) => SemigroupOp' a
semigroupXor = op xor

-- | Bitwise equivalence / XNOR ('Data.Bits.Iff').
--
-- >>> run semigroupIff (0xFF :: Word8) 0x0F
-- 15
semigroupIff :: (FiniteBits a) => SemigroupOp' a
semigroupIff = op (\a b -> complement (xor a b))

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

-- | Set union.
--
-- >>> run semigroupSetUnion (Set.fromList [1,2]) (Set.fromList [2,3 :: Int])
-- fromList [1,2,3]
semigroupSetUnion :: (Ord a) => SemigroupOp' (Set a)
semigroupSetUnion = op Set.union

-- | Set intersection.
--
-- >>> run semigroupSetIntersection (Set.fromList [1,2,3]) (Set.fromList [2,3,4 :: Int])
-- fromList [2,3]
semigroupSetIntersection :: (Ord a) => SemigroupOp' (Set a)
semigroupSetIntersection = op Set.intersection

-- | IntSet union.
--
-- >>> run semigroupIntSetUnion (IntSet.fromList [1,2]) (IntSet.fromList [2,3])
-- fromList [1,2,3]
semigroupIntSetUnion :: SemigroupOp' IntSet
semigroupIntSetUnion = op IntSet.union

-- | IntSet intersection.
--
-- >>> run semigroupIntSetIntersection (IntSet.fromList [1,2,3]) (IntSet.fromList [2,3,4])
-- fromList [2,3]
semigroupIntSetIntersection :: SemigroupOp' IntSet
semigroupIntSetIntersection = op IntSet.intersection

-- | HashSet union.
--
-- >>> sort (HashSet.toList (run semigroupHashSetUnion (HashSet.fromList [1,2]) (HashSet.fromList [2,3 :: Int])))
-- [1,2,3]
semigroupHashSetUnion :: (Eq a, Hashable a) => SemigroupOp' (HashSet a)
semigroupHashSetUnion = op HashSet.union

-- | HashSet intersection.
--
-- >>> sort (HashSet.toList (run semigroupHashSetIntersection (HashSet.fromList [1,2,3]) (HashSet.fromList [2,3,4 :: Int])))
-- [2,3]
semigroupHashSetIntersection :: (Eq a, Hashable a) => SemigroupOp' (HashSet a)
semigroupHashSetIntersection = op HashSet.intersection

-- | Map union (left-biased on overlapping keys).
--
-- >>> run semigroupMapUnion (Map.fromList [(1 :: Int,'a'),(2,'b')]) (Map.fromList [(2,'x'),(3,'c')])
-- fromList [(1,'a'),(2,'b'),(3,'c')]
semigroupMapUnion :: (Ord k) => SemigroupOp' (Map k v)
semigroupMapUnion = op Map.union

-- | Map intersection (left-biased on overlapping keys).
--
-- >>> run semigroupMapIntersection (Map.fromList [(1 :: Int,'a'),(2,'b'),(3,'c')]) (Map.fromList [(2,'x'),(3,'y'),(4,'z')])
-- fromList [(2,'b'),(3,'c')]
semigroupMapIntersection :: (Ord k) => SemigroupOp' (Map k v)
semigroupMapIntersection = op Map.intersection

-- | IntMap union (left-biased on overlapping keys).
--
-- >>> run semigroupIntMapUnion (IntMap.fromList [(1,'a'),(2,'b')]) (IntMap.fromList [(2,'x'),(3,'c')])
-- fromList [(1,'a'),(2,'b'),(3,'c')]
semigroupIntMapUnion :: SemigroupOp' (IntMap v)
semigroupIntMapUnion = op IntMap.union

-- | IntMap intersection (left-biased on overlapping keys).
--
-- >>> run semigroupIntMapIntersection (IntMap.fromList [(1,'a'),(2,'b'),(3,'c')]) (IntMap.fromList [(2,'x'),(3,'y'),(4,'z')])
-- fromList [(2,'b'),(3,'c')]
semigroupIntMapIntersection :: SemigroupOp' (IntMap v)
semigroupIntMapIntersection = op IntMap.intersection

-- | HashMap union (left-biased on overlapping keys).
--
-- >>> sort (HashMap.toList (run semigroupHashMapUnion (HashMap.fromList [(1 :: Int,'a'),(2,'b')]) (HashMap.fromList [(2,'x'),(3,'c')])))
-- [(1,'a'),(2,'b'),(3,'c')]
semigroupHashMapUnion :: (Eq k, Hashable k) => SemigroupOp' (HashMap k v)
semigroupHashMapUnion = op HashMap.union

-- | HashMap intersection (left-biased on overlapping keys).
--
-- >>> sort (HashMap.toList (run semigroupHashMapIntersection (HashMap.fromList [(1 :: Int,'a'),(2,'b'),(3,'c')]) (HashMap.fromList [(2,'x'),(3,'y'),(4,'z')])))
-- [(2,'b'),(3,'c')]
semigroupHashMapIntersection :: (Eq k, Hashable k) => SemigroupOp' (HashMap k v)
semigroupHashMapIntersection = op HashMap.intersection