associative (empty) → 0.0.1

raw patch · 15 files changed

+3569/−0 lines, 15 filesdep +basedep +containersdep +hashablesetup-changed

Dependencies added: base, containers, hashable, lens, mtl, process, profunctors, selective, semigroupoids, unordered-containers, witherable

Files

• LICENCE +27/−0
• Setup.hs +3/−0
• associative.cabal +62/−0
• changelog.md +3/−0
• examples/Data/Associative/Examples.hs +14/−0
• examples/Data/Associative/Examples/MonoidOpExamples.hs +60/−0
• examples/Data/Associative/Examples/PartialMonoidOpExamples.hs +60/−0
• examples/Data/Associative/Examples/PartialSemigroupOpExamples.hs +118/−0
• examples/Data/Associative/Examples/SemigroupOpExamples.hs +104/−0
• src/Data/Associative.hs +231/−0
• src/Data/Associative/MonoidOp.hs +508/−0
• src/Data/Associative/PartialMonoidOp.hs +524/−0
• src/Data/Associative/PartialSemigroupOp.hs +972/−0
• src/Data/Associative/SemigroupOp.hs +865/−0
• test/Main.hs +18/−0

@@ -0,0 +1,27 @@+Copyright 2026 Tony Morris++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.

@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain

@@ -0,0 +1,62 @@+cabal-version:        2.4+name:                 associative+version:              0.0.1+synopsis:             Partial Semigroup and Semigroup operations+description:          Partial Semigroup and Semigroup operations: Associative, Closed, Binary operation which may not be defined for all domains+license:              BSD-3-Clause+license-file:         LICENCE+author:               Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ>+maintainer:           Tony Morris <ʇǝu˙sıɹɹoɯʇ@ןןǝʞsɐɥ>+copyright:            Copyright (C) 2026 Tony Morris+category:             Data+build-type:           Simple+extra-doc-files:      changelog.md+homepage:             https://gitlab.com/tonymorris/associative+bug-reports:          https://gitlab.com/tonymorris/associative/issues+tested-with:          GHC == 9.4.8, GHC == 9.6.7++source-repository     head+  type:               git+  location:           https://gitlab.com/tonymorris/associative++library+  exposed-modules:+                      Data.Associative+                      Data.Associative.MonoidOp+                      Data.Associative.PartialMonoidOp+                      Data.Associative.PartialSemigroupOp+                      Data.Associative.SemigroupOp+                      Data.Associative.Examples+                      Data.Associative.Examples.MonoidOpExamples+                      Data.Associative.Examples.PartialMonoidOpExamples+                      Data.Associative.Examples.PartialSemigroupOpExamples+                      Data.Associative.Examples.SemigroupOpExamples++  build-depends:        base >= 4.8 && < 6+                      , containers >= 0.5 && < 1+                      , hashable >= 1.2 && < 2+                      , lens >= 4 && < 6+                      , mtl >= 2.2 && < 3+                      , profunctors >= 5 && < 6+                      , selective >= 0.7.0.1 && < 1+                      , semigroupoids >= 5.2 && < 7+                      , unordered-containers >= 0.2 && < 1+                      , witherable >= 0.4 && < 1++  hs-source-dirs:     src+                      examples++  default-language:   Haskell2010++  ghc-options:        -Wall+++test-suite doctest+  type:               exitcode-stdio-1.0+  hs-source-dirs:     test+  main-is:            Main.hs+  build-depends:      base >= 4.8 && < 6+                    , process >= 1 && < 2+  build-tool-depends: doctest:doctest >= 0.22+  default-language:   Haskell2010+  ghc-options:        -Wall

@@ -0,0 +1,3 @@+0.0.1++* This change log starts

@@ -0,0 +1,14 @@+{-# OPTIONS_GHC -Wall -Werror #-}++module Data.Associative.Examples+  ( module Data.Associative.Examples.MonoidOpExamples,+    module Data.Associative.Examples.PartialMonoidOpExamples,+    module Data.Associative.Examples.PartialSemigroupOpExamples,+    module Data.Associative.Examples.SemigroupOpExamples,+  )+where++import Data.Associative.Examples.MonoidOpExamples+import Data.Associative.Examples.PartialMonoidOpExamples+import Data.Associative.Examples.PartialSemigroupOpExamples+import Data.Associative.Examples.SemigroupOpExamples

@@ -0,0 +1,60 @@+{-# OPTIONS_GHC -Wall -Werror #-}++-- |+-- Example usages of "Data.Associative.MonoidOp".+module Data.Associative.Examples.MonoidOpExamples+  ( -- * Constructing monoid operations+    addMonoid,+    catMonoid,++    -- * Identity element laws+    monoidIdentityLawExample,+  )+where++import Data.Associative.MonoidOp+  ( MonoidOp (..),+    identityMonoidOp,+    monoidList,+    runMonoidOp,+  )+import Data.Associative.SemigroupOp (op)++-- * Constructing monoid operations++-- | A monoid operation for addition with identity 0.+--+-- >>> runMonoidOp addMonoid 3 4+-- 7+-- >>> identityMonoidOp addMonoid+-- 0+addMonoid :: MonoidOp Int+addMonoid = MonoidOp (op (+)) 0++-- | A monoid operation from the 'Monoid' class.+--+-- >>> runMonoidOp catMonoid [1,2] [3,4 :: Int]+-- [1,2,3,4]+-- >>> identityMonoidOp catMonoid+-- []+catMonoid :: MonoidOp [Int]+catMonoid = monoidList++-- * Identity element laws++-- | The identity element is neutral under the operation.+--+-- >>> let e = identityMonoidOp addMonoid+-- >>> runMonoidOp addMonoid e 42+-- 42+-- >>> runMonoidOp addMonoid 42 e+-- 42+monoidIdentityLawExample :: ()+monoidIdentityLawExample = ()++-- helpers to suppress unused-import warnings for re-exports used in doctests+_suppressRunMonoidOp :: MonoidOp a -> a -> a -> a+_suppressRunMonoidOp = runMonoidOp++_suppressIdentityMonoidOp :: MonoidOp a -> a+_suppressIdentityMonoidOp = identityMonoidOp

@@ -0,0 +1,60 @@+{-# OPTIONS_GHC -Wall -Werror #-}++-- |+-- Example usages of "Data.Associative.PartialMonoidOp".+module Data.Associative.Examples.PartialMonoidOpExamples+  ( -- * Constructing partial monoid operations+    addPartialMonoid,+    catPartialMonoid,++    -- * Identity element laws+    partialMonoidIdentityLawExample,+  )+where++import Data.Associative.PartialMonoidOp+  ( PartialMonoidOp (..),+    identityPartialMonoidOp,+    pmonoidList,+    runPartialMonoidOp,+  )+import Data.Associative.PartialSemigroupOp (total)++-- * Constructing partial monoid operations++-- | A partial monoid operation for addition with identity 0.+--+-- >>> runPartialMonoidOp addPartialMonoid 3 4+-- Just 7+-- >>> identityPartialMonoidOp addPartialMonoid+-- 0+addPartialMonoid :: PartialMonoidOp Int+addPartialMonoid = PartialMonoidOp (total (+)) 0++-- | A partial monoid operation from the 'Monoid' class.+--+-- >>> runPartialMonoidOp catPartialMonoid [1,2] [3,4 :: Int]+-- Just [1,2,3,4]+-- >>> identityPartialMonoidOp catPartialMonoid+-- []+catPartialMonoid :: PartialMonoidOp [Int]+catPartialMonoid = pmonoidList++-- * Identity element laws++-- | The identity element is neutral under the operation.+--+-- >>> let e = identityPartialMonoidOp addPartialMonoid+-- >>> runPartialMonoidOp addPartialMonoid e 42+-- Just 42+-- >>> runPartialMonoidOp addPartialMonoid 42 e+-- Just 42+partialMonoidIdentityLawExample :: ()+partialMonoidIdentityLawExample = ()++-- helpers to suppress unused-import warnings for re-exports used in doctests+_suppressRunPartialMonoidOp :: PartialMonoidOp a -> a -> a -> Maybe a+_suppressRunPartialMonoidOp = runPartialMonoidOp++_suppressIdentityPartialMonoidOp :: PartialMonoidOp a -> a+_suppressIdentityPartialMonoidOp = identityPartialMonoidOp

@@ -0,0 +1,118 @@+{-# OPTIONS_GHC -Wall -Werror #-}++-- |+-- Example usages of "Data.Associative.PartialSemigroupOp".+module Data.Associative.Examples.PartialSemigroupOpExamples+  ( -- * Constructing and running partial semigroups+    addPositive,+    multiply,++    -- * Combining operations with Semigroup (first-success fallback)+    fallbackExample,++    -- * Functor+    fmapPartialExample,++    -- * Using effects (monad transformer)+    countedAdd,+  )+where++import Control.Monad.State (State, get, put)+import Data.Associative.PartialSemigroupOp+  ( PartialSemigroupOp',+    PartialSemigroupOpT (..),+    runPartialSemigroupOp,+    runPartialSemigroupOpT,+    total,+  )+import Data.Functor.Identity (Identity (..))+import Prelude hiding (null)++-- $setup+-- >>> import Data.Functor.Identity (Identity(..))+-- >>> import Control.Monad.State (runState)++-- * Constructing and running partial semigroups++-- | A partial semigroup that adds two positive integers,+-- returning 'Nothing' when either input is non-positive.+--+-- >>> runPartialSemigroupOp addPositive 3 4+-- Just 7+-- >>> runPartialSemigroupOp addPositive (-1) 4+-- Nothing+-- >>> runPartialSemigroupOp addPositive 0 5+-- Nothing+addPositive :: PartialSemigroupOp' Int+addPositive =+  PartialSemigroupOpT+    ( \a b ->+        Identity+          ( if a > 0 && b > 0+              then Just (a + b)+              else Nothing+          )+    )++-- | A partial semigroup built with the 'total' smart constructor.+-- Total operations always succeed (always return 'Just').+--+-- >>> runPartialSemigroupOp multiply 3 4+-- Just 12+-- >>> runPartialSemigroupOp multiply 0 5+-- Just 0+multiply :: PartialSemigroupOp' Int+multiply = total (*)++-- * Combining operations with Semigroup (first-success fallback)++-- | Partial semigroups combine with first-success fallback:+-- try the left operand; if it returns 'Nothing', try the right.+--+-- >>> runPartialSemigroupOp (addPositive <> total (+)) 3 4+-- Just 7+-- >>> runPartialSemigroupOp (addPositive <> total (+)) (-1) 4+-- Just 3+fallbackExample :: PartialSemigroupOp' Int+fallbackExample = addPositive <> total (+)++-- * Functor++-- | 'fmap' transforms the result.+--+-- >>> runPartialSemigroupOp (fmap (*10) addPositive) 3 4+-- Just 70+-- >>> runPartialSemigroupOp (fmap (*10) addPositive) (-1) 4+-- Nothing+fmapPartialExample :: PartialSemigroupOp' Int+fmapPartialExample = fmap (* 10) addPositive++-- * Using effects (monad transformer)++-- | A partial semigroup that tracks how many times it's been called,+-- returning 'Nothing' when either input is non-positive.+--+-- >>> runState (runPartialSemigroupOpT countedAdd 3 4) 0+-- (Just 7,1)+-- >>> runState (runPartialSemigroupOpT countedAdd (-1) 4) 0+-- (Nothing,1)+countedAdd :: PartialSemigroupOpT (State Int) Int Int+countedAdd =+  PartialSemigroupOpT+    ( \a b -> do+        n <- get+        put (n + 1)+        pure+          ( if a > 0 && b > 0+              then Just (a + b)+              else Nothing+          )+    )++-- helpers to suppress unused-import warnings for re-exports used in doctests+_suppressRunPartialSemigroupOp :: PartialSemigroupOp' a -> a -> a -> Maybe a+_suppressRunPartialSemigroupOp = runPartialSemigroupOp++_suppressRunPartialSemigroupOpT :: PartialSemigroupOpT f a b -> a -> a -> f (Maybe b)+_suppressRunPartialSemigroupOpT = runPartialSemigroupOpT

@@ -0,0 +1,104 @@+{-# OPTIONS_GHC -Wall -Werror #-}++-- |+-- Example usages of "Data.Associative.SemigroupOp".+module Data.Associative.Examples.SemigroupOpExamples+  ( -- * Constructing and running total semigroup operations+    add,+    cat,++    -- * Combining operations with Semigroup (pointwise)+    pointwiseExample,++    -- * Functor and Profunctor+    fmapTotalExample,+    lmapExample,++    -- * Using effects (monad transformer)+    statefulConcat,+  )+where++import Control.Monad.State (State, get, put)+import Data.Associative.SemigroupOp+  ( SemigroupOp',+    SemigroupOpT (..),+    op,+    runSemigroupOp,+    runSemigroupOpT,+  )+import Data.Functor.Identity (Identity (..))++-- $setup+-- >>> import Data.Functor.Identity (Identity(..))+-- >>> import Data.Profunctor (lmap, rmap)+-- >>> import Control.Monad.State (runState)++-- * Constructing and running total semigroup operations++-- | A total semigroup operation for addition.+--+-- >>> runSemigroupOp add 3 4+-- 7+add :: SemigroupOp' Int+add = op (+)++-- | A total semigroup operation for list concatenation.+--+-- >>> runSemigroupOp cat [1,2] [3,4 :: Int]+-- [1,2,3,4]+cat :: SemigroupOp' [Int]+cat = op (++)++-- * Combining operations with Semigroup (pointwise)++-- | Total semigroup operations combine pointwise: both operations+-- run and their results are combined via the inner 'Semigroup'.+--+-- >>> runSemigroupOp (cat <> cat) [1] [2 :: Int]+-- [1,2,1,2]+pointwiseExample :: SemigroupOp' [Int]+pointwiseExample = cat <> cat++-- * Functor and Profunctor++-- | 'fmap' transforms the result of a total operation.+--+-- >>> runSemigroupOpT (fmap show add) 3 4+-- Identity "7"+fmapTotalExample :: SemigroupOpT Identity Int String+fmapTotalExample = fmap show add++-- | 'lmap' transforms the inputs (contravariantly).+--+-- >>> runSemigroupOp (lmap negate add) (-3) (-4)+-- 7+--+-- 'rmap' transforms the output (same as 'fmap').+--+-- >>> runSemigroupOp (rmap (*10) add) 3 4+-- 70+lmapExample :: SemigroupOp' Int+lmapExample = fmap (* 10) add++-- * Using effects (monad transformer)++-- | A total semigroup operation with state.+--+-- >>> runState (runSemigroupOpT statefulConcat "hello" " world") 0+-- ("hello world",1)+statefulConcat :: SemigroupOpT (State Int) String String+statefulConcat =+  SemigroupOpT+    ( \a b -> do+        n <- get+        put (n + 1)+        pure (a ++ b)+    )++-- helpers to suppress unused-import warnings for re-exports used in doctests+_suppressRunSemigroupOp :: SemigroupOp' a -> a -> a -> a+_suppressRunSemigroupOp = runSemigroupOp++_suppressRunSemigroupOpT :: SemigroupOpT f a b -> a -> a -> f b+_suppressRunSemigroupOpT = runSemigroupOpT

@@ -0,0 +1,231 @@+{-# OPTIONS_GHC -Wall -Werror #-}++-- |+-- Associative binary operations as first-class values, with a monad-transformer+-- structure for composing effects. Includes both total and partial variants, each+-- with semigroup and monoid flavours.+--+-- Four modules are provided:+--+-- +--------------------------------------------------+----------------------------------------------+-----------------------------------------------------------++-- | Module                                           | Type                                         | Operation                                                 |+-- +==================================================+==============================================+===========================================================++-- | "Data.Associative.SemigroupOp"                   | @SemigroupOpT f a b@ ~ @a -> a -> f b@       | Total semigroup -- defined for all inputs                 |+-- +--------------------------------------------------+----------------------------------------------+-----------------------------------------------------------++-- | "Data.Associative.PartialSemigroupOp"            | @PartialSemigroupOpT f a b@ ~ @a -> a -> f (Maybe b)@ | Partial semigroup -- may be undefined for some inputs |+-- +--------------------------------------------------+----------------------------------------------+-----------------------------------------------------------++-- | "Data.Associative.MonoidOp"                      | @MonoidOp a@ ~ @(SemigroupOp' a, a)@        | Total monoid -- semigroup with an identity element        |+-- +--------------------------------------------------+----------------------------------------------+-----------------------------------------------------------++-- | "Data.Associative.PartialMonoidOp"               | @PartialMonoidOp a@ ~ @(PartialSemigroupOp' a, a)@ | Partial monoid -- partial semigroup with an identity element |+-- +--------------------------------------------------+----------------------------------------------+-----------------------------------------------------------++--+-- The semigroup types are parameterised by a functor @f@ for effects (e.g.+-- 'Data.Functor.Identity.Identity', 'IO', @State s@), an input type @a@, and a result type @b@. When+-- @a ~ b@ the operation is /endomorphic/ (the common case for semigroups).+--+-- The monoid types pair a semigroup operation with its identity element.+--+-- == Quick start+--+-- @+-- import "Data.Associative.SemigroupOp"+-- import "Data.Associative.PartialSemigroupOp" ('Data.Associative.PartialSemigroupOp.PartialSemigroupOpT'(..), 'Data.Associative.PartialSemigroupOp.runPartialSemigroupOp', 'Data.Associative.PartialSemigroupOp.total')+-- import "Data.Associative.MonoidOp"+-- import "Data.Associative.PartialMonoidOp"+--+-- -- A total semigroup operation for addition+-- add :: 'Data.Associative.SemigroupOp.SemigroupOp'' Int+-- add = 'Data.Associative.SemigroupOp.op' (+)+--+-- 'Data.Associative.SemigroupOp.runSemigroupOp' add 3 4 -- 7+--+-- -- A partial semigroup that adds two positive integers+-- addPos :: 'Data.Associative.PartialSemigroupOp.PartialSemigroupOp'' Int+-- addPos = 'Data.Associative.PartialSemigroupOp.PartialSemigroupOpT' (\\a b ->+--   Identity (if a > 0 && b > 0 then Just (a + b) else Nothing))+--+-- 'Data.Associative.PartialSemigroupOp.runPartialSemigroupOp' addPos 3 4   -- Just 7+-- 'Data.Associative.PartialSemigroupOp.runPartialSemigroupOp' addPos (-1) 4 -- Nothing+--+-- -- A monoid operation for addition with identity 0+-- addM :: 'Data.Associative.MonoidOp.MonoidOp' Int+-- addM = 'Data.Associative.MonoidOp.MonoidOp' ('Data.Associative.SemigroupOp.op' (+)) 0+--+-- 'Data.Associative.MonoidOp.runMonoidOp' addM 3 4        -- 7+-- 'Data.Associative.MonoidOp.identityMonoidOp' addM       -- 0+--+-- -- A partial monoid operation+-- addPM :: 'Data.Associative.PartialMonoidOp.PartialMonoidOp' Int+-- addPM = 'Data.Associative.PartialMonoidOp.PartialMonoidOp' ('Data.Associative.PartialSemigroupOp.total' (+)) 0+--+-- 'Data.Associative.PartialMonoidOp.runPartialMonoidOp' addPM 3 4        -- Just 7+-- 'Data.Associative.PartialMonoidOp.identityPartialMonoidOp' addPM       -- 0+-- @+--+-- == Smart constructors+--+-- === SemigroupOp+--+-- ['Data.Associative.SemigroupOp.op'] Lift a pure function @(a -> a -> b)@ into a semigroup operation+--+-- ['Data.Associative.SemigroupOp.semigroupSemigroup'] Lift a 'Semigroup' class instance: @semigroupSemigroup = op ('<>')@+--+-- === PartialSemigroupOp+--+-- ['Data.Associative.PartialSemigroupOp.total'] Lift a total pure function @(a -> a -> b)@ into a partial semigroup that always succeeds+--+-- ['Data.Associative.PartialSemigroupOp.totalT'] Lift an effectful total function @(a -> a -> f b)@+--+-- ['Data.Associative.PartialSemigroupOp.psemigroupSemigroup'] Lift a 'Semigroup' class instance: @psemigroupSemigroup = total ('<>')@+--+-- ['Data.Associative.PartialSemigroupOp.null'] The always-undefined partial semigroup+--+-- === MonoidOp+--+-- ['Data.Associative.MonoidOp.monoid'] Lift a 'Monoid' class instance+--+-- ['Data.Associative.MonoidOp.MonoidOp'] Directly pair a 'Data.Associative.SemigroupOp.SemigroupOp'' with its identity element+--+-- === PartialMonoidOp+--+-- ['Data.Associative.PartialMonoidOp.pmonoid'] Lift a 'Monoid' class instance+--+-- ['Data.Associative.PartialMonoidOp.PartialMonoidOp'] Directly pair a 'Data.Associative.PartialSemigroupOp.PartialSemigroupOp'' with its identity element+--+-- == Typeclass instances+--+-- The semigroup types carry a rich set of instances. The monoid types provide+-- classy optics into their underlying semigroup.+--+-- === SemigroupOpT instances+--+-- 'Functor', 'Data.Functor.Apply.Apply', 'Applicative', 'Data.Functor.Bind.Bind', 'Monad', 'Data.Profunctor.Profunctor', 'Data.Profunctor.Strong', 'Data.Profunctor.Choice',+-- 'Data.Semigroupoid.Semigroupoid', 'Semigroup', 'Monoid', 'Control.Selective.Selective', 'Data.Functor.Extend.Extend', 'Control.Lens.Wrapped', 'Control.Lens.Rewrapped',+-- 'Control.Monad.Reader.Class.MonadReader', 'Control.Monad.Error.Class.MonadError', 'Control.Monad.State.Class.MonadState', 'Control.Monad.Writer.Class.MonadWriter', 'Control.Monad.RWS.Class.MonadRWS', 'Control.Monad.IO.Class.MonadIO',+-- 'Control.Monad.Cont.Class.MonadCont', 'Data.Functor.Alt.Alt', 'Data.Functor.Plus.Plus'.+--+-- === PartialSemigroupOpT instances+--+-- All of the above, plus: 'MonadFail', 'Control.Applicative.Alternative', 'Control.Monad.MonadPlus', 'Witherable.Filterable'.+--+-- These additional instances exploit the 'Maybe' layer in @f (Maybe b)@ to+-- express failure and filtering. They are not available on 'Data.Associative.SemigroupOp.SemigroupOpT'+-- because a total operation always produces a result.+--+-- === Semantic differences+--+-- The 'Semigroup' and 'Monoid' instances differ between the two semigroup types:+--+-- ['Data.Associative.PartialSemigroupOp.PartialSemigroupOpT'] First-success fallback. @p '<>' q@ tries @p@ first;+--   if it returns 'Nothing', falls back to @q@. 'mempty' is the+--   always-undefined operation.+--+-- ['Data.Associative.SemigroupOp.SemigroupOpT'] Pointwise combination. @p '<>' q@ runs both and combines+--   their results via the inner 'Semigroup'. 'mempty' returns 'mempty' of the+--   result type. Requires @'Semigroup' b@ \/ @'Monoid' b@ on the result.+--+-- === Classy optics on monoid types+--+-- 'Data.Associative.MonoidOp.MonoidOp' has a 'Data.Associative.SemigroupOp.HasSemigroupOpT' instance giving lens access to the+-- underlying 'Data.Associative.SemigroupOp.SemigroupOp''. 'Data.Associative.PartialMonoidOp.PartialMonoidOp' has a 'Data.Associative.PartialSemigroupOp.HasPartialSemigroupOpT'+-- instance for the same purpose.+--+-- == Pre-defined values+--+-- All four modules export named values for common operations.+--+-- === Via class instance+--+-- @Unit@, @Void@ (semigroups only), @Ordering@, @List@, @NonEmpty@ (semigroups only), @Either@ (semigroups only),+-- @Proxy@, @Maybe@, @Dual@, @Down@, @Identity@, @Tuple@, @WrappedMonoid@,+-- @Function@, @Alt@, @Alternative@.+--+-- === Via op \/ total+--+-- @First@, @Last@ (semigroups only), @Min@, @Max@, @All@, @Any@, @Addition@, @Multiplication@, @Endo@,+-- @And@ (bitwise), @Ior@, @Xor@, @Iff@ (XNOR).+--+-- === Collection operations+--+-- Union and intersection for 'Data.Set.Set', 'Data.IntSet.IntSet', 'Data.HashSet.HashSet', 'Data.Map.Map', 'Data.IntMap.IntMap',+-- 'Data.HashMap.Strict.HashMap'. Monoid types provide union only (intersection lacks a general+-- identity element).+--+-- == Classy optics+--+-- Each semigroup module exports a classy lens and a classy prism:+--+-- @+-- class 'Data.Associative.SemigroupOp.HasSemigroupOpT' c f a b | c -> f a b where+--   'Data.Associative.SemigroupOp.semigroupOpT' :: Lens' c ('Data.Associative.SemigroupOp.SemigroupOpT' f a b)+--+-- class 'Data.Associative.SemigroupOp.AsSemigroupOpT' c f a b | c -> f a b where+--   'Data.Associative.SemigroupOp._SemigroupOpT' :: Prism' c ('Data.Associative.SemigroupOp.SemigroupOpT' f a b)+-- @+--+-- @+-- class 'Data.Associative.PartialSemigroupOp.HasPartialSemigroupOpT' c f a b | c -> f a b where+--   'Data.Associative.PartialSemigroupOp.partialSemigroupOpT' :: Lens' c ('Data.Associative.PartialSemigroupOp.PartialSemigroupOpT' f a b)+--+-- class 'Data.Associative.PartialSemigroupOp.AsPartialSemigroupOpT' c f a b | c -> f a b where+--   'Data.Associative.PartialSemigroupOp._PartialSemigroupOpT' :: Prism' c ('Data.Associative.PartialSemigroupOp.PartialSemigroupOpT' f a b)+-- @+--+-- Each monoid module exports its own classy lens and prism:+--+-- @+-- class 'Data.Associative.MonoidOp.HasMonoidOp' c a | c -> a where+--   'Data.Associative.MonoidOp.monoidOp' :: Lens' c ('Data.Associative.MonoidOp.MonoidOp' a)+--+-- class 'Data.Associative.MonoidOp.AsMonoidOp' c a | c -> a where+--   'Data.Associative.MonoidOp._MonoidOp' :: Prism' c ('Data.Associative.MonoidOp.MonoidOp' a)+-- @+--+-- @+-- class 'Data.Associative.PartialMonoidOp.HasPartialMonoidOp' c a | c -> a where+--   'Data.Associative.PartialMonoidOp.partialMonoidOp' :: Lens' c ('Data.Associative.PartialMonoidOp.PartialMonoidOp' a)+--+-- class 'Data.Associative.PartialMonoidOp.AsPartialMonoidOp' c a | c -> a where+--   'Data.Associative.PartialMonoidOp._PartialMonoidOp' :: Prism' c ('Data.Associative.PartialMonoidOp.PartialMonoidOp' a)+-- @+--+-- == Law-checking functions+--+-- All modules export functions for verifying laws at specific inputs, useful for+-- property-based testing.+--+-- Each module prefixes its law functions with its value prefix+-- (@semigroup@, @psemigroup@, @monoid@, @pmonoid@).+--+-- === Semigroup modules+--+-- * @semigroupLawAssociative@ / @psemigroupLawAssociative@ -- associativity of the binary operation itself+--+-- * @semigroupLawSemigroupAssociative@ / @psemigroupLawSemigroupAssociative@ -- 'Semigroup' instance associativity+--+-- * @semigroupLawMonoidLeftIdentity@ / @psemigroupLawMonoidLeftIdentity@, @semigroupLawMonoidRightIdentity@ / @psemigroupLawMonoidRightIdentity@+--+-- * @semigroupLawFunctorIdentity@ / @psemigroupLawFunctorIdentity@, @semigroupLawFunctorComposition@ / @psemigroupLawFunctorComposition@+--+-- * @semigroupLawProfunctorIdentity@ / @psemigroupLawProfunctorIdentity@+--+-- * @semigroupLawExtendAssociative@ / @psemigroupLawExtendAssociative@+--+-- * @semigroupLawSemigroupoidAssociative@ / @psemigroupLawSemigroupoidAssociative@+--+-- "Data.Associative.PartialSemigroupOp" additionally exports @lawFilterableIdentity@ and+-- @lawFilterableComposition@.+--+-- === Monoid modules+--+-- * @monoidLawAssociative@ / @pmonoidLawAssociative@ -- associativity of the binary operation+--+-- * @monoidLawLeftIdentity@ / @pmonoidLawLeftIdentity@, @monoidLawRightIdentity@ / @pmonoidLawRightIdentity@ -- identity element laws+module Data.Associative (+  module A+) where++import Data.Associative.MonoidOp as A+import Data.Associative.PartialMonoidOp as A+import Data.Associative.PartialSemigroupOp as A+import Data.Associative.SemigroupOp as A

@@ -0,0 +1,508 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall -Werror #-}++-- |+-- A monoid operation is an associative binary operation with an identity element+-- that is defined for all pairs of inputs.+module Data.Associative.MonoidOp+  ( -- * Types+    MonoidOp (..),++    -- * Isomorphism+    iMonoidOp,++    -- * Running+    runMonoidOp,+    identityMonoidOp,++    -- * Smart constructors+    monoid,++    -- * Laws+    monoidLawAssociative,+    monoidLawLeftIdentity,+    monoidLawRightIdentity,++    -- * Classy optics+    HasMonoidOp (..),+    AsMonoidOp (..),++    -- * Values (via monoid)+    monoidUnit,+    monoidOrdering,+    monoidList,+    monoidProxy,+    monoidMaybe,+    monoidDual,+    monoidDown,+    monoidIdentity,+    monoidTuple,+    monoidWrappedMonoid,+    monoidFunction,+    monoidAlt,+    monoidAlternative,++    -- * Values (via MonoidOp)+    monoidMin,+    monoidMax,+    monoidAll,+    monoidAny,+    monoidAddition,+    monoidMultiplication,+    monoidEndo,+    monoidAnd,+    monoidIor,+    monoidXor,+    monoidIff,++    -- * Collection values+    monoidSetUnion,+    monoidIntSetUnion,+    monoidHashSetUnion,+    monoidMapUnion,+    monoidIntMapUnion,+    monoidHashMapUnion,+  )+where++import Control.Applicative (Alternative (..))+import Control.Lens+  ( Iso,+    Lens',+    Prism',+    iso,+    lens,+  )+import Data.Associative.SemigroupOp (HasSemigroupOpT (..), SemigroupOp', op, runSemigroupOp)+import qualified Data.Associative.SemigroupOp as SG (semigroupSemigroup)+import Data.Bits (Bits, FiniteBits, complement, xor, zeroBits, (.&.), (.|.))+import Data.Functor.Alt (Alt (..))+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 (SemigroupOpT(..), op)+-- >>> 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 = MonoidOp (op (+)) 0 :: MonoidOp Int+-- >>> let run = runMonoidOp++-- | A monoid operation: an associative binary operation with an identity element,+-- defined for all pairs of inputs.+--+-- >>> run add 3 4+-- 7+-- >>> identityMonoidOp add+-- 0+data MonoidOp a = MonoidOp (SemigroupOp' a) a+  deriving (Generic)++-- | Iso between 'MonoidOp' and a @(binary-operation, identity)@ pair.+--+-- >>> let (f, e) = view iMonoidOp add+-- >>> f 3 4+-- 7+-- >>> e+-- 0+iMonoidOp :: Iso (MonoidOp a) (MonoidOp b) (a -> a -> a, a) (b -> b -> b, b)+iMonoidOp =+  iso+    (\(MonoidOp s e) -> (runSemigroupOp s, e))+    (\(f, e) -> MonoidOp (op f) e)+{-# INLINE iMonoidOp #-}++-- | Extract the binary operation and run it.+--+-- >>> runMonoidOp add 3 4+-- 7+runMonoidOp :: MonoidOp a -> a -> a -> a+runMonoidOp (MonoidOp s _) = runSemigroupOp s+{-# INLINE runMonoidOp #-}++-- | Extract the identity element.+--+-- >>> identityMonoidOp add+-- 0+-- >>> identityMonoidOp monoidList+-- []+identityMonoidOp :: MonoidOp a -> a+identityMonoidOp (MonoidOp _ e) = e+{-# INLINE identityMonoidOp #-}++-- | Build a 'MonoidOp' from any 'Monoid' instance.+--+-- >>> run (monoid :: MonoidOp [Int]) [1,2] [3,4]+-- [1,2,3,4]+-- >>> identityMonoidOp (monoid :: MonoidOp [Int])+-- []+monoid :: (Monoid a) => MonoidOp a+monoid = MonoidOp SG.semigroupSemigroup mempty+{-# INLINE monoid #-}++-- | Classy lens giving access to the underlying 'SemigroupOpT'.+--+-- >>> import Data.Associative.SemigroupOp (runSemigroupOp)+-- >>> runSemigroupOp (view semigroupOpT add) 3 4+-- 7+instance HasSemigroupOpT (MonoidOp a) Identity a a where+  semigroupOpT = lens (\(MonoidOp s _) -> s) (\(MonoidOp _ e) s' -> MonoidOp s' e)++{- HLINT ignore "Monoid law, left identity" -}+{- HLINT ignore "Monoid law, right identity" -}++----+-- Law-checking functions+----++-- | Associativity: @f (f x y) z == f x (f y z)@+--+-- >>> monoidLawAssociative add 1 2 3+-- True+monoidLawAssociative :: (Eq a) => MonoidOp a -> a -> a -> a -> Bool+monoidLawAssociative m x y z =+  let f = runMonoidOp m+   in f (f x y) z == f x (f y z)++-- | Left identity: @f e a == a@+--+-- >>> monoidLawLeftIdentity add 42+-- True+-- >>> monoidLawLeftIdentity monoidList [1,2,3 :: Int]+-- True+monoidLawLeftIdentity :: (Eq a) => MonoidOp a -> a -> Bool+monoidLawLeftIdentity m a =+  runMonoidOp m (identityMonoidOp m) a == a++-- | Right identity: @f a e == a@+--+-- >>> monoidLawRightIdentity add 42+-- True+-- >>> monoidLawRightIdentity monoidList [1,2,3 :: Int]+-- True+monoidLawRightIdentity :: (Eq a) => MonoidOp a -> a -> Bool+monoidLawRightIdentity m a =+  runMonoidOp m a (identityMonoidOp m) == a++-- | Classy lens for types that contain a 'MonoidOp'.+--+-- >>> run (view monoidOp add) 3 4+-- 7+class HasMonoidOp c a | c -> a where+  monoidOp :: Lens' c (MonoidOp a)++instance HasMonoidOp (MonoidOp a) a where+  monoidOp = id++-- | Classy prism for types that can be constructed from a 'MonoidOp'.+--+-- >>> run (review _MonoidOp add) 3 4+-- 7+class AsMonoidOp c a | c -> a where+  _MonoidOp :: Prism' c (MonoidOp a)++instance AsMonoidOp (MonoidOp a) a where+  _MonoidOp = id++----+-- MonoidOp values via monoid+----++-- | >>> run monoidUnit () ()+-- ()+-- >>> identityMonoidOp monoidUnit+-- ()+monoidUnit :: MonoidOp ()+monoidUnit = monoid++-- | Lexicographic composition of orderings.+--+-- >>> run monoidOrdering LT GT+-- LT+-- >>> run monoidOrdering EQ GT+-- GT+-- >>> identityMonoidOp monoidOrdering+-- EQ+monoidOrdering :: MonoidOp Ordering+monoidOrdering = monoid++-- | List concatenation.+--+-- >>> run monoidList [1,2] [3,4 :: Int]+-- [1,2,3,4]+-- >>> identityMonoidOp monoidList+-- []+monoidList :: MonoidOp [a]+monoidList = monoid++-- | >>> run monoidProxy Proxy (Proxy :: Proxy Int)+-- Proxy+-- >>> identityMonoidOp monoidProxy+-- Proxy+monoidProxy :: MonoidOp (Proxy a)+monoidProxy = monoid++-- | 'Nothing' is identity; 'Just' values are combined.+--+-- >>> run monoidMaybe (Just [1]) (Just [2 :: Int])+-- Just [1,2]+-- >>> run monoidMaybe Nothing (Just [2 :: Int])+-- Just [2]+-- >>> identityMonoidOp monoidMaybe+-- Nothing+monoidMaybe :: (Semigroup a) => MonoidOp (Maybe a)+monoidMaybe = monoid++-- | Reverses the inner monoid.+--+-- >>> run monoidDual (Dual [1]) (Dual [2 :: Int])+-- Dual {getDual = [2,1]}+-- >>> identityMonoidOp (monoidDual :: MonoidOp (Dual [Int]))+-- Dual {getDual = []}+monoidDual :: (Monoid a) => MonoidOp (Dual a)+monoidDual = monoid++-- | Delegates through 'Down'.+--+-- >>> run monoidDown (Down [1]) (Down [2 :: Int])+-- Down [1,2]+monoidDown :: (Monoid a) => MonoidOp (Down a)+monoidDown = monoid++-- | Delegates through 'Identity'.+--+-- >>> run monoidIdentity (Identity [1]) (Identity [2 :: Int])+-- Identity [1,2]+monoidIdentity :: (Monoid a) => MonoidOp (Identity a)+monoidIdentity = monoid++-- | Pairwise combination.+--+-- >>> run monoidTuple ([1 :: Int], [10]) ([2], [20 :: Int])+-- ([1,2],[10,20])+-- >>> identityMonoidOp (monoidTuple :: MonoidOp ([Int], [Int]))+-- ([],[])+monoidTuple :: (Monoid a, Monoid b) => MonoidOp (a, b)+monoidTuple = monoid++-- | Uses the underlying 'Monoid' operation.+--+-- >>> run monoidWrappedMonoid (WrapMonoid [1]) (WrapMonoid [2 :: Int])+-- WrapMonoid {unwrapMonoid = [1,2]}+monoidWrappedMonoid :: (Monoid a) => MonoidOp (WrappedMonoid a)+monoidWrappedMonoid = monoid++-- | Pointwise combination.+--+-- >>> run monoidFunction (++ "a") ((++ "b") :: String -> String) "x"+-- "xaxb"+monoidFunction :: (Monoid b) => MonoidOp (a -> b)+monoidFunction = monoid++-- | First-success on 'Maybe' via 'Alt'.+--+-- >>> run monoidAlt (Just 1) (Just 2 :: Maybe Int)+-- Just 1+-- >>> run monoidAlt Nothing (Just 2 :: Maybe Int)+-- Just 2+-- >>> identityMonoidOp monoidAlt+-- Nothing+monoidAlt :: MonoidOp (Maybe a)+monoidAlt = MonoidOp (op (<!>)) Nothing++-- | First-success on 'Maybe' via 'Alternative'.+--+-- >>> run monoidAlternative (Just 1) (Just 2 :: Maybe Int)+-- Just 1+-- >>> run monoidAlternative Nothing (Just 2 :: Maybe Int)+-- Just 2+-- >>> identityMonoidOp monoidAlternative+-- Nothing+monoidAlternative :: MonoidOp (Maybe a)+monoidAlternative = MonoidOp (op (<|>)) Nothing++----+-- MonoidOp values via MonoidOp constructor+----++-- | Takes the minimum ('Min'). Requires 'Bounded' for 'maxBound' identity.+--+-- >>> run monoidMin (3 :: Int) 4+-- 3+-- >>> identityMonoidOp monoidMin == (maxBound :: Int)+-- True+monoidMin :: (Ord a, Bounded a) => MonoidOp a+monoidMin = MonoidOp (op min) maxBound++-- | Takes the maximum ('Max'). Requires 'Bounded' for 'minBound' identity.+--+-- >>> run monoidMax (3 :: Int) 4+-- 4+-- >>> identityMonoidOp monoidMax == (minBound :: Int)+-- True+monoidMax :: (Ord a, Bounded a) => MonoidOp a+monoidMax = MonoidOp (op max) minBound++-- | Logical conjunction ('All'). Identity is 'True'.+--+-- >>> run monoidAll True True+-- True+-- >>> run monoidAll True False+-- False+-- >>> identityMonoidOp monoidAll+-- True+monoidAll :: MonoidOp Bool+monoidAll = MonoidOp (op (&&)) True++-- | Logical disjunction ('Any'). Identity is 'False'.+--+-- >>> run monoidAny False False+-- False+-- >>> run monoidAny False True+-- True+-- >>> identityMonoidOp monoidAny+-- False+monoidAny :: MonoidOp Bool+monoidAny = MonoidOp (op (||)) False++-- | Addition ('Sum'). Identity is 0.+--+-- >>> run monoidAddition (3 :: Int) 4+-- 7+-- >>> identityMonoidOp monoidAddition+-- 0+monoidAddition :: (Num a) => MonoidOp a+monoidAddition = MonoidOp (op (+)) 0++-- | Multiplication ('Product'). Identity is 1.+--+-- >>> run monoidMultiplication (3 :: Int) 4+-- 12+-- >>> identityMonoidOp monoidMultiplication+-- 1+monoidMultiplication :: (Num a) => MonoidOp a+monoidMultiplication = MonoidOp (op (*)) 1++-- | Function composition ('Endo'). Identity is 'id'.+--+-- >>> run monoidEndo (+1) ((*10) :: Int -> Int) 3+-- 31+-- >>> identityMonoidOp monoidEndo 42+-- 42+monoidEndo :: MonoidOp (a -> a)+monoidEndo = MonoidOp (op (.)) id++-- | Bitwise AND. Identity is all ones ('complement' 'zeroBits').+--+-- >>> run monoidAnd (0xFF :: Word8) 0x0F+-- 15+-- >>> identityMonoidOp monoidAnd == (0xFF :: Word8)+-- True+monoidAnd :: (Bits a) => MonoidOp a+monoidAnd = MonoidOp (op (.&.)) (complement zeroBits)++-- | Bitwise inclusive OR. Identity is 'zeroBits'.+--+-- >>> run monoidIor (0xF0 :: Word8) 0x0F+-- 255+-- >>> identityMonoidOp monoidIor == (0 :: Word8)+-- True+monoidIor :: (Bits a) => MonoidOp a+monoidIor = MonoidOp (op (.|.)) zeroBits++-- | Bitwise exclusive OR. Identity is 'zeroBits'.+--+-- >>> run monoidXor (0xFF :: Word8) 0x0F+-- 240+-- >>> identityMonoidOp monoidXor == (0 :: Word8)+-- True+monoidXor :: (Bits a) => MonoidOp a+monoidXor = MonoidOp (op xor) zeroBits++-- | Bitwise equivalence / XNOR. Identity is all ones ('complement' 'zeroBits').+--+-- >>> run monoidIff (0xFF :: Word8) 0x0F+-- 15+-- >>> identityMonoidOp monoidIff == (0xFF :: Word8)+-- True+monoidIff :: (FiniteBits a) => MonoidOp a+monoidIff = MonoidOp (op (\a b -> complement (xor a b))) (complement zeroBits)++----+-- Collection values+----++-- | Set union. Identity is 'Set.empty'.+--+-- >>> run monoidSetUnion (Set.fromList [1,2]) (Set.fromList [2,3 :: Int])+-- fromList [1,2,3]+-- >>> identityMonoidOp monoidSetUnion == (Set.empty :: Set Int)+-- True+monoidSetUnion :: (Ord a) => MonoidOp (Set a)+monoidSetUnion = MonoidOp (op Set.union) Set.empty++-- | IntSet union. Identity is 'IntSet.empty'.+--+-- >>> run monoidIntSetUnion (IntSet.fromList [1,2]) (IntSet.fromList [2,3])+-- fromList [1,2,3]+-- >>> identityMonoidOp monoidIntSetUnion == IntSet.empty+-- True+monoidIntSetUnion :: MonoidOp IntSet+monoidIntSetUnion = MonoidOp (op IntSet.union) IntSet.empty++-- | HashSet union. Identity is 'HashSet.empty'.+--+-- >>> sort (HashSet.toList (run monoidHashSetUnion (HashSet.fromList [1,2]) (HashSet.fromList [2,3 :: Int])))+-- [1,2,3]+monoidHashSetUnion :: (Eq a, Hashable a) => MonoidOp (HashSet a)+monoidHashSetUnion = MonoidOp (op HashSet.union) HashSet.empty++-- | Map union (left-biased on overlapping keys). Identity is 'Map.empty'.+--+-- >>> run monoidMapUnion (Map.fromList [(1 :: Int,'a'),(2,'b')]) (Map.fromList [(2,'x'),(3,'c')])+-- fromList [(1,'a'),(2,'b'),(3,'c')]+monoidMapUnion :: (Ord k) => MonoidOp (Map k v)+monoidMapUnion = MonoidOp (op Map.union) Map.empty++-- | IntMap union (left-biased on overlapping keys). Identity is 'IntMap.empty'.+--+-- >>> run monoidIntMapUnion (IntMap.fromList [(1,'a'),(2,'b')]) (IntMap.fromList [(2,'x'),(3,'c')])+-- fromList [(1,'a'),(2,'b'),(3,'c')]+monoidIntMapUnion :: MonoidOp (IntMap v)+monoidIntMapUnion = MonoidOp (op IntMap.union) IntMap.empty++-- | HashMap union (left-biased on overlapping keys). Identity is 'HashMap.empty'.+--+-- >>> sort (HashMap.toList (run monoidHashMapUnion (HashMap.fromList [(1 :: Int,'a'),(2,'b')]) (HashMap.fromList [(2,'x'),(3,'c')])))+-- [(1,'a'),(2,'b'),(3,'c')]+monoidHashMapUnion :: (Eq k, Hashable k) => MonoidOp (HashMap k v)+monoidHashMapUnion = MonoidOp (op HashMap.union) HashMap.empty

@@ -0,0 +1,524 @@+{-# 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+    PartialMonoidOp (..),++    -- * Isomorphism+    iPartialMonoidOp,++    -- * Running+    runPartialMonoidOp,+    identityPartialMonoidOp,++    -- * Smart constructors+    pmonoid,++    -- * Laws+    pmonoidLawAssociative,+    pmonoidLawLeftIdentity,+    pmonoidLawRightIdentity,++    -- * Classy optics+    HasPartialMonoidOp (..),+    AsPartialMonoidOp (..),++    -- * Values (via pmonoid)+    pmonoidUnit,+    pmonoidOrdering,+    pmonoidList,+    pmonoidProxy,+    pmonoidMaybe,+    pmonoidDual,+    pmonoidDown,+    pmonoidIdentity,+    pmonoidTuple,+    pmonoidWrappedMonoid,+    pmonoidFunction,+    pmonoidAlt,+    pmonoidAlternative,++    -- * Values (via PartialMonoidOp)+    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,+  )+import Data.Associative.PartialSemigroupOp+  ( HasPartialSemigroupOpT (..),+    PartialSemigroupOp',+    iPartialSemigroupOp,+    runPartialSemigroupOp,+    psemigroupSemigroup,+    total,+  )+import Data.Bits (Bits, FiniteBits, complement, xor, zeroBits, (.&.), (.|.))+import Data.Functor.Alt (Alt (..))+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.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 = PartialMonoidOp (total (+)) 0 :: PartialMonoidOp Int+-- >>> let run = runPartialMonoidOp++-- | A partial monoid operation: an associative binary operation with an identity+-- element, not necessarily defined for all pairs of inputs.+--+-- >>> run add 3 4+-- Just 7+-- >>> identityPartialMonoidOp add+-- 0+data PartialMonoidOp a = PartialMonoidOp (PartialSemigroupOp' a) a+  deriving (Generic)++-- | Iso between 'PartialMonoidOp' and a @(partial-binary-operation, identity)@ pair.+--+-- >>> let (f, e) = view iPartialMonoidOp add+-- >>> f 3 4+-- Just 7+-- >>> e+-- 0+iPartialMonoidOp :: Iso (PartialMonoidOp a) (PartialMonoidOp b) (a -> a -> Maybe a, a) (b -> b -> Maybe b, b)+iPartialMonoidOp =+  iso+    (\(PartialMonoidOp s e) -> (runPartialSemigroupOp s, e))+    (\(f, e) -> PartialMonoidOp (review iPartialSemigroupOp f) e)+{-# INLINE iPartialMonoidOp #-}++-- | Extract the partial binary operation and run it.+--+-- >>> runPartialMonoidOp add 3 4+-- Just 7+runPartialMonoidOp :: PartialMonoidOp a -> a -> a -> Maybe a+runPartialMonoidOp (PartialMonoidOp s _) = runPartialSemigroupOp s+{-# INLINE runPartialMonoidOp #-}++-- | Extract the identity element.+--+-- >>> identityPartialMonoidOp add+-- 0+-- >>> identityPartialMonoidOp pmonoidList+-- []+identityPartialMonoidOp :: PartialMonoidOp a -> a+identityPartialMonoidOp (PartialMonoidOp _ 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 = PartialMonoidOp 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 (PartialMonoidOp a) Identity a a where+  partialSemigroupOpT = lens (\(PartialMonoidOp s _) -> s) (\(PartialMonoidOp _ e) s' -> PartialMonoidOp 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'.+--+-- >>> pmonoidLawAssociative add 1 2 3+-- True+pmonoidLawAssociative :: (Eq a) => PartialMonoidOp a -> a -> a -> a -> Bool+pmonoidLawAssociative m x y z =+  let f = runPartialMonoidOp m+      lhs = case f x y of+        Nothing -> Nothing+        Just xy -> f xy z+      rhs = case f y z of+        Nothing -> Nothing+        Just yz -> f x yz+   in lhs == rhs++-- | Left identity: @f e a == Just a@+--+-- >>> pmonoidLawLeftIdentity add 42+-- True+-- >>> pmonoidLawLeftIdentity pmonoidList [1,2,3 :: Int]+-- True+pmonoidLawLeftIdentity :: (Eq a) => PartialMonoidOp a -> a -> Bool+pmonoidLawLeftIdentity m a =+  runPartialMonoidOp m (identityPartialMonoidOp m) a == Just a++-- | Right identity: @f a e == Just a@+--+-- >>> pmonoidLawRightIdentity add 42+-- True+-- >>> pmonoidLawRightIdentity pmonoidList [1,2,3 :: Int]+-- True+pmonoidLawRightIdentity :: (Eq a) => PartialMonoidOp a -> a -> Bool+pmonoidLawRightIdentity m a =+  runPartialMonoidOp m a (identityPartialMonoidOp m) == Just a++-- | Classy lens for types that contain a 'PartialMonoidOp'.+--+-- >>> run (view partialMonoidOp add) 3 4+-- Just 7+class HasPartialMonoidOp c a | c -> a where+  partialMonoidOp :: Lens' c (PartialMonoidOp a)++instance HasPartialMonoidOp (PartialMonoidOp a) a where+  partialMonoidOp = id++-- | Classy prism for types that can be constructed from a 'PartialMonoidOp'.+--+-- >>> run (review _PartialMonoidOp add) 3 4+-- Just 7+class AsPartialMonoidOp c a | c -> a where+  _PartialMonoidOp :: Prism' c (PartialMonoidOp a)++instance AsPartialMonoidOp (PartialMonoidOp a) a where+  _PartialMonoidOp = 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 (Just [1]) (Just [2 :: Int])+-- Just (Just [1,2])+-- >>> run pmonoidMaybe Nothing (Just [2 :: Int])+-- Just (Just [2])+-- >>> identityPartialMonoidOp pmonoidMaybe+-- Nothing+pmonoidMaybe :: (Semigroup a) => PartialMonoidOp (Maybe a)+pmonoidMaybe = pmonoid++-- | Reverses the inner monoid.+--+-- >>> run pmonoidDual (Dual [1]) (Dual [2 :: Int])+-- Just (Dual {getDual = [2,1]})+-- >>> identityPartialMonoidOp (pmonoidDual :: PartialMonoidOp (Dual [Int]))+-- Dual {getDual = []}+pmonoidDual :: (Monoid a) => PartialMonoidOp (Dual a)+pmonoidDual = pmonoid++-- | Delegates through 'Down'.+--+-- >>> run pmonoidDown (Down [1]) (Down [2 :: Int])+-- Just (Down [1,2])+pmonoidDown :: (Monoid a) => PartialMonoidOp (Down a)+pmonoidDown = pmonoid++-- | Delegates through 'Identity'.+--+-- >>> run pmonoidIdentity (Identity [1]) (Identity [2 :: Int])+-- Just (Identity [1,2])+pmonoidIdentity :: (Monoid a) => PartialMonoidOp (Identity a)+pmonoidIdentity = pmonoid++-- | Pairwise combination.+--+-- >>> run pmonoidTuple ([1 :: Int], [10]) ([2], [20 :: Int])+-- Just ([1,2],[10,20])+-- >>> identityPartialMonoidOp (pmonoidTuple :: PartialMonoidOp ([Int], [Int]))+-- ([],[])+pmonoidTuple :: (Monoid a, Monoid b) => PartialMonoidOp (a, b)+pmonoidTuple = pmonoid++-- | Uses the underlying 'Monoid' operation.+--+-- >>> run pmonoidWrappedMonoid (WrapMonoid [1]) (WrapMonoid [2 :: Int])+-- Just (WrapMonoid {unwrapMonoid = [1,2]})+pmonoidWrappedMonoid :: (Monoid a) => PartialMonoidOp (WrappedMonoid a)+pmonoidWrappedMonoid = pmonoid++-- | Pointwise combination.+--+-- >>> fmap ($ "x") (run pmonoidFunction (++ "a") ((++ "b") :: String -> String))+-- Just "xaxb"+pmonoidFunction :: (Monoid b) => PartialMonoidOp (a -> b)+pmonoidFunction = pmonoid++-- | 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 = PartialMonoidOp (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 = PartialMonoidOp (total (<|>)) Nothing++----+-- PartialMonoidOp values via PartialMonoidOp 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 = PartialMonoidOp (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 = PartialMonoidOp (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 = PartialMonoidOp (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 = PartialMonoidOp (total (||)) False++-- | Addition ('Sum'). Identity is 0.+--+-- >>> run pmonoidAddition (3 :: Int) 4+-- Just 7+-- >>> identityPartialMonoidOp pmonoidAddition+-- 0+pmonoidAddition :: (Num a) => PartialMonoidOp a+pmonoidAddition = PartialMonoidOp (total (+)) 0++-- | Multiplication ('Product'). Identity is 1.+--+-- >>> run pmonoidMultiplication (3 :: Int) 4+-- Just 12+-- >>> identityPartialMonoidOp pmonoidMultiplication+-- 1+pmonoidMultiplication :: (Num a) => PartialMonoidOp a+pmonoidMultiplication = PartialMonoidOp (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 = PartialMonoidOp (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 = PartialMonoidOp (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 = PartialMonoidOp (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 = PartialMonoidOp (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 = PartialMonoidOp (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 = PartialMonoidOp (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 = PartialMonoidOp (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 = PartialMonoidOp (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 = PartialMonoidOp (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 = PartialMonoidOp (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 = PartialMonoidOp (total HashMap.union) HashMap.empty

@@ -0,0 +1,972 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall -Werror #-}++-- |+-- A partial semigroup operation is an associative binary operation that is not+-- defined for all pairs of inputs.+module Data.Associative.PartialSemigroupOp+  ( -- * Types+    PartialSemigroupOpT (..),+    PartialSemigroupOp,+    PartialSemigroupOpT',+    PartialSemigroupOp',++    -- * Isomorphisms+    iPartialSemigroupOpT,+    iPartialSemigroupOp,++    -- * Running+    runPartialSemigroupOpT,+    runPartialSemigroupOp,++    -- * Smart constructors+    totalT,+    total,+    psemigroupSemigroup,+    null,++    -- * Laws+    psemigroupLawAssociative,+    psemigroupLawSemigroupAssociative,+    psemigroupLawMonoidLeftIdentity,+    psemigroupLawMonoidRightIdentity,+    psemigroupLawFunctorIdentity,+    psemigroupLawFunctorComposition,+    psemigroupLawProfunctorIdentity,+    lawFilterableIdentity,+    lawFilterableComposition,+    psemigroupLawExtendAssociative,+    psemigroupLawSemigroupoidAssociative,++    -- * Classy optics+    HasPartialSemigroupOpT (..),+    AsPartialSemigroupOpT (..),++    -- * Values (via semigroup)+    psemigroupUnit,+    psemigroupVoid,+    psemigroupOrdering,+    psemigroupList,+    psemigroupNonEmpty,+    psemigroupEither,+    psemigroupProxy,+    psemigroupMaybe,+    psemigroupDual,+    psemigroupDown,+    psemigroupIdentity,+    psemigroupTuple,+    psemigroupWrappedMonoid,+    psemigroupFunction,+    psemigroupAlt,+    psemigroupAlternative,++    -- * Values (via total)+    psemigroupFirst,+    psemigroupLast,+    psemigroupMin,+    psemigroupMax,+    psemigroupAll,+    psemigroupAny,+    psemigroupAddition,+    psemigroupMultiplication,+    psemigroupEndo,+    psemigroupAnd,+    psemigroupIor,+    psemigroupXor,+    psemigroupIff,++    -- * Collection values+    psemigroupSetUnion,+    psemigroupSetIntersection,+    psemigroupIntSetUnion,+    psemigroupIntSetIntersection,+    psemigroupHashSetUnion,+    psemigroupHashSetIntersection,+    psemigroupMapUnion,+    psemigroupMapIntersection,+    psemigroupIntMapUnion,+    psemigroupIntMapIntersection,+    psemigroupHashMapUnion,+    psemigroupHashMapIntersection,+  )+where++import Control.Applicative (Alternative (..))+import Control.Lens+  ( Iso,+    Lens',+    Prism',+    Rewrapped,+    Wrapped (..),+    iso,+    review,+    view,+    _Wrapped,+  )+import Control.Monad (MonadPlus, (>=>))+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 (..))+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)+import Witherable (Filterable (mapMaybe))+import Prelude hiding (null)++-- $setup+-- >>> :set -Wno-name-shadowing+-- >>> 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 Witherable (mapMaybe)+-- >>> 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 addPos = PartialSemigroupOpT (\a b -> Identity (if a > 0 && b > 0 then Just (a + b) else Nothing)) :: PartialSemigroupOp' Int+-- >>> let total = PartialSemigroupOpT (\a b -> Identity (Just (a + b))) :: PartialSemigroupOp' Int+-- >>> let run = runPartialSemigroupOp++-- | A partial semigroup transformer. The wrapped operation must be associative+-- (see 'psemigroupLawAssociative').+--+-- >>> run addPos 3 4+-- Just 7+-- >>> run addPos (-1) 4+-- Nothing+newtype PartialSemigroupOpT f a b = PartialSemigroupOpT (a -> a -> f (Maybe b))+  deriving (Generic, Generic1)++-- | A partial semigroup using 'Identity' as the base functor.+type PartialSemigroupOp a b = PartialSemigroupOpT Identity a b++-- | A partial semigroup transformer where input and output types coincide.+type PartialSemigroupOpT' f x = PartialSemigroupOpT f x x++-- | A partial semigroup where input and output types coincide.+type PartialSemigroupOp' x = PartialSemigroupOp x x++-- | Iso between 'PartialSemigroupOpT' and its underlying function.+--+-- >>> view iPartialSemigroupOpT addPos 3 4+-- Identity (Just 7)+iPartialSemigroupOpT :: Iso (PartialSemigroupOpT f a b) (PartialSemigroupOpT f' a' b') (a -> a -> f (Maybe b)) (a' -> a' -> f' (Maybe b'))+iPartialSemigroupOpT = _Wrapped+{-# INLINE iPartialSemigroupOpT #-}++-- | Iso between 'PartialSemigroupOp' and a pure partial function.+--+-- >>> view iPartialSemigroupOp addPos 3 4+-- Just 7+iPartialSemigroupOp :: Iso (PartialSemigroupOp a b) (PartialSemigroupOp a' b') (a -> a -> Maybe b) (a' -> a' -> Maybe b')+iPartialSemigroupOp =+  iso+    (\(PartialSemigroupOpT j) a1 a2 -> runIdentity (j a1 a2))+    (\k -> PartialSemigroupOpT (\a1 a2 -> Identity (k a1 a2)))+{-# INLINE iPartialSemigroupOp #-}++-- | Unwrap a 'PartialSemigroupOpT' to its underlying function.+--+-- >>> runPartialSemigroupOpT addPos 3 4+-- Identity (Just 7)+-- >>> runPartialSemigroupOpT addPos (-1) 4+-- Identity Nothing+runPartialSemigroupOpT :: PartialSemigroupOpT f a b -> a -> a -> f (Maybe b)+runPartialSemigroupOpT = view iPartialSemigroupOpT+{-# INLINE runPartialSemigroupOpT #-}++-- | Run a 'PartialSemigroupOp' (specialised to 'Identity').+--+-- >>> runPartialSemigroupOp addPos 3 4+-- Just 7+-- >>> runPartialSemigroupOp addPos (-1) 4+-- Nothing+runPartialSemigroupOp :: PartialSemigroupOp a b -> a -> a -> Maybe b+runPartialSemigroupOp = view iPartialSemigroupOp+{-# INLINE runPartialSemigroupOp #-}++totalT :: (Functor f) => (a -> a -> f b) -> PartialSemigroupOpT f a b+totalT k = PartialSemigroupOpT (\a1 a2 -> Just <$> k a1 a2)+{-# INLINE totalT #-}++total :: (a -> a -> b) -> PartialSemigroupOp a b+total k = review iPartialSemigroupOp (\a1 a2 -> Just (k a1 a2))+{-# INLINE total #-}++psemigroupSemigroup :: (Semigroup a) => PartialSemigroupOp' a+psemigroupSemigroup = total (<>)+{-# INLINE psemigroupSemigroup #-}++null :: (Applicative f) => PartialSemigroupOpT f a b+null = PartialSemigroupOpT (\_ _ -> pure Nothing)+{-# INLINE null #-}++instance+  (PartialSemigroupOpT f a b ~ t) =>+  Rewrapped (PartialSemigroupOpT f' a' b') t++instance Wrapped (PartialSemigroupOpT f a b) where+  type Unwrapped (PartialSemigroupOpT f a b) = a -> a -> f (Maybe b)+  _Wrapped' = iso (\(PartialSemigroupOpT x) -> x) PartialSemigroupOpT++-- | >>> run (fmap (*10) addPos) 3 4+-- Just 70+-- >>> run (fmap (*10) addPos) (-1) 4+-- Nothing+instance (Functor f) => Functor (PartialSemigroupOpT f a) where+  fmap g (PartialSemigroupOpT k) =+    PartialSemigroupOpT (\a1 a2 -> fmap (fmap g) (k a1 a2))++-- | >>> run (liftF2 (+) addPos total) 3 4+-- Just 14+-- >>> run (liftF2 (+) addPos addPos) (-1) 4+-- Nothing+instance (Apply f) => Apply (PartialSemigroupOpT f a) where+  liftF2 g (PartialSemigroupOpT kx) (PartialSemigroupOpT ky) =+    PartialSemigroupOpT (\a1 a2 -> liftF2 (liftA2 g) (kx a1 a2) (ky a1 a2))++-- | >>> run (pure 42 :: PartialSemigroupOp' Int) 0 0+-- Just 42+-- >>> run (liftA2 (+) addPos total) 3 4+-- Just 14+instance (Applicative f) => Applicative (PartialSemigroupOpT f a) where+  pure b = PartialSemigroupOpT (\_ _ -> pure (Just b))+  liftA2 g (PartialSemigroupOpT kx) (PartialSemigroupOpT ky) =+    PartialSemigroupOpT (\a1 a2 -> liftA2 (liftA2 g) (kx a1 a2) (ky a1 a2))++-- | >>> run (addPos >>- \n -> pure (n * 10)) 3 4+-- Just 70+instance (Monad f, Apply f) => Bind (PartialSemigroupOpT f a) where+  PartialSemigroupOpT ka >>- g =+    PartialSemigroupOpT+      ( \a1 a2 ->+          ka a1 a2 >>= \case+            Nothing -> pure Nothing+            Just x -> let PartialSemigroupOpT kb = g x in kb a1 a2+      )++-- | >>> run (addPos >>= \n -> pure (n * 10)) 3 4+-- Just 70+-- >>> run (addPos >>= \_ -> mempty :: PartialSemigroupOp' Int) 3 4+-- Nothing+instance (Monad f) => Monad (PartialSemigroupOpT f a) where+  PartialSemigroupOpT ka >>= g =+    PartialSemigroupOpT+      ( \a1 a2 ->+          ka a1 a2 >>= \case+            Nothing -> pure Nothing+            Just x -> let PartialSemigroupOpT kb = g x in kb a1 a2+      )++-- | >>> run (lmap negate addPos) (-3) (-4)+-- Just 7+-- >>> run (rmap (*10) addPos) 3 4+-- Just 70+-- >>> run (dimap negate (*10) addPos) (-3) (-4)+-- Just 70+instance (Functor f) => Profunctor (PartialSemigroupOpT f) where+  dimap f g (PartialSemigroupOpT k) =+    PartialSemigroupOpT (\a1 a2 -> fmap (fmap g) (k (f a1) (f a2)))+  lmap f (PartialSemigroupOpT k) =+    PartialSemigroupOpT (\a1 a2 -> k (f a1) (f a2))+  rmap g (PartialSemigroupOpT k) =+    PartialSemigroupOpT (\a1 a2 -> fmap (fmap g) (k a1 a2))++-- | Pairs the first input's extra component with the result.+--+-- >>> run (first' addPos) (3, "x") (4, "y")+-- Just (7,"x")+instance (Functor f) => Strong (PartialSemigroupOpT f) where+  first' (PartialSemigroupOpT k) =+    PartialSemigroupOpT (\(a1, c) (a2, _) -> fmap (fmap (,c)) (k a1 a2))+  second' (PartialSemigroupOpT k) =+    PartialSemigroupOpT (\(c, a1) (_, a2) -> fmap (fmap (c,)) (k a1 a2))++-- | Routes matching 'Either' branches; passes through the other.+--+-- >>> run (left' addPos) (Left 3 :: Either Int String) (Left 4)+-- Just (Left 7)+-- >>> run (left' addPos) (Right "x" :: Either Int String) (Left 4)+-- Just (Right "x")+-- >>> run (left' addPos) (Left 3 :: Either Int String) (Right "x")+-- Just (Right "x")+instance (Applicative f) => Choice (PartialSemigroupOpT f) where+  left' (PartialSemigroupOpT k) =+    PartialSemigroupOpT+      ( \e1 e2 -> case (e1, e2) of+          (Left a1, Left a2) -> fmap (fmap Left) (k a1 a2)+          (Right c, _) -> pure (Just (Right c))+          (Left _, Right c) -> pure (Just (Right c))+      )+  right' (PartialSemigroupOpT k) =+    PartialSemigroupOpT+      ( \e1 e2 -> case (e1, e2) of+          (Right a1, Right a2) -> fmap (fmap Right) (k a1 a2)+          (Left c, _) -> pure (Just (Left c))+          (Right _, Left c) -> pure (Just (Left c))+      )++-- | Compose by feeding the result of the second into both arguments of the first.+--+-- >>> let showPos = PartialSemigroupOpT (\a _ -> Identity (if a > 0 then Just (show a) else Nothing)) :: PartialSemigroupOpT Identity Int String+-- >>> run (o showPos total) 3 4+-- Just "7"+instance (Monad f) => Semigroupoid (PartialSemigroupOpT f) where+  o (PartialSemigroupOpT g) (PartialSemigroupOpT h) =+    PartialSemigroupOpT+      ( \a1 a2 ->+          h a1 a2 >>= \case+            Nothing -> pure Nothing+            Just b -> g b b+      )++-- | >>> run (fail "oops" :: PartialSemigroupOp' Int) 3 4+-- Nothing+instance (Monad f) => MonadFail (PartialSemigroupOpT f a) where+  fail _ = PartialSemigroupOpT (\_ _ -> pure Nothing)++-- | First-success: try the left operand, fall back to the right.+--+-- >>> run (addPos <> total) 3 4+-- Just 7+-- >>> run (addPos <> total) (-1) 4+-- Just 3+instance (Monad f) => Semigroup (PartialSemigroupOpT f a b) where+  PartialSemigroupOpT k1 <> PartialSemigroupOpT k2 =+    PartialSemigroupOpT+      ( \a1 a2 ->+          k1 a1 a2 >>= \case+            Just b -> pure (Just b)+            Nothing -> k2 a1 a2+      )++-- | The always-undefined partial semigroup.+--+-- >>> run (mempty :: PartialSemigroupOp' Int) 3 4+-- Nothing+-- >>> run (mempty <> addPos) 3 4+-- Just 7+instance (Monad f) => Monoid (PartialSemigroupOpT f a b) where+  mempty = PartialSemigroupOpT (\_ _ -> pure Nothing)++-- | >>> run (addPos <!> total) (-1) 4+-- Just 3+instance (Monad f) => Alt (PartialSemigroupOpT f a) where+  (<!>) = (<>)++-- | >>> run (zero :: PartialSemigroupOp' Int) 3 4+-- Nothing+-- >>> run (zero <!> addPos :: PartialSemigroupOp' Int) 3 4+-- Just 7+instance (Monad f) => Plus (PartialSemigroupOpT f a) where+  zero = PartialSemigroupOpT (\_ _ -> pure Nothing)++-- | >>> run (empty <|> addPos :: PartialSemigroupOp' Int) 3 4+-- Just 7+instance (Monad f) => Alternative (PartialSemigroupOpT f a) where+  empty = mempty+  (<|>) = (<>)++instance (Monad f) => MonadPlus (PartialSemigroupOpT f a)++-- | >>> run (select (pure (Left 5)) (pure (+10)) :: PartialSemigroupOp' Int) 0 0+-- Just 15+-- >>> run (select (pure (Right 42)) (pure (+10)) :: PartialSemigroupOp' Int) 0 0+-- Just 42+instance (Monad f) => Selective (PartialSemigroupOpT f a) where+  select = selectM++-- | >>> run (mapMaybe (\n -> if n > 5 then Just (n * 10) else Nothing) total) 3 4+-- Just 70+-- >>> run (mapMaybe (\n -> if n > 10 then Just n else Nothing) total) 3 4+-- Nothing+instance (Functor f) => Filterable (PartialSemigroupOpT f a) where+  mapMaybe g (PartialSemigroupOpT k) =+    PartialSemigroupOpT (\a1 a2 -> fmap (>>= g) (k a1 a2))++-- | @'duplicated' w = w '<$' w@: preserves the 'Nothing'/'Just' structure,+-- replacing each value with the original partial semigroup.+--+-- >>> run (extended (\p -> runPartialSemigroupOp p 10 20) total) 3 4+-- Just (Just 30)+instance (Functor f) => Extend (PartialSemigroupOpT f a) where+  duplicated w = w <$ w++-- | Delegates to the underlying 'MonadReader'.+--+-- >>> import Control.Monad.Reader (Reader, runReader)+-- >>> runReader (runPartialSemigroupOpT (ask :: PartialSemigroupOpT (Reader Int) () Int) () ()) 42+-- Just 42+instance (MonadReader r f) => MonadReader r (PartialSemigroupOpT f a) where+  ask = PartialSemigroupOpT (\_ _ -> Just <$> ask)+  local g (PartialSemigroupOpT k) = PartialSemigroupOpT (\a1 a2 -> local g (k a1 a2))++-- | Delegates to the underlying 'MonadError'.+--+-- >>> import Control.Monad.Except (Except, runExcept)+-- >>> runExcept (runPartialSemigroupOpT (throwError "oops" :: PartialSemigroupOpT (Except String) () Int) () ())+-- Left "oops"+instance (MonadError e f) => MonadError e (PartialSemigroupOpT f a) where+  throwError e = PartialSemigroupOpT (\_ _ -> throwError e)+  catchError (PartialSemigroupOpT k) h =+    PartialSemigroupOpT+      ( \a1 a2 ->+          catchError (k a1 a2) (\e -> let PartialSemigroupOpT k' = h e in k' a1 a2)+      )++-- | Delegates to the underlying 'MonadState'.+--+-- >>> import Control.Monad.State (State, runState)+-- >>> runState (runPartialSemigroupOpT (get :: PartialSemigroupOpT (State Int) () Int) () ()) 5+-- (Just 5,5)+instance (MonadState s f) => MonadState s (PartialSemigroupOpT f a) where+  get = PartialSemigroupOpT (\_ _ -> Just <$> get)+  put s = PartialSemigroupOpT (\_ _ -> Just <$> put s)++-- | Delegates to the underlying 'MonadWriter'.+--+-- >>> import Control.Monad.Writer (Writer, runWriter)+-- >>> runWriter (runPartialSemigroupOpT (tell "hi" :: PartialSemigroupOpT (Writer String) () ()) () ())+-- (Just (),"hi")+instance (MonadWriter w f) => MonadWriter w (PartialSemigroupOpT f a) where+  tell w = PartialSemigroupOpT (\_ _ -> Just <$> tell w)+  listen (PartialSemigroupOpT k) =+    PartialSemigroupOpT+      ( \a1 a2 ->+          fmap (\(mb, w') -> fmap (,w') mb) (listen (k a1 a2))+      )+  pass (PartialSemigroupOpT k) =+    PartialSemigroupOpT+      ( \a1 a2 ->+          pass+            ( fmap+                ( \case+                    Nothing -> (Nothing, id)+                    Just (b, g) -> (Just b, g)+                )+                (k a1 a2)+            )+      )++instance (MonadRWS r w s f) => MonadRWS r w s (PartialSemigroupOpT f a)++-- | Lifts an 'IO' action, always producing 'Just'.+instance (MonadIO f) => MonadIO (PartialSemigroupOpT f a) where+  liftIO io = PartialSemigroupOpT (\_ _ -> Just <$> liftIO io)++-- | Delegates to the underlying 'MonadCont'.+instance (MonadCont f) => MonadCont (PartialSemigroupOpT f a) where+  callCC g =+    PartialSemigroupOpT+      ( \a1 a2 ->+          callCC+            ( \c ->+                let PartialSemigroupOpT k = g (\b -> PartialSemigroupOpT (\_ _ -> c (Just b)))+                 in k a1 a2+            )+      )++{- HLINT ignore "Monoid law, left identity" -}+{- HLINT ignore "Monoid law, right identity" -}+{- HLINT ignore "Functor law" -}+{- HLINT ignore "Use >=>" -}++----+-- Law-checking functions+----++-- | Associativity of the partial semigroup operation.+--+-- Left- and right-association of three values must agree:+-- both 'Nothing' or both the same 'Just'.+--+-- >>> runIdentity $ psemigroupLawAssociative total 1 2 3+-- True+-- >>> runIdentity $ psemigroupLawAssociative addPos 1 2 3+-- True+-- >>> runIdentity $ psemigroupLawAssociative addPos (-1) 2 3+-- True+psemigroupLawAssociative :: (Monad f, Eq a) => PartialSemigroupOpT' f a -> a -> a -> a -> f Bool+psemigroupLawAssociative (PartialSemigroupOpT op) x y z = do+  mxy <- op x y+  lhs <- case mxy of+    Nothing -> pure Nothing+    Just xy -> op xy z+  myz <- op y z+  rhs <- case myz of+    Nothing -> pure Nothing+    Just yz -> op x yz+  pure (lhs == rhs)++-- | 'Semigroup' associativity: @(p '<>' q) '<>' r == p '<>' (q '<>' r)@+--+-- >>> psemigroupLawSemigroupAssociative addPos total mempty 3 4+-- True+-- >>> psemigroupLawSemigroupAssociative addPos total mempty (-1) 4+-- True+psemigroupLawSemigroupAssociative :: (Monad f, Eq (f (Maybe b))) => PartialSemigroupOpT f a b -> PartialSemigroupOpT f a b -> PartialSemigroupOpT f a b -> a -> a -> Bool+psemigroupLawSemigroupAssociative p q r a1 a2 =+  runPartialSemigroupOpT ((p <> q) <> r) a1 a2 == runPartialSemigroupOpT (p <> (q <> r)) a1 a2++-- | 'Monoid' left identity: @'mempty' '<>' p == p@+--+-- >>> psemigroupLawMonoidLeftIdentity addPos 3 4+-- True+-- >>> psemigroupLawMonoidLeftIdentity addPos (-1) 4+-- True+psemigroupLawMonoidLeftIdentity :: (Monad f, Eq (f (Maybe b))) => PartialSemigroupOpT f a b -> a -> a -> Bool+psemigroupLawMonoidLeftIdentity p a1 a2 =+  runPartialSemigroupOpT (mempty <> p) a1 a2 == runPartialSemigroupOpT p a1 a2++-- | 'Monoid' right identity: @p '<>' 'mempty' == p@+--+-- >>> psemigroupLawMonoidRightIdentity addPos 3 4+-- True+-- >>> psemigroupLawMonoidRightIdentity addPos (-1) 4+-- True+psemigroupLawMonoidRightIdentity :: (Monad f, Eq (f (Maybe b))) => PartialSemigroupOpT f a b -> a -> a -> Bool+psemigroupLawMonoidRightIdentity p a1 a2 =+  runPartialSemigroupOpT (p <> mempty) a1 a2 == runPartialSemigroupOpT p a1 a2++-- | 'Functor' identity: @'fmap' 'id' == 'id'@+--+-- >>> psemigroupLawFunctorIdentity addPos 3 4+-- True+-- >>> psemigroupLawFunctorIdentity addPos (-1) 4+-- True+psemigroupLawFunctorIdentity :: (Functor f, Eq (f (Maybe b))) => PartialSemigroupOpT f a b -> a -> a -> Bool+psemigroupLawFunctorIdentity p a1 a2 =+  runPartialSemigroupOpT (fmap id p) a1 a2 == runPartialSemigroupOpT p a1 a2++-- | 'Functor' composition: @'fmap' (g '.' h) == 'fmap' g '.' 'fmap' h@+--+-- >>> psemigroupLawFunctorComposition (*10) (+1) addPos 3 4+-- True+psemigroupLawFunctorComposition :: (Functor f, Eq (f (Maybe d))) => (c -> d) -> (b -> c) -> PartialSemigroupOpT f a b -> a -> a -> Bool+psemigroupLawFunctorComposition g h p a1 a2 =+  runPartialSemigroupOpT (fmap (g . h) p) a1 a2 == runPartialSemigroupOpT (fmap g (fmap h p)) a1 a2++-- | 'Profunctor' identity: @'dimap' 'id' 'id' == 'id'@+--+-- >>> psemigroupLawProfunctorIdentity addPos 3 4+-- True+psemigroupLawProfunctorIdentity :: (Functor f, Eq (f (Maybe b))) => PartialSemigroupOpT f a b -> a -> a -> Bool+psemigroupLawProfunctorIdentity p a1 a2 =+  runPartialSemigroupOpT (dimap id id p) a1 a2 == runPartialSemigroupOpT p a1 a2++-- | 'Filterable' identity: @'mapMaybe' 'Just' == 'id'@+--+-- >>> lawFilterableIdentity addPos 3 4+-- True+-- >>> lawFilterableIdentity addPos (-1) 4+-- True+lawFilterableIdentity :: (Functor f, Eq (f (Maybe b))) => PartialSemigroupOpT f a b -> a -> a -> Bool+lawFilterableIdentity p a1 a2 =+  runPartialSemigroupOpT (mapMaybe Just p) a1 a2 == runPartialSemigroupOpT p a1 a2++-- | 'Filterable' composition: @'mapMaybe' g '.' 'mapMaybe' h == 'mapMaybe' (h 'Control.Monad.>=>' g)@+--+-- >>> lawFilterableComposition (\n -> if n > 50 then Just n else Nothing) (\n -> if n > 5 then Just (n * 10) else Nothing) total 3 4+-- True+lawFilterableComposition :: (Functor f, Eq (f (Maybe c))) => (b -> Maybe c) -> (a -> Maybe b) -> PartialSemigroupOpT f x a -> x -> x -> Bool+lawFilterableComposition g h p x1 x2 =+  runPartialSemigroupOpT (mapMaybe g (mapMaybe h p)) x1 x2 == runPartialSemigroupOpT (mapMaybe (h >=> g) p) x1 x2++-- | 'Extend' associativity: @'extended' f '.' 'extended' g == 'extended' (f '.' 'extended' g)@+--+-- >>> psemigroupLawExtendAssociative (const True) (const 'x') total 3 4+-- True+-- >>> psemigroupLawExtendAssociative (const True) (const 'x') addPos (-1) 4+-- True+psemigroupLawExtendAssociative :: (Functor f, Eq (f (Maybe c))) => (PartialSemigroupOpT f a b -> c) -> (PartialSemigroupOpT f a d -> b) -> PartialSemigroupOpT f a d -> a -> a -> Bool+psemigroupLawExtendAssociative f g p a1 a2 =+  runPartialSemigroupOpT (extended f (extended g p)) a1 a2 == runPartialSemigroupOpT (extended (f . extended g) p) a1 a2++-- | 'Semigroupoid' associativity: @'o' f ('o' g h) == 'o' ('o' f g) h@+--+-- >>> psemigroupLawSemigroupoidAssociative total total total 3 4+-- True+psemigroupLawSemigroupoidAssociative :: (Monad f, Eq (f (Maybe d))) => PartialSemigroupOpT f c d -> PartialSemigroupOpT f b c -> PartialSemigroupOpT f a b -> a -> a -> Bool+psemigroupLawSemigroupoidAssociative f g h x1 x2 =+  runPartialSemigroupOpT (o f (o g h)) x1 x2 == runPartialSemigroupOpT (o (o f g) h) x1 x2++-- | Classy lens for types that contain a 'PartialSemigroupOpT'.+--+-- >>> run (view partialSemigroupOpT addPos) 3 4+-- Just 7+class HasPartialSemigroupOpT c f a b | c -> f a b where+  partialSemigroupOpT :: Lens' c (PartialSemigroupOpT f a b)++instance HasPartialSemigroupOpT (PartialSemigroupOpT f a b) f a b where+  partialSemigroupOpT = id++-- | Classy prism for types that can be constructed from a 'PartialSemigroupOpT'.+--+-- >>> run (review _PartialSemigroupOpT addPos) 3 4+-- Just 7+class AsPartialSemigroupOpT c f a b | c -> f a b where+  _PartialSemigroupOpT :: Prism' c (PartialSemigroupOpT f a b)++instance AsPartialSemigroupOpT (PartialSemigroupOpT f a b) f a b where+  _PartialSemigroupOpT = id++----+-- PartialSemigroupOp' values via semigroup+----++-- | >>> run psemigroupUnit () ()+-- Just ()+psemigroupUnit :: PartialSemigroupOp' ()+psemigroupUnit = psemigroupSemigroup++-- | Vacuously associative — 'Void' has no inhabitants.+psemigroupVoid :: PartialSemigroupOp' Void+psemigroupVoid = psemigroupSemigroup++-- | Lexicographic composition of orderings.+--+-- >>> run psemigroupOrdering LT GT+-- Just LT+-- >>> run psemigroupOrdering EQ GT+-- Just GT+-- >>> run psemigroupOrdering EQ EQ+-- Just EQ+psemigroupOrdering :: PartialSemigroupOp' Ordering+psemigroupOrdering = psemigroupSemigroup++-- | List concatenation.+--+-- >>> run psemigroupList [1,2] [3,4 :: Int]+-- Just [1,2,3,4]+psemigroupList :: PartialSemigroupOp' [a]+psemigroupList = psemigroupSemigroup++-- | Non-empty list concatenation.+--+-- >>> run psemigroupNonEmpty (1 :| [2]) (3 :| [4 :: Int])+-- Just (1 :| [2,3,4])+psemigroupNonEmpty :: PartialSemigroupOp' (NonEmpty a)+psemigroupNonEmpty = psemigroupSemigroup++-- | First 'Right' wins; 'Left' is absorbed.+--+-- >>> run psemigroupEither (Left "a") (Right 1 :: Either String Int)+-- Just (Right 1)+-- >>> run psemigroupEither (Right 1) (Left "b" :: Either String Int)+-- Just (Right 1)+-- >>> run psemigroupEither (Left "a") (Left "b" :: Either String Int)+-- Just (Left "b")+psemigroupEither :: PartialSemigroupOp' (Either a b)+psemigroupEither = psemigroupSemigroup++-- | >>> run psemigroupProxy Proxy (Proxy :: Proxy Int)+-- Just Proxy+psemigroupProxy :: PartialSemigroupOp' (Proxy a)+psemigroupProxy = psemigroupSemigroup++-- | 'Nothing' is identity; 'Just' values are combined.+--+-- >>> run psemigroupMaybe (Just [1]) (Just [2 :: Int])+-- Just (Just [1,2])+-- >>> run psemigroupMaybe Nothing (Just [2 :: Int])+-- Just (Just [2])+-- >>> run psemigroupMaybe (Just [1 :: Int]) Nothing+-- Just (Just [1])+psemigroupMaybe :: (Semigroup a) => PartialSemigroupOp' (Maybe a)+psemigroupMaybe = psemigroupSemigroup++-- | Reverses the inner semigroup.+--+-- >>> run psemigroupDual (Dual [1]) (Dual [2 :: Int])+-- Just (Dual {getDual = [2,1]})+psemigroupDual :: (Semigroup a) => PartialSemigroupOp' (Dual a)+psemigroupDual = psemigroupSemigroup++-- | Delegates through 'Down'.+--+-- >>> run psemigroupDown (Down [1]) (Down [2 :: Int])+-- Just (Down [1,2])+psemigroupDown :: (Semigroup a) => PartialSemigroupOp' (Down a)+psemigroupDown = psemigroupSemigroup++-- | Delegates through 'Identity'.+--+-- >>> run psemigroupIdentity (Identity [1]) (Identity [2 :: Int])+-- Just (Identity [1,2])+psemigroupIdentity :: (Semigroup a) => PartialSemigroupOp' (Identity a)+psemigroupIdentity = psemigroupSemigroup++-- | Pairwise combination.+--+-- >>> run psemigroupTuple ([1 :: Int], [10]) ([2], [20 :: Int])+-- Just ([1,2],[10,20])+psemigroupTuple :: (Semigroup a, Semigroup b) => PartialSemigroupOp' (a, b)+psemigroupTuple = psemigroupSemigroup++-- | Uses the underlying 'Monoid' operation.+--+-- >>> run psemigroupWrappedMonoid (WrapMonoid [1]) (WrapMonoid [2 :: Int])+-- Just (WrapMonoid {unwrapMonoid = [1,2]})+psemigroupWrappedMonoid :: (Monoid a) => PartialSemigroupOp' (WrappedMonoid a)+psemigroupWrappedMonoid = psemigroupSemigroup++-- | Pointwise combination.+--+-- >>> fmap ($ "x") (run psemigroupFunction (++ "a") ((++ "b") :: String -> String))+-- Just "xaxb"+psemigroupFunction :: (Semigroup b) => PartialSemigroupOp' (a -> b)+psemigroupFunction = psemigroupSemigroup++-- | First-success on 'Maybe' via 'Alt'.+--+-- >>> run psemigroupAlt (Just 1) (Just 2 :: Maybe Int)+-- Just (Just 1)+-- >>> run psemigroupAlt Nothing (Just 2 :: Maybe Int)+-- Just (Just 2)+psemigroupAlt :: PartialSemigroupOp' (Maybe a)+psemigroupAlt = total (<!>)++-- | First-success on 'Maybe' via 'Alternative'.+--+-- >>> run psemigroupAlternative (Just 1) (Just 2 :: Maybe Int)+-- Just (Just 1)+-- >>> run psemigroupAlternative Nothing (Just 2 :: Maybe Int)+-- Just (Just 2)+psemigroupAlternative :: PartialSemigroupOp' (Maybe a)+psemigroupAlternative = total (<|>)++----+-- PartialSemigroupOp' values via total+----++-- | Takes the first value ('First').+--+-- >>> run psemigroupFirst 'a' 'b'+-- Just 'a'+psemigroupFirst :: PartialSemigroupOp' a+psemigroupFirst = total const++-- | Takes the last value ('Last').+--+-- >>> run psemigroupLast 'a' 'b'+-- Just 'b'+psemigroupLast :: PartialSemigroupOp' a+psemigroupLast = total (const id)++-- | Takes the minimum ('Min').+--+-- >>> run psemigroupMin (3 :: Int) 4+-- Just 3+psemigroupMin :: (Ord a) => PartialSemigroupOp' a+psemigroupMin = total min++-- | Takes the maximum ('Max').+--+-- >>> run psemigroupMax (3 :: Int) 4+-- Just 4+psemigroupMax :: (Ord a) => PartialSemigroupOp' a+psemigroupMax = total max++-- | Logical conjunction ('All').+--+-- >>> run psemigroupAll True True+-- Just True+-- >>> run psemigroupAll True False+-- Just False+psemigroupAll :: PartialSemigroupOp' Bool+psemigroupAll = total (&&)++-- | Logical disjunction ('Any').+--+-- >>> run psemigroupAny False False+-- Just False+-- >>> run psemigroupAny False True+-- Just True+psemigroupAny :: PartialSemigroupOp' Bool+psemigroupAny = total (||)++-- | Addition ('Sum').+--+-- >>> run psemigroupAddition (3 :: Int) 4+-- Just 7+psemigroupAddition :: (Num a) => PartialSemigroupOp' a+psemigroupAddition = total (+)++-- | Multiplication ('Product').+--+-- >>> run psemigroupMultiplication (3 :: Int) 4+-- Just 12+psemigroupMultiplication :: (Num a) => PartialSemigroupOp' a+psemigroupMultiplication = total (*)++-- | Function composition ('Endo').+--+-- >>> fmap ($ 3) (run psemigroupEndo (+1) ((*10) :: Int -> Int))+-- Just 31+psemigroupEndo :: PartialSemigroupOp' (a -> a)+psemigroupEndo = total (.)++-- | Bitwise AND ('Data.Bits.And').+--+-- >>> run psemigroupAnd (0xFF :: Word8) 0x0F+-- Just 15+psemigroupAnd :: (Bits a) => PartialSemigroupOp' a+psemigroupAnd = total (.&.)++-- | Bitwise inclusive OR ('Data.Bits.Ior').+--+-- >>> run psemigroupIor (0xF0 :: Word8) 0x0F+-- Just 255+psemigroupIor :: (Bits a) => PartialSemigroupOp' a+psemigroupIor = total (.|.)++-- | Bitwise exclusive OR ('Data.Bits.Xor').+--+-- >>> run psemigroupXor (0xFF :: Word8) 0x0F+-- Just 240+psemigroupXor :: (Bits a) => PartialSemigroupOp' a+psemigroupXor = total xor++-- | Bitwise equivalence / XNOR ('Data.Bits.Iff').+--+-- >>> run psemigroupIff (0xFF :: Word8) 0x0F+-- Just 15+psemigroupIff :: (FiniteBits a) => PartialSemigroupOp' a+psemigroupIff = total (\a b -> complement (xor a b))++----+-- Collection values+----++-- | Set union.+--+-- >>> run psemigroupSetUnion (Set.fromList [1,2]) (Set.fromList [2,3 :: Int])+-- Just (fromList [1,2,3])+psemigroupSetUnion :: (Ord a) => PartialSemigroupOp' (Set a)+psemigroupSetUnion = total Set.union++-- | Set intersection.+--+-- >>> run psemigroupSetIntersection (Set.fromList [1,2,3]) (Set.fromList [2,3,4 :: Int])+-- Just (fromList [2,3])+psemigroupSetIntersection :: (Ord a) => PartialSemigroupOp' (Set a)+psemigroupSetIntersection = total Set.intersection++-- | IntSet union.+--+-- >>> run psemigroupIntSetUnion (IntSet.fromList [1,2]) (IntSet.fromList [2,3])+-- Just (fromList [1,2,3])+psemigroupIntSetUnion :: PartialSemigroupOp' IntSet+psemigroupIntSetUnion = total IntSet.union++-- | IntSet intersection.+--+-- >>> run psemigroupIntSetIntersection (IntSet.fromList [1,2,3]) (IntSet.fromList [2,3,4])+-- Just (fromList [2,3])+psemigroupIntSetIntersection :: PartialSemigroupOp' IntSet+psemigroupIntSetIntersection = total IntSet.intersection++-- | HashSet union.+--+-- >>> fmap sort (fmap HashSet.toList (run psemigroupHashSetUnion (HashSet.fromList [1,2]) (HashSet.fromList [2,3 :: Int])))+-- Just [1,2,3]+psemigroupHashSetUnion :: (Eq a, Hashable a) => PartialSemigroupOp' (HashSet a)+psemigroupHashSetUnion = total HashSet.union++-- | HashSet intersection.+--+-- >>> fmap sort (fmap HashSet.toList (run psemigroupHashSetIntersection (HashSet.fromList [1,2,3]) (HashSet.fromList [2,3,4 :: Int])))+-- Just [2,3]+psemigroupHashSetIntersection :: (Eq a, Hashable a) => PartialSemigroupOp' (HashSet a)+psemigroupHashSetIntersection = total HashSet.intersection++-- | Map union (left-biased on overlapping keys).+--+-- >>> run psemigroupMapUnion (Map.fromList [(1 :: Int,'a'),(2,'b')]) (Map.fromList [(2,'x'),(3,'c')])+-- Just (fromList [(1,'a'),(2,'b'),(3,'c')])+psemigroupMapUnion :: (Ord k) => PartialSemigroupOp' (Map k v)+psemigroupMapUnion = total Map.union++-- | Map intersection (left-biased on overlapping keys).+--+-- >>> run psemigroupMapIntersection (Map.fromList [(1 :: Int,'a'),(2,'b'),(3,'c')]) (Map.fromList [(2,'x'),(3,'y'),(4,'z')])+-- Just (fromList [(2,'b'),(3,'c')])+psemigroupMapIntersection :: (Ord k) => PartialSemigroupOp' (Map k v)+psemigroupMapIntersection = total Map.intersection++-- | IntMap union (left-biased on overlapping keys).+--+-- >>> run psemigroupIntMapUnion (IntMap.fromList [(1,'a'),(2,'b')]) (IntMap.fromList [(2,'x'),(3,'c')])+-- Just (fromList [(1,'a'),(2,'b'),(3,'c')])+psemigroupIntMapUnion :: PartialSemigroupOp' (IntMap v)+psemigroupIntMapUnion = total IntMap.union++-- | IntMap intersection (left-biased on overlapping keys).+--+-- >>> run psemigroupIntMapIntersection (IntMap.fromList [(1,'a'),(2,'b'),(3,'c')]) (IntMap.fromList [(2,'x'),(3,'y'),(4,'z')])+-- Just (fromList [(2,'b'),(3,'c')])+psemigroupIntMapIntersection :: PartialSemigroupOp' (IntMap v)+psemigroupIntMapIntersection = total IntMap.intersection++-- | HashMap union (left-biased on overlapping keys).+--+-- >>> fmap sort (fmap HashMap.toList (run psemigroupHashMapUnion (HashMap.fromList [(1 :: Int,'a'),(2,'b')]) (HashMap.fromList [(2,'x'),(3,'c')])))+-- Just [(1,'a'),(2,'b'),(3,'c')]+psemigroupHashMapUnion :: (Eq k, Hashable k) => PartialSemigroupOp' (HashMap k v)+psemigroupHashMapUnion = total HashMap.union++-- | HashMap intersection (left-biased on overlapping keys).+--+-- >>> fmap sort (fmap HashMap.toList (run psemigroupHashMapIntersection (HashMap.fromList [(1 :: Int,'a'),(2,'b'),(3,'c')]) (HashMap.fromList [(2,'x'),(3,'y'),(4,'z')])))+-- Just [(2,'b'),(3,'c')]+psemigroupHashMapIntersection :: (Eq k, Hashable k) => PartialSemigroupOp' (HashMap k v)+psemigroupHashMapIntersection = total HashMap.intersection

@@ -0,0 +1,865 @@+{-# 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,++    -- * 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 (..))+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 (Just [1]) (Just [2 :: Int])+-- Just [1,2]+-- >>> run semigroupMaybe Nothing (Just [2 :: Int])+-- Just [2]+-- >>> run semigroupMaybe (Just [1 :: Int]) Nothing+-- Just [1]+semigroupMaybe :: (Semigroup a) => SemigroupOp' (Maybe a)+semigroupMaybe = semigroupSemigroup++-- | 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 (<|>)++-- | Reverses the inner semigroup.+--+-- >>> run semigroupDual (Dual [1]) (Dual [2 :: Int])+-- Dual {getDual = [2,1]}+semigroupDual :: (Semigroup a) => SemigroupOp' (Dual a)+semigroupDual = semigroupSemigroup++-- | Delegates through 'Down'.+--+-- >>> run semigroupDown (Down [1]) (Down [2 :: Int])+-- Down [1,2]+semigroupDown :: (Semigroup a) => SemigroupOp' (Down a)+semigroupDown = semigroupSemigroup++-- | Delegates through 'Identity'.+--+-- >>> run semigroupIdentity (Identity [1]) (Identity [2 :: Int])+-- Identity [1,2]+semigroupIdentity :: (Semigroup a) => SemigroupOp' (Identity a)+semigroupIdentity = semigroupSemigroup++-- | Pairwise combination.+--+-- >>> run semigroupTuple ([1 :: Int], [10]) ([2], [20 :: Int])+-- ([1,2],[10,20])+semigroupTuple :: (Semigroup a, Semigroup b) => SemigroupOp' (a, b)+semigroupTuple = semigroupSemigroup++-- | Uses the underlying 'Monoid' operation.+--+-- >>> run semigroupWrappedMonoid (WrapMonoid [1]) (WrapMonoid [2 :: Int])+-- WrapMonoid {unwrapMonoid = [1,2]}+semigroupWrappedMonoid :: (Monoid a) => SemigroupOp' (WrappedMonoid a)+semigroupWrappedMonoid = semigroupSemigroup++-- | Pointwise combination.+--+-- >>> run semigroupFunction (++ "a") ((++ "b") :: String -> String) "x"+-- "xaxb"+semigroupFunction :: (Semigroup b) => SemigroupOp' (a -> b)+semigroupFunction = semigroupSemigroup++----+-- 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

@@ -0,0 +1,18 @@+{-# OPTIONS_GHC -Wall -Werror #-}++module Main where++import System.Exit (exitWith)+import System.Process (rawSystem)++main :: IO ()+main =+  exitWith+    =<< rawSystem+      "cabal"+      [ "repl",+        "--with-compiler=doctest",+        "--repl-options=-w",+        "--repl-options=-Wdefault",+        "lib:associative"+      ]