associative 0.0.3 → 0.0.4

raw patch · 7 files changed

+417/−268 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• associative.cabal +1/−1
• changelog.md +13/−0
• examples/Data/Associative/Examples/MonoidOpExamples.hs +7/−6
• examples/Data/Associative/Examples/PartialMonoidOpExamples.hs +7/−6
• src/Data/Associative/MonoidOp.hs +185/−121
• src/Data/Associative/PartialMonoidOp.hs +189/−132
• src/Data/Associative/PartialSemigroupOp.hs +15/−2

@@ -1,6 +1,6 @@ cabal-version:        2.4 name:                 associative-version:              0.0.3+version:              0.0.4 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

@@ -1,3 +1,16 @@+0.0.4++* Generalised `MonoidOp` to monad transformer `MonoidOpT f a b i` with type aliases `MonoidOp a b i`, `MonoidOpT' f x`, `MonoidOp' x`+* Generalised `PartialMonoidOp` to monad transformer `PartialMonoidOpT f a b i` with type aliases `PartialMonoidOp a b i`, `PartialMonoidOpT' f x`, `PartialMonoidOp' x`+* New `iMonoidOpT` isomorphism for the transformer variant+* New `iPartialMonoidOpT` isomorphism for the transformer variant+* New `runMonoidOpT`, `identityMonoidOpT` for `MonoidOpT`+* New `runPartialMonoidOpT`, `identityPartialMonoidOpT` for `PartialMonoidOpT`+* New `defaultSemigroupOpT` converting a partial semigroup to a total one given a default value+* New `defaultMonoidOp` converting a partial monoid to a total one given a default value+* Classy optics renamed: `HasMonoidOp`/`AsMonoidOp` to `HasMonoidOpT`/`AsMonoidOpT`, `HasPartialMonoidOp`/`AsPartialMonoidOp` to `HasPartialMonoidOpT`/`AsPartialMonoidOpT`+* Law-checking functions (`monoidLawAssociative`, `monoidLawLeftIdentity`, `monoidLawRightIdentity`, `pmonoidLawAssociative`, `pmonoidLawLeftIdentity`, `pmonoidLawRightIdentity`) now work in any `Monad f` rather than being pure+ 0.0.3  * New `nonPartialSemigroup` isomorphism witnessing that `PartialSemigroupOpT (Const b) a b` is isomorphic to `SemigroupOp a b`

@@ -13,7 +13,8 @@ where  import Data.Associative.MonoidOp-  ( MonoidOp (..),+  ( MonoidOp',+    MonoidOpT (..),     identityMonoidOp,     monoidList,     runMonoidOp,@@ -28,8 +29,8 @@ -- 7 -- >>> identityMonoidOp addMonoid -- 0-addMonoid :: MonoidOp Int-addMonoid = MonoidOp (op (+)) 0+addMonoid :: MonoidOp' Int+addMonoid = MonoidOpT (op (+)) 0  -- | A monoid operation from the 'Monoid' class. --@@ -37,7 +38,7 @@ -- [1,2,3,4] -- >>> identityMonoidOp catMonoid -- []-catMonoid :: MonoidOp [Int]+catMonoid :: MonoidOp' [Int] catMonoid = monoidList  -- * Identity element laws@@ -53,8 +54,8 @@ monoidIdentityLawExample = ()  -- helpers to suppress unused-import warnings for re-exports used in doctests-_suppressRunMonoidOp :: MonoidOp a -> a -> a -> a+_suppressRunMonoidOp :: MonoidOp' a -> a -> a -> a _suppressRunMonoidOp = runMonoidOp -_suppressIdentityMonoidOp :: MonoidOp a -> a+_suppressIdentityMonoidOp :: MonoidOp' a -> a _suppressIdentityMonoidOp = identityMonoidOp

@@ -13,7 +13,8 @@ where  import Data.Associative.PartialMonoidOp-  ( PartialMonoidOp (..),+  ( PartialMonoidOp',+    PartialMonoidOpT (..),     identityPartialMonoidOp,     pmonoidList,     runPartialMonoidOp,@@ -28,8 +29,8 @@ -- Just 7 -- >>> identityPartialMonoidOp addPartialMonoid -- 0-addPartialMonoid :: PartialMonoidOp Int-addPartialMonoid = PartialMonoidOp (total (+)) 0+addPartialMonoid :: PartialMonoidOp' Int+addPartialMonoid = PartialMonoidOpT (total (+)) 0  -- | A partial monoid operation from the 'Monoid' class. --@@ -37,7 +38,7 @@ -- Just [1,2,3,4] -- >>> identityPartialMonoidOp catPartialMonoid -- []-catPartialMonoid :: PartialMonoidOp [Int]+catPartialMonoid :: PartialMonoidOp' [Int] catPartialMonoid = pmonoidList  -- * Identity element laws@@ -53,8 +54,8 @@ partialMonoidIdentityLawExample = ()  -- helpers to suppress unused-import warnings for re-exports used in doctests-_suppressRunPartialMonoidOp :: PartialMonoidOp a -> a -> a -> Maybe a+_suppressRunPartialMonoidOp :: PartialMonoidOp' a -> a -> a -> Maybe a _suppressRunPartialMonoidOp = runPartialMonoidOp -_suppressIdentityPartialMonoidOp :: PartialMonoidOp a -> a+_suppressIdentityPartialMonoidOp :: PartialMonoidOp' a -> a _suppressIdentityPartialMonoidOp = identityPartialMonoidOp

@@ -9,13 +9,19 @@ -- that is defined for all pairs of inputs. module Data.Associative.MonoidOp   ( -- * Types-    MonoidOp (..),+    MonoidOpT (..),+    MonoidOp,+    MonoidOpT',+    MonoidOp', -    -- * Isomorphism+    -- * Isomorphisms+    iMonoidOpT,     iMonoidOp,      -- * Running+    runMonoidOpT,     runMonoidOp,+    identityMonoidOpT,     identityMonoidOp,      -- * Smart constructors@@ -27,8 +33,8 @@     monoidLawRightIdentity,      -- * Classy optics-    HasMonoidOp (..),-    AsMonoidOp (..),+    HasMonoidOpT (..),+    AsMonoidOpT (..),      -- * Values (via monoid)     monoidUnit,@@ -47,7 +53,7 @@     monoidLiftF2,     monoidLiftA2, -    -- * Values (via MonoidOp)+    -- * Values (via MonoidOpT)     monoidMin,     monoidMax,     monoidAll,@@ -78,7 +84,23 @@     iso,     lens,   )-import Data.Associative.SemigroupOp (HasSemigroupOpT (..), SemigroupOp', op, runSemigroupOp, semigroupDown, semigroupDual, semigroupFunction, semigroupIdentity, semigroupLiftA2, semigroupMaybe, semigroupTuple, semigroupWrappedMonoid)+import Data.Associative.SemigroupOp+  ( HasSemigroupOpT (..),+    SemigroupOp',+    SemigroupOpT (..),+    op,+    runSemigroupOp,+    runSemigroupOpT,+    semigroupDown,+    semigroupDual,+    semigroupFunction,+    semigroupIdentity,+    semigroupLawAssociative,+    semigroupLiftA2,+    semigroupMaybe,+    semigroupTuple,+    semigroupWrappedMonoid,+  ) import qualified Data.Associative.SemigroupOp as SG (semigroupSemigroup) import Data.Bits (Bits, FiniteBits, complement, xor, zeroBits, (.&.), (.|.)) import Data.Functor.Alt (Alt (..))@@ -116,59 +138,101 @@ -- >>> 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 add = MonoidOpT (op (+)) 0 :: MonoidOp' Int -- >>> let run = runMonoidOp+-- >>> let runT = runMonoidOpT --- | A monoid operation: an associative binary operation with an identity element,--- defined for all pairs of inputs.+-- | A monoid transformer. The wrapped operation must be associative+-- (see 'monoidLawAssociative') with an identity element. -- -- >>> run add 3 4 -- 7 -- >>> identityMonoidOp add -- 0-data MonoidOp a = MonoidOp (SemigroupOp' a) a+data MonoidOpT f a b i = MonoidOpT (SemigroupOpT f a b) i   deriving (Generic) --- | Iso between 'MonoidOp' and a @(binary-operation, identity)@ pair.+-- | A monoid using 'Identity' as the base functor.+type MonoidOp a b i = MonoidOpT Identity a b i++-- | A monoid transformer where input, output, and identity types coincide.+type MonoidOpT' f x = MonoidOpT f x x x++-- | A monoid where input, output, and identity types coincide.+type MonoidOp' x = MonoidOp x x x++-- | Iso between 'MonoidOpT' and its underlying function paired with identity. --+-- >>> let (f, e) = view iMonoidOpT add+-- >>> f 3 4+-- Identity 7+-- >>> e+-- 0+iMonoidOpT :: Iso (MonoidOpT f a b i) (MonoidOpT f' a' b' i') (a -> a -> f b, i) (a' -> a' -> f' b', i')+iMonoidOpT =+  iso+    (\(MonoidOpT (SemigroupOpT k) e) -> (k, e))+    (\(f, e) -> MonoidOpT (SemigroupOpT f) e)+{-# INLINE iMonoidOpT #-}++-- | Iso between 'MonoidOp' and a pure function paired with identity.+-- -- >>> 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 a b i) (MonoidOp a' b' i') (a -> a -> b, i) (a' -> a' -> b', i') iMonoidOp =   iso-    (\(MonoidOp s e) -> (runSemigroupOp s, e))-    (\(f, e) -> MonoidOp (op f) e)+    (\(MonoidOpT s e) -> (runSemigroupOp s, e))+    (\(f, e) -> MonoidOpT (op f) e) {-# INLINE iMonoidOp #-} --- | Extract the binary operation and run it.+-- | Unwrap a 'MonoidOpT' to run its underlying operation. ----- >>> runMonoidOp add 3 4+-- >>> runT add 3 4+-- Identity 7+runMonoidOpT :: MonoidOpT f a b i -> a -> a -> f b+runMonoidOpT (MonoidOpT s _) = runSemigroupOpT s+{-# INLINE runMonoidOpT #-}++-- | Run a 'MonoidOp' (specialised to 'Identity').+--+-- >>> run add 3 4 -- 7-runMonoidOp :: MonoidOp a -> a -> a -> a-runMonoidOp (MonoidOp s _) = runSemigroupOp s+runMonoidOp :: MonoidOp a b i -> a -> a -> b+runMonoidOp (MonoidOpT s _) = runSemigroupOp s {-# INLINE runMonoidOp #-} --- | Extract the identity element.+-- | Extract the identity element from a 'MonoidOpT'. --+-- >>> identityMonoidOpT add+-- 0+-- >>> identityMonoidOpT monoidList+-- []+identityMonoidOpT :: MonoidOpT f a b i -> i+identityMonoidOpT (MonoidOpT _ e) = e+{-# INLINE identityMonoidOpT #-}++-- | Extract the identity element from a 'MonoidOp'.+-- -- >>> identityMonoidOp add -- 0 -- >>> identityMonoidOp monoidList -- []-identityMonoidOp :: MonoidOp a -> a-identityMonoidOp (MonoidOp _ e) = e+identityMonoidOp :: MonoidOp a b i -> i+identityMonoidOp (MonoidOpT _ e) = e {-# INLINE identityMonoidOp #-} --- | Build a 'MonoidOp' from any 'Monoid' instance.+-- | Build a 'MonoidOp'' from any 'Monoid' instance. ----- >>> run (monoid :: MonoidOp [Int]) [1,2] [3,4]+-- >>> run (monoid :: MonoidOp' [Int]) [1,2] [3,4] -- [1,2,3,4]--- >>> identityMonoidOp (monoid :: MonoidOp [Int])+-- >>> identityMonoidOp (monoid :: MonoidOp' [Int]) -- []-monoid :: (Monoid a) => MonoidOp a-monoid = MonoidOp SG.semigroupSemigroup mempty+monoid :: (Monoid a) => MonoidOp' a+monoid = MonoidOpT SG.semigroupSemigroup mempty {-# INLINE monoid #-}  -- | Classy lens giving access to the underlying 'SemigroupOpT'.@@ -176,8 +240,8 @@ -- >>> 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)+instance HasSemigroupOpT (MonoidOpT f a b i) f a b where+  semigroupOpT = lens (\(MonoidOpT s _) -> s) (\(MonoidOpT _ e) s' -> MonoidOpT s' e)  {- HLINT ignore "Monoid law, left identity" -} {- HLINT ignore "Monoid law, right identity" -}@@ -188,62 +252,62 @@  -- | Associativity: @f (f x y) z == f x (f y z)@ ----- >>> monoidLawAssociative add 1 2 3+-- >>> runIdentity $ 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)+monoidLawAssociative :: (Monad f, Eq a) => MonoidOpT' f a -> a -> a -> a -> f Bool+monoidLawAssociative (MonoidOpT s _) = semigroupLawAssociative s  -- | Left identity: @f e a == a@ ----- >>> monoidLawLeftIdentity add 42+-- >>> runIdentity $ monoidLawLeftIdentity add 42 -- True--- >>> monoidLawLeftIdentity monoidList [1,2,3 :: Int]+-- >>> runIdentity $ monoidLawLeftIdentity monoidList [1,2,3 :: Int] -- True-monoidLawLeftIdentity :: (Eq a) => MonoidOp a -> a -> Bool-monoidLawLeftIdentity m a =-  runMonoidOp m (identityMonoidOp m) a == a+monoidLawLeftIdentity :: (Monad f, Eq a) => MonoidOpT' f a -> a -> f Bool+monoidLawLeftIdentity m a = do+  r <- runMonoidOpT m (identityMonoidOpT m) a+  pure (r == a)  -- | Right identity: @f a e == a@ ----- >>> monoidLawRightIdentity add 42+-- >>> runIdentity $ monoidLawRightIdentity add 42 -- True--- >>> monoidLawRightIdentity monoidList [1,2,3 :: Int]+-- >>> runIdentity $ monoidLawRightIdentity monoidList [1,2,3 :: Int] -- True-monoidLawRightIdentity :: (Eq a) => MonoidOp a -> a -> Bool-monoidLawRightIdentity m a =-  runMonoidOp m a (identityMonoidOp m) == a+monoidLawRightIdentity :: (Monad f, Eq a) => MonoidOpT' f a -> a -> f Bool+monoidLawRightIdentity m a = do+  r <- runMonoidOpT m a (identityMonoidOpT m)+  pure (r == a) --- | Classy lens for types that contain a 'MonoidOp'.+-- | Classy lens for types that contain a 'MonoidOpT'. ----- >>> run (view monoidOp add) 3 4+-- >>> run (view monoidOpT add) 3 4 -- 7-class HasMonoidOp c a | c -> a where-  monoidOp :: Lens' c (MonoidOp a)+class HasMonoidOpT c f a b i | c -> f a b i where+  monoidOpT :: Lens' c (MonoidOpT f a b i) -instance HasMonoidOp (MonoidOp a) a where-  monoidOp = id+instance HasMonoidOpT (MonoidOpT f a b i) f a b i where+  monoidOpT = id --- | Classy prism for types that can be constructed from a 'MonoidOp'.+-- | Classy prism for types that can be constructed from a 'MonoidOpT'. ----- >>> run (review _MonoidOp add) 3 4+-- >>> run (review _MonoidOpT add) 3 4 -- 7-class AsMonoidOp c a | c -> a where-  _MonoidOp :: Prism' c (MonoidOp a)+class AsMonoidOpT c f a b i | c -> f a b i where+  _MonoidOpT :: Prism' c (MonoidOpT f a b i) -instance AsMonoidOp (MonoidOp a) a where-  _MonoidOp = id+instance AsMonoidOpT (MonoidOpT f a b i) f a b i where+  _MonoidOpT = id  ------- MonoidOp values via monoid+-- MonoidOp' values via monoid ----  -- | >>> run monoidUnit () () -- () -- >>> identityMonoidOp monoidUnit -- ()-monoidUnit :: MonoidOp ()+monoidUnit :: MonoidOp' () monoidUnit = monoid  -- | Lexicographic composition of orderings.@@ -254,7 +318,7 @@ -- GT -- >>> identityMonoidOp monoidOrdering -- EQ-monoidOrdering :: MonoidOp Ordering+monoidOrdering :: MonoidOp' Ordering monoidOrdering = monoid  -- | List concatenation.@@ -263,14 +327,14 @@ -- [1,2,3,4] -- >>> identityMonoidOp monoidList -- []-monoidList :: MonoidOp [a]+monoidList :: MonoidOp' [a] monoidList = monoid  -- | >>> run monoidProxy Proxy (Proxy :: Proxy Int) -- Proxy -- >>> identityMonoidOp monoidProxy -- Proxy-monoidProxy :: MonoidOp (Proxy a)+monoidProxy :: MonoidOp' (Proxy a) monoidProxy = monoid  -- | 'Nothing' is identity; 'Just' values are combined.@@ -281,54 +345,54 @@ -- Just [2] -- >>> identityMonoidOp (monoidMaybe semigroupList) -- Nothing-monoidMaybe :: SemigroupOp' a -> MonoidOp (Maybe a)-monoidMaybe s = MonoidOp (semigroupMaybe s) Nothing+monoidMaybe :: SemigroupOp' a -> MonoidOp' (Maybe a)+monoidMaybe s = MonoidOpT (semigroupMaybe s) Nothing  -- | Reverses the inner monoid. -- -- >>> run (monoidDual monoidList) (Dual [1]) (Dual [2 :: Int]) -- Dual {getDual = [2,1]}--- >>> identityMonoidOp (monoidDual (monoidList :: MonoidOp [Int]))+-- >>> identityMonoidOp (monoidDual (monoidList :: MonoidOp' [Int])) -- Dual {getDual = []}-monoidDual :: MonoidOp a -> MonoidOp (Dual a)-monoidDual (MonoidOp s e) = MonoidOp (semigroupDual s) (Dual e)+monoidDual :: MonoidOp' a -> MonoidOp' (Dual a)+monoidDual (MonoidOpT s e) = MonoidOpT (semigroupDual s) (Dual e)  -- | Delegates through 'Down'. -- -- >>> run (monoidDown monoidList) (Down [1]) (Down [2 :: Int]) -- Down [1,2]-monoidDown :: MonoidOp a -> MonoidOp (Down a)-monoidDown (MonoidOp s e) = MonoidOp (semigroupDown s) (Down e)+monoidDown :: MonoidOp' a -> MonoidOp' (Down a)+monoidDown (MonoidOpT s e) = MonoidOpT (semigroupDown s) (Down e)  -- | Delegates through 'Identity'. -- -- >>> run (monoidIdentity monoidList) (Identity [1]) (Identity [2 :: Int]) -- Identity [1,2]-monoidIdentity :: MonoidOp a -> MonoidOp (Identity a)-monoidIdentity (MonoidOp s e) = MonoidOp (semigroupIdentity s) (Identity e)+monoidIdentity :: MonoidOp' a -> MonoidOp' (Identity a)+monoidIdentity (MonoidOpT s e) = MonoidOpT (semigroupIdentity s) (Identity e)  -- | Pairwise combination. -- -- >>> run (monoidTuple monoidList monoidList) ([1 :: Int], [10]) ([2], [20 :: Int]) -- ([1,2],[10,20])--- >>> identityMonoidOp (monoidTuple monoidList monoidList :: MonoidOp ([Int], [Int]))+-- >>> identityMonoidOp (monoidTuple monoidList monoidList :: MonoidOp' ([Int], [Int])) -- ([],[])-monoidTuple :: MonoidOp a -> MonoidOp b -> MonoidOp (a, b)-monoidTuple (MonoidOp sa ea) (MonoidOp sb eb) = MonoidOp (semigroupTuple sa sb) (ea, eb)+monoidTuple :: MonoidOp' a -> MonoidOp' b -> MonoidOp' (a, b)+monoidTuple (MonoidOpT sa ea) (MonoidOpT sb eb) = MonoidOpT (semigroupTuple sa sb) (ea, eb)  -- | Uses the underlying monoid operation. -- -- >>> run (monoidWrappedMonoid monoidList) (WrapMonoid [1]) (WrapMonoid [2 :: Int]) -- WrapMonoid {unwrapMonoid = [1,2]}-monoidWrappedMonoid :: MonoidOp a -> MonoidOp (WrappedMonoid a)-monoidWrappedMonoid (MonoidOp s e) = MonoidOp (semigroupWrappedMonoid s) (WrapMonoid e)+monoidWrappedMonoid :: MonoidOp' a -> MonoidOp' (WrappedMonoid a)+monoidWrappedMonoid (MonoidOpT s e) = MonoidOpT (semigroupWrappedMonoid s) (WrapMonoid e)  -- | Pointwise combination. -- -- >>> run (monoidFunction monoidList) (++ "a") ((++ "b") :: String -> String) "x" -- "xaxb"-monoidFunction :: MonoidOp b -> MonoidOp (a -> b)-monoidFunction (MonoidOp s e) = MonoidOp (semigroupFunction s) (const e)+monoidFunction :: MonoidOp' b -> MonoidOp' (a -> b)+monoidFunction (MonoidOpT s e) = MonoidOpT (semigroupFunction s) (const e)  -- | First-success on 'Maybe' via 'Alt'. --@@ -338,8 +402,8 @@ -- Just 2 -- >>> identityMonoidOp monoidAlt -- Nothing-monoidAlt :: MonoidOp (Maybe a)-monoidAlt = MonoidOp (op (<!>)) Nothing+monoidAlt :: MonoidOp' (Maybe a)+monoidAlt = MonoidOpT (op (<!>)) Nothing  -- | First-success on 'Maybe' via 'Alternative'. --@@ -349,30 +413,30 @@ -- Just 2 -- >>> identityMonoidOp monoidAlternative -- Nothing-monoidAlternative :: MonoidOp (Maybe a)-monoidAlternative = MonoidOp (op (<|>)) Nothing+monoidAlternative :: MonoidOp' (Maybe a)+monoidAlternative = MonoidOpT (op (<|>)) Nothing  -- | Lift a monoid operation through an 'Data.Functor.Apply.Apply' functor via 'Data.Functor.Apply.liftF2'. -- Requires 'Applicative' for 'pure' to construct the identity element. -- -- >>> run (monoidLiftF2 add) (Just 3) (Just 4 :: Maybe Int) -- Just 7--- >>> identityMonoidOp (monoidLiftF2 add :: MonoidOp (Maybe Int))+-- >>> identityMonoidOp (monoidLiftF2 add :: MonoidOp' (Maybe Int)) -- Just 0-monoidLiftF2 :: (Applicative f) => MonoidOp a -> MonoidOp (f a)-monoidLiftF2 (MonoidOp s e) = MonoidOp (semigroupLiftA2 s) (pure e)+monoidLiftF2 :: (Applicative f) => MonoidOp' a -> MonoidOp' (f a)+monoidLiftF2 (MonoidOpT s e) = MonoidOpT (semigroupLiftA2 s) (pure e)  -- | Lift a monoid operation through an 'Applicative' functor via 'Control.Applicative.liftA2'. -- -- >>> run (monoidLiftA2 add) (Just 3) (Just 4 :: Maybe Int) -- Just 7--- >>> identityMonoidOp (monoidLiftA2 add :: MonoidOp (Maybe Int))+-- >>> identityMonoidOp (monoidLiftA2 add :: MonoidOp' (Maybe Int)) -- Just 0-monoidLiftA2 :: (Applicative f) => MonoidOp a -> MonoidOp (f a)-monoidLiftA2 (MonoidOp s e) = MonoidOp (semigroupLiftA2 s) (pure e)+monoidLiftA2 :: (Applicative f) => MonoidOp' a -> MonoidOp' (f a)+monoidLiftA2 (MonoidOpT s e) = MonoidOpT (semigroupLiftA2 s) (pure e)  ------- MonoidOp values via MonoidOp constructor+-- MonoidOp' values via MonoidOpT constructor ----  -- | Takes the minimum ('Min'). Requires 'Bounded' for 'maxBound' identity.@@ -381,8 +445,8 @@ -- 3 -- >>> identityMonoidOp monoidMin == (maxBound :: Int) -- True-monoidMin :: (Ord a, Bounded a) => MonoidOp a-monoidMin = MonoidOp (op min) maxBound+monoidMin :: (Ord a, Bounded a) => MonoidOp' a+monoidMin = MonoidOpT (op min) maxBound  -- | Takes the maximum ('Max'). Requires 'Bounded' for 'minBound' identity. --@@ -390,8 +454,8 @@ -- 4 -- >>> identityMonoidOp monoidMax == (minBound :: Int) -- True-monoidMax :: (Ord a, Bounded a) => MonoidOp a-monoidMax = MonoidOp (op max) minBound+monoidMax :: (Ord a, Bounded a) => MonoidOp' a+monoidMax = MonoidOpT (op max) minBound  -- | Logical conjunction ('All'). Identity is 'True'. --@@ -401,8 +465,8 @@ -- False -- >>> identityMonoidOp monoidAll -- True-monoidAll :: MonoidOp Bool-monoidAll = MonoidOp (op (&&)) True+monoidAll :: MonoidOp' Bool+monoidAll = MonoidOpT (op (&&)) True  -- | Logical disjunction ('Any'). Identity is 'False'. --@@ -412,8 +476,8 @@ -- True -- >>> identityMonoidOp monoidAny -- False-monoidAny :: MonoidOp Bool-monoidAny = MonoidOp (op (||)) False+monoidAny :: MonoidOp' Bool+monoidAny = MonoidOpT (op (||)) False  -- | Addition ('Sum'). Identity is 0. --@@ -421,8 +485,8 @@ -- 7 -- >>> identityMonoidOp monoidAddition -- 0-monoidAddition :: (Num a) => MonoidOp a-monoidAddition = MonoidOp (op (+)) 0+monoidAddition :: (Num a) => MonoidOp' a+monoidAddition = MonoidOpT (op (+)) 0  -- | Multiplication ('Product'). Identity is 1. --@@ -430,8 +494,8 @@ -- 12 -- >>> identityMonoidOp monoidMultiplication -- 1-monoidMultiplication :: (Num a) => MonoidOp a-monoidMultiplication = MonoidOp (op (*)) 1+monoidMultiplication :: (Num a) => MonoidOp' a+monoidMultiplication = MonoidOpT (op (*)) 1  -- | Function composition ('Endo'). Identity is 'id'. --@@ -439,8 +503,8 @@ -- 31 -- >>> identityMonoidOp monoidEndo 42 -- 42-monoidEndo :: MonoidOp (a -> a)-monoidEndo = MonoidOp (op (.)) id+monoidEndo :: MonoidOp' (a -> a)+monoidEndo = MonoidOpT (op (.)) id  -- | Bitwise AND. Identity is all ones ('complement' 'zeroBits'). --@@ -448,8 +512,8 @@ -- 15 -- >>> identityMonoidOp monoidAnd == (0xFF :: Word8) -- True-monoidAnd :: (Bits a) => MonoidOp a-monoidAnd = MonoidOp (op (.&.)) (complement zeroBits)+monoidAnd :: (Bits a) => MonoidOp' a+monoidAnd = MonoidOpT (op (.&.)) (complement zeroBits)  -- | Bitwise inclusive OR. Identity is 'zeroBits'. --@@ -457,8 +521,8 @@ -- 255 -- >>> identityMonoidOp monoidIor == (0 :: Word8) -- True-monoidIor :: (Bits a) => MonoidOp a-monoidIor = MonoidOp (op (.|.)) zeroBits+monoidIor :: (Bits a) => MonoidOp' a+monoidIor = MonoidOpT (op (.|.)) zeroBits  -- | Bitwise exclusive OR. Identity is 'zeroBits'. --@@ -466,8 +530,8 @@ -- 240 -- >>> identityMonoidOp monoidXor == (0 :: Word8) -- True-monoidXor :: (Bits a) => MonoidOp a-monoidXor = MonoidOp (op xor) zeroBits+monoidXor :: (Bits a) => MonoidOp' a+monoidXor = MonoidOpT (op xor) zeroBits  -- | Bitwise equivalence / XNOR. Identity is all ones ('complement' 'zeroBits'). --@@ -475,8 +539,8 @@ -- 15 -- >>> identityMonoidOp monoidIff == (0xFF :: Word8) -- True-monoidIff :: (FiniteBits a) => MonoidOp a-monoidIff = MonoidOp (op (\a b -> complement (xor a b))) (complement zeroBits)+monoidIff :: (FiniteBits a) => MonoidOp' a+monoidIff = MonoidOpT (op (\a b -> complement (xor a b))) (complement zeroBits)  ---- -- Collection values@@ -488,8 +552,8 @@ -- fromList [1,2,3] -- >>> identityMonoidOp monoidSetUnion == (Set.empty :: Set Int) -- True-monoidSetUnion :: (Ord a) => MonoidOp (Set a)-monoidSetUnion = MonoidOp (op Set.union) Set.empty+monoidSetUnion :: (Ord a) => MonoidOp' (Set a)+monoidSetUnion = MonoidOpT (op Set.union) Set.empty  -- | IntSet union. Identity is 'IntSet.empty'. --@@ -497,33 +561,33 @@ -- fromList [1,2,3] -- >>> identityMonoidOp monoidIntSetUnion == IntSet.empty -- True-monoidIntSetUnion :: MonoidOp IntSet-monoidIntSetUnion = MonoidOp (op IntSet.union) IntSet.empty+monoidIntSetUnion :: MonoidOp' IntSet+monoidIntSetUnion = MonoidOpT (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+monoidHashSetUnion :: (Eq a, Hashable a) => MonoidOp' (HashSet a)+monoidHashSetUnion = MonoidOpT (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+monoidMapUnion :: (Ord k) => MonoidOp' (Map k v)+monoidMapUnion = MonoidOpT (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+monoidIntMapUnion :: MonoidOp' (IntMap v)+monoidIntMapUnion = MonoidOpT (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+monoidHashMapUnion :: (Eq k, Hashable k) => MonoidOp' (HashMap k v)+monoidHashMapUnion = MonoidOpT (op HashMap.union) HashMap.empty

@@ -9,14 +9,21 @@ -- element that is not defined for all pairs of inputs. module Data.Associative.PartialMonoidOp   ( -- * Types-    PartialMonoidOp (..),+    PartialMonoidOpT (..),+    PartialMonoidOp,+    PartialMonoidOpT',+    PartialMonoidOp', -    -- * Isomorphism+    -- * Isomorphisms+    iPartialMonoidOpT,     iPartialMonoidOp,     nonPartialMonoid,+    defaultMonoidOp,      -- * Running+    runPartialMonoidOpT,     runPartialMonoidOp,+    identityPartialMonoidOpT,     identityPartialMonoidOp,      -- * Smart constructors@@ -28,8 +35,8 @@     pmonoidLawRightIdentity,      -- * Classy optics-    HasPartialMonoidOp (..),-    AsPartialMonoidOp (..),+    HasPartialMonoidOpT (..),+    AsPartialMonoidOpT (..),      -- * Values (via pmonoid)     pmonoidUnit,@@ -48,7 +55,7 @@     pmonoidLiftF2,     pmonoidLiftA2, -    -- * Values (via PartialMonoidOp)+    -- * Values (via PartialMonoidOpT)     pmonoidMin,     pmonoidMax,     pmonoidAll,@@ -81,23 +88,26 @@     review,     view,   )-import Data.Associative.MonoidOp (MonoidOp (..))+import Data.Associative.MonoidOp (MonoidOp', MonoidOpT (..)) import Data.Associative.PartialSemigroupOp   ( HasPartialSemigroupOpT (..),-    PartialSemigroupOp',     PartialSemigroupOpT,+    defaultSemigroupOpT,     iPartialSemigroupOp,+    iPartialSemigroupOpT,     nonPartialSemigroup,     psemigroupDown,     psemigroupDual,     psemigroupFunction,     psemigroupIdentity,+    psemigroupLawAssociative,     psemigroupLiftA2,     psemigroupMaybe,     psemigroupSemigroup,     psemigroupTuple,     psemigroupWrappedMonoid,     runPartialSemigroupOp,+    runPartialSemigroupOpT,     total,   ) import Data.Associative.SemigroupOp (SemigroupOp')@@ -125,7 +135,7 @@  -- $setup -- >>> import Data.Associative.SemigroupOp (SemigroupOp', op, semigroupList)--- >>> import Data.Associative.MonoidOp (MonoidOp(..), monoidList)+-- >>> import Data.Associative.MonoidOp (MonoidOpT(..), MonoidOp', monoidList, runMonoidOp, identityMonoidOp) -- >>> import Data.Associative.PartialSemigroupOp (PartialSemigroupOpT(..), total) -- >>> import Control.Lens (view, review) -- >>> import Data.Functor.Identity (Identity(..))@@ -140,66 +150,119 @@ -- >>> 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 add = PartialMonoidOpT (total (+)) 0 :: PartialMonoidOp' Int -- >>> let run = runPartialMonoidOp+-- >>> let runT = runPartialMonoidOpT --- | A partial monoid operation: an associative binary operation with an identity--- element, not necessarily defined for all pairs of inputs.+-- | A partial monoid transformer. The wrapped operation must be associative+-- (see 'pmonoidLawAssociative') with an identity element. -- -- >>> run add 3 4 -- Just 7 -- >>> identityPartialMonoidOp add -- 0-data PartialMonoidOp a = PartialMonoidOp (PartialSemigroupOp' a) a+data PartialMonoidOpT f a b i = PartialMonoidOpT (PartialSemigroupOpT f a b) i   deriving (Generic) --- | Iso between 'PartialMonoidOp' and a @(partial-binary-operation, identity)@ pair.+-- | A partial monoid using 'Identity' as the base functor.+type PartialMonoidOp a b i = PartialMonoidOpT Identity a b i++-- | A partial monoid transformer where input, output, and identity types coincide.+type PartialMonoidOpT' f x = PartialMonoidOpT f x x x++-- | A partial monoid where input, output, and identity types coincide.+type PartialMonoidOp' x = PartialMonoidOp x x x++-- | Iso between 'PartialMonoidOpT' and its underlying function paired with identity. --+-- >>> let (f, e) = view iPartialMonoidOpT add+-- >>> f 3 4+-- Identity (Just 7)+-- >>> e+-- 0+iPartialMonoidOpT :: Iso (PartialMonoidOpT f a b i) (PartialMonoidOpT f' a' b' i') (a -> a -> f (Maybe b), i) (a' -> a' -> f' (Maybe b'), i')+iPartialMonoidOpT =+  iso+    (\(PartialMonoidOpT s e) -> (runPartialSemigroupOpT s, e))+    (\(f, e) -> PartialMonoidOpT (review iPartialSemigroupOpT f) e)+{-# INLINE iPartialMonoidOpT #-}++-- | Iso between 'PartialMonoidOp' and a pure partial function paired with identity.+-- -- >>> let (f, e) = view iPartialMonoidOp add -- >>> f 3 4 -- Just 7 -- >>> e -- 0-iPartialMonoidOp :: Iso (PartialMonoidOp a) (PartialMonoidOp b) (a -> a -> Maybe a, a) (b -> b -> Maybe b, b)+iPartialMonoidOp :: Iso (PartialMonoidOp a b i) (PartialMonoidOp a' b' i') (a -> a -> Maybe b, i) (a' -> a' -> Maybe b', i') iPartialMonoidOp =   iso-    (\(PartialMonoidOp s e) -> (runPartialSemigroupOp s, e))-    (\(f, e) -> PartialMonoidOp (review iPartialSemigroupOp f) e)+    (\(PartialMonoidOpT s e) -> (runPartialSemigroupOp s, e))+    (\(f, e) -> PartialMonoidOpT (review iPartialSemigroupOp f) e) {-# INLINE iPartialMonoidOp #-} -nonPartialMonoid :: Iso (PartialSemigroupOpT (Const a) a a, a) (PartialSemigroupOpT (Const a') a' a', a') (MonoidOp a) (MonoidOp a')+nonPartialMonoid :: Iso (PartialMonoidOpT (Const a) a a a) (PartialMonoidOpT (Const a') a' a' a') (MonoidOp' a) (MonoidOp' a') nonPartialMonoid =   iso-    (\(s, e) -> MonoidOp (view nonPartialSemigroup s) e)-    (\(MonoidOp s e) -> (review nonPartialSemigroup s, e))+    (\(PartialMonoidOpT s e) -> MonoidOpT (view nonPartialSemigroup s) e)+    (\(MonoidOpT s e) -> PartialMonoidOpT (review nonPartialSemigroup s) e) {-# INLINE nonPartialMonoid #-} --- | Extract the partial binary operation and run it.+-- | Convert a partial monoid operation to a total one by providing a default+-- value for the undefined case. ----- >>> runPartialMonoidOp add 3 4+-- >>> runMonoidOp (defaultMonoidOp 0 add) 3 4+-- 7+-- >>> identityMonoidOp (defaultMonoidOp 0 add)+-- 0+defaultMonoidOp :: a -> PartialMonoidOp' a -> MonoidOp' a+defaultMonoidOp x (PartialMonoidOpT s e) = MonoidOpT (defaultSemigroupOpT (Identity x) s) e+{-# INLINE defaultMonoidOp #-}++-- | Unwrap a 'PartialMonoidOpT' to run its underlying partial operation.+--+-- >>> runT add 3 4+-- Identity (Just 7)+runPartialMonoidOpT :: PartialMonoidOpT f a b i -> a -> a -> f (Maybe b)+runPartialMonoidOpT (PartialMonoidOpT s _) = runPartialSemigroupOpT s+{-# INLINE runPartialMonoidOpT #-}++-- | Run a 'PartialMonoidOp' (specialised to 'Identity').+--+-- >>> run add 3 4 -- Just 7-runPartialMonoidOp :: PartialMonoidOp a -> a -> a -> Maybe a-runPartialMonoidOp (PartialMonoidOp s _) = runPartialSemigroupOp s+runPartialMonoidOp :: PartialMonoidOp a b i -> a -> a -> Maybe b+runPartialMonoidOp (PartialMonoidOpT s _) = runPartialSemigroupOp s {-# INLINE runPartialMonoidOp #-} --- | Extract the identity element.+-- | Extract the identity element from a 'PartialMonoidOpT'. --+-- >>> identityPartialMonoidOpT add+-- 0+-- >>> identityPartialMonoidOpT pmonoidList+-- []+identityPartialMonoidOpT :: PartialMonoidOpT f a b i -> i+identityPartialMonoidOpT (PartialMonoidOpT _ e) = e+{-# INLINE identityPartialMonoidOpT #-}++-- | Extract the identity element from a 'PartialMonoidOp'.+-- -- >>> identityPartialMonoidOp add -- 0 -- >>> identityPartialMonoidOp pmonoidList -- []-identityPartialMonoidOp :: PartialMonoidOp a -> a-identityPartialMonoidOp (PartialMonoidOp _ e) = e+identityPartialMonoidOp :: PartialMonoidOp a b i -> i+identityPartialMonoidOp (PartialMonoidOpT _ e) = e {-# INLINE identityPartialMonoidOp #-} --- | Build a 'PartialMonoidOp' from any 'Monoid' instance.+-- | Build a 'PartialMonoidOp'' from any 'Monoid' instance. ----- >>> run (pmonoid :: PartialMonoidOp [Int]) [1,2] [3,4]+-- >>> run (pmonoid :: PartialMonoidOp' [Int]) [1,2] [3,4] -- Just [1,2,3,4]--- >>> identityPartialMonoidOp (pmonoid :: PartialMonoidOp [Int])+-- >>> identityPartialMonoidOp (pmonoid :: PartialMonoidOp' [Int]) -- []-pmonoid :: (Monoid a) => PartialMonoidOp a-pmonoid = PartialMonoidOp psemigroupSemigroup mempty+pmonoid :: (Monoid a) => PartialMonoidOp' a+pmonoid = PartialMonoidOpT psemigroupSemigroup mempty {-# INLINE pmonoid #-}  -- | Classy lens giving access to the underlying 'PartialSemigroupOpT'.@@ -207,8 +270,8 @@ -- >>> 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)+instance HasPartialSemigroupOpT (PartialMonoidOpT f a b i) f a b where+  partialSemigroupOpT = lens (\(PartialMonoidOpT s _) -> s) (\(PartialMonoidOpT _ e) s' -> PartialMonoidOpT s' e)  {- HLINT ignore "Monoid law, left identity" -} {- HLINT ignore "Monoid law, right identity" -}@@ -222,68 +285,62 @@ -- Left- and right-association of three values must agree: -- both 'Nothing' or both the same 'Just'. ----- >>> pmonoidLawAssociative add 1 2 3+-- >>> runIdentity $ 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+pmonoidLawAssociative :: (Monad f, Eq a) => PartialMonoidOpT' f a -> a -> a -> a -> f Bool+pmonoidLawAssociative (PartialMonoidOpT s _) = psemigroupLawAssociative s  -- | Left identity: @f e a == Just a@ ----- >>> pmonoidLawLeftIdentity add 42+-- >>> runIdentity $ pmonoidLawLeftIdentity add 42 -- True--- >>> pmonoidLawLeftIdentity pmonoidList [1,2,3 :: Int]+-- >>> runIdentity $ pmonoidLawLeftIdentity pmonoidList [1,2,3 :: Int] -- True-pmonoidLawLeftIdentity :: (Eq a) => PartialMonoidOp a -> a -> Bool-pmonoidLawLeftIdentity m a =-  runPartialMonoidOp m (identityPartialMonoidOp m) a == Just a+pmonoidLawLeftIdentity :: (Monad f, Eq a) => PartialMonoidOpT' f a -> a -> f Bool+pmonoidLawLeftIdentity m a = do+  r <- runPartialMonoidOpT m (identityPartialMonoidOpT m) a+  pure (r == Just a)  -- | Right identity: @f a e == Just a@ ----- >>> pmonoidLawRightIdentity add 42+-- >>> runIdentity $ pmonoidLawRightIdentity add 42 -- True--- >>> pmonoidLawRightIdentity pmonoidList [1,2,3 :: Int]+-- >>> runIdentity $ pmonoidLawRightIdentity pmonoidList [1,2,3 :: Int] -- True-pmonoidLawRightIdentity :: (Eq a) => PartialMonoidOp a -> a -> Bool-pmonoidLawRightIdentity m a =-  runPartialMonoidOp m a (identityPartialMonoidOp m) == Just a+pmonoidLawRightIdentity :: (Monad f, Eq a) => PartialMonoidOpT' f a -> a -> f Bool+pmonoidLawRightIdentity m a = do+  r <- runPartialMonoidOpT m a (identityPartialMonoidOpT m)+  pure (r == Just a) --- | Classy lens for types that contain a 'PartialMonoidOp'.+-- | Classy lens for types that contain a 'PartialMonoidOpT'. ----- >>> run (view partialMonoidOp add) 3 4+-- >>> run (view partialMonoidOpT add) 3 4 -- Just 7-class HasPartialMonoidOp c a | c -> a where-  partialMonoidOp :: Lens' c (PartialMonoidOp a)+class HasPartialMonoidOpT c f a b i | c -> f a b i where+  partialMonoidOpT :: Lens' c (PartialMonoidOpT f a b i) -instance HasPartialMonoidOp (PartialMonoidOp a) a where-  partialMonoidOp = id+instance HasPartialMonoidOpT (PartialMonoidOpT f a b i) f a b i where+  partialMonoidOpT = id --- | Classy prism for types that can be constructed from a 'PartialMonoidOp'.+-- | Classy prism for types that can be constructed from a 'PartialMonoidOpT'. ----- >>> run (review _PartialMonoidOp add) 3 4+-- >>> run (review _PartialMonoidOpT add) 3 4 -- Just 7-class AsPartialMonoidOp c a | c -> a where-  _PartialMonoidOp :: Prism' c (PartialMonoidOp a)+class AsPartialMonoidOpT c f a b i | c -> f a b i where+  _PartialMonoidOpT :: Prism' c (PartialMonoidOpT f a b i) -instance AsPartialMonoidOp (PartialMonoidOp a) a where-  _PartialMonoidOp = id+instance AsPartialMonoidOpT (PartialMonoidOpT f a b i) f a b i where+  _PartialMonoidOpT = id  ------- PartialMonoidOp values via pmonoid+-- PartialMonoidOp' values via pmonoid ----  -- | >>> run pmonoidUnit () () -- Just () -- >>> identityPartialMonoidOp pmonoidUnit -- ()-pmonoidUnit :: PartialMonoidOp ()+pmonoidUnit :: PartialMonoidOp' () pmonoidUnit = pmonoid  -- | Lexicographic composition of orderings.@@ -294,7 +351,7 @@ -- Just GT -- >>> identityPartialMonoidOp pmonoidOrdering -- EQ-pmonoidOrdering :: PartialMonoidOp Ordering+pmonoidOrdering :: PartialMonoidOp' Ordering pmonoidOrdering = pmonoid  -- | List concatenation.@@ -303,14 +360,14 @@ -- Just [1,2,3,4] -- >>> identityPartialMonoidOp pmonoidList -- []-pmonoidList :: PartialMonoidOp [a]+pmonoidList :: PartialMonoidOp' [a] pmonoidList = pmonoid  -- | >>> run pmonoidProxy Proxy (Proxy :: Proxy Int) -- Just Proxy -- >>> identityPartialMonoidOp pmonoidProxy -- Proxy-pmonoidProxy :: PartialMonoidOp (Proxy a)+pmonoidProxy :: PartialMonoidOp' (Proxy a) pmonoidProxy = pmonoid  -- | 'Nothing' is identity; 'Just' values are combined.@@ -321,54 +378,54 @@ -- Just (Just [2]) -- >>> identityPartialMonoidOp (pmonoidMaybe semigroupList) -- Nothing-pmonoidMaybe :: SemigroupOp' a -> PartialMonoidOp (Maybe a)-pmonoidMaybe s = PartialMonoidOp (psemigroupMaybe s) Nothing+pmonoidMaybe :: SemigroupOp' a -> PartialMonoidOp' (Maybe a)+pmonoidMaybe s = PartialMonoidOpT (psemigroupMaybe s) Nothing  -- | Reverses the inner monoid. -- -- >>> run (pmonoidDual monoidList) (Dual [1]) (Dual [2 :: Int]) -- Just (Dual {getDual = [2,1]})--- >>> identityPartialMonoidOp (pmonoidDual (monoidList :: MonoidOp [Int]))+-- >>> identityPartialMonoidOp (pmonoidDual (monoidList :: MonoidOp' [Int])) -- Dual {getDual = []}-pmonoidDual :: MonoidOp a -> PartialMonoidOp (Dual a)-pmonoidDual (MonoidOp s e) = PartialMonoidOp (psemigroupDual s) (Dual e)+pmonoidDual :: MonoidOp' a -> PartialMonoidOp' (Dual a)+pmonoidDual (MonoidOpT s e) = PartialMonoidOpT (psemigroupDual s) (Dual e)  -- | Delegates through 'Down'. -- -- >>> run (pmonoidDown monoidList) (Down [1]) (Down [2 :: Int]) -- Just (Down [1,2])-pmonoidDown :: MonoidOp a -> PartialMonoidOp (Down a)-pmonoidDown (MonoidOp s e) = PartialMonoidOp (psemigroupDown s) (Down e)+pmonoidDown :: MonoidOp' a -> PartialMonoidOp' (Down a)+pmonoidDown (MonoidOpT s e) = PartialMonoidOpT (psemigroupDown s) (Down e)  -- | Delegates through 'Identity'. -- -- >>> run (pmonoidIdentity monoidList) (Identity [1]) (Identity [2 :: Int]) -- Just (Identity [1,2])-pmonoidIdentity :: MonoidOp a -> PartialMonoidOp (Identity a)-pmonoidIdentity (MonoidOp s e) = PartialMonoidOp (psemigroupIdentity s) (Identity e)+pmonoidIdentity :: MonoidOp' a -> PartialMonoidOp' (Identity a)+pmonoidIdentity (MonoidOpT s e) = PartialMonoidOpT (psemigroupIdentity s) (Identity e)  -- | Pairwise combination. -- -- >>> run (pmonoidTuple monoidList monoidList) ([1 :: Int], [10]) ([2], [20 :: Int]) -- Just ([1,2],[10,20])--- >>> identityPartialMonoidOp (pmonoidTuple monoidList monoidList :: PartialMonoidOp ([Int], [Int]))+-- >>> identityPartialMonoidOp (pmonoidTuple monoidList monoidList :: PartialMonoidOp' ([Int], [Int])) -- ([],[])-pmonoidTuple :: MonoidOp a -> MonoidOp b -> PartialMonoidOp (a, b)-pmonoidTuple (MonoidOp sa ea) (MonoidOp sb eb) = PartialMonoidOp (psemigroupTuple sa sb) (ea, eb)+pmonoidTuple :: MonoidOp' a -> MonoidOp' b -> PartialMonoidOp' (a, b)+pmonoidTuple (MonoidOpT sa ea) (MonoidOpT sb eb) = PartialMonoidOpT (psemigroupTuple sa sb) (ea, eb)  -- | Uses the underlying monoid operation. -- -- >>> run (pmonoidWrappedMonoid monoidList) (WrapMonoid [1]) (WrapMonoid [2 :: Int]) -- Just (WrapMonoid {unwrapMonoid = [1,2]})-pmonoidWrappedMonoid :: MonoidOp a -> PartialMonoidOp (WrappedMonoid a)-pmonoidWrappedMonoid (MonoidOp s e) = PartialMonoidOp (psemigroupWrappedMonoid s) (WrapMonoid e)+pmonoidWrappedMonoid :: MonoidOp' a -> PartialMonoidOp' (WrappedMonoid a)+pmonoidWrappedMonoid (MonoidOpT s e) = PartialMonoidOpT (psemigroupWrappedMonoid s) (WrapMonoid e)  -- | Pointwise combination. -- -- >>> fmap ($ "x") (run (pmonoidFunction monoidList) (++ "a") ((++ "b") :: String -> String)) -- Just "xaxb"-pmonoidFunction :: MonoidOp b -> PartialMonoidOp (a -> b)-pmonoidFunction (MonoidOp s e) = PartialMonoidOp (psemigroupFunction s) (const e)+pmonoidFunction :: MonoidOp' b -> PartialMonoidOp' (a -> b)+pmonoidFunction (MonoidOpT s e) = PartialMonoidOpT (psemigroupFunction s) (const e)  -- | First-success on 'Maybe' via 'Alt'. --@@ -378,8 +435,8 @@ -- Just (Just 2) -- >>> identityPartialMonoidOp pmonoidAlt -- Nothing-pmonoidAlt :: PartialMonoidOp (Maybe a)-pmonoidAlt = PartialMonoidOp (total (<!>)) Nothing+pmonoidAlt :: PartialMonoidOp' (Maybe a)+pmonoidAlt = PartialMonoidOpT (total (<!>)) Nothing  -- | First-success on 'Maybe' via 'Alternative'. --@@ -389,30 +446,30 @@ -- Just (Just 2) -- >>> identityPartialMonoidOp pmonoidAlternative -- Nothing-pmonoidAlternative :: PartialMonoidOp (Maybe a)-pmonoidAlternative = PartialMonoidOp (total (<|>)) Nothing+pmonoidAlternative :: PartialMonoidOp' (Maybe a)+pmonoidAlternative = PartialMonoidOpT (total (<|>)) Nothing  -- | Lift a monoid operation through an 'Data.Functor.Apply.Apply' functor via 'Data.Functor.Apply.liftF2'. -- Requires 'Applicative' for 'pure' to construct the identity element. -- -- >>> run (pmonoidLiftF2 monoidList) (Just [1,2]) (Just [3,4 :: Int]) -- Just (Just [1,2,3,4])--- >>> identityPartialMonoidOp (pmonoidLiftF2 monoidList :: PartialMonoidOp (Maybe [Int]))+-- >>> identityPartialMonoidOp (pmonoidLiftF2 monoidList :: PartialMonoidOp' (Maybe [Int])) -- Just []-pmonoidLiftF2 :: (Applicative f) => MonoidOp a -> PartialMonoidOp (f a)-pmonoidLiftF2 (MonoidOp s e) = PartialMonoidOp (psemigroupLiftA2 s) (pure e)+pmonoidLiftF2 :: (Applicative f) => MonoidOp' a -> PartialMonoidOp' (f a)+pmonoidLiftF2 (MonoidOpT s e) = PartialMonoidOpT (psemigroupLiftA2 s) (pure e)  -- | Lift a monoid operation through an 'Applicative' functor via 'Control.Applicative.liftA2'. -- -- >>> run (pmonoidLiftA2 monoidList) (Just [1,2]) (Just [3,4 :: Int]) -- Just (Just [1,2,3,4])--- >>> identityPartialMonoidOp (pmonoidLiftA2 monoidList :: PartialMonoidOp (Maybe [Int]))+-- >>> identityPartialMonoidOp (pmonoidLiftA2 monoidList :: PartialMonoidOp' (Maybe [Int])) -- Just []-pmonoidLiftA2 :: (Applicative f) => MonoidOp a -> PartialMonoidOp (f a)-pmonoidLiftA2 (MonoidOp s e) = PartialMonoidOp (psemigroupLiftA2 s) (pure e)+pmonoidLiftA2 :: (Applicative f) => MonoidOp' a -> PartialMonoidOp' (f a)+pmonoidLiftA2 (MonoidOpT s e) = PartialMonoidOpT (psemigroupLiftA2 s) (pure e)  ------- PartialMonoidOp values via PartialMonoidOp constructor+-- PartialMonoidOp' values via PartialMonoidOpT constructor ----  -- | Takes the minimum ('Min'). Requires 'Bounded' for 'maxBound' identity.@@ -421,8 +478,8 @@ -- Just 3 -- >>> identityPartialMonoidOp pmonoidMin == (maxBound :: Int) -- True-pmonoidMin :: (Ord a, Bounded a) => PartialMonoidOp a-pmonoidMin = PartialMonoidOp (total min) maxBound+pmonoidMin :: (Ord a, Bounded a) => PartialMonoidOp' a+pmonoidMin = PartialMonoidOpT (total min) maxBound  -- | Takes the maximum ('Max'). Requires 'Bounded' for 'minBound' identity. --@@ -430,8 +487,8 @@ -- Just 4 -- >>> identityPartialMonoidOp pmonoidMax == (minBound :: Int) -- True-pmonoidMax :: (Ord a, Bounded a) => PartialMonoidOp a-pmonoidMax = PartialMonoidOp (total max) minBound+pmonoidMax :: (Ord a, Bounded a) => PartialMonoidOp' a+pmonoidMax = PartialMonoidOpT (total max) minBound  -- | Logical conjunction ('All'). Identity is 'True'. --@@ -441,8 +498,8 @@ -- Just False -- >>> identityPartialMonoidOp pmonoidAll -- True-pmonoidAll :: PartialMonoidOp Bool-pmonoidAll = PartialMonoidOp (total (&&)) True+pmonoidAll :: PartialMonoidOp' Bool+pmonoidAll = PartialMonoidOpT (total (&&)) True  -- | Logical disjunction ('Any'). Identity is 'False'. --@@ -452,8 +509,8 @@ -- Just True -- >>> identityPartialMonoidOp pmonoidAny -- False-pmonoidAny :: PartialMonoidOp Bool-pmonoidAny = PartialMonoidOp (total (||)) False+pmonoidAny :: PartialMonoidOp' Bool+pmonoidAny = PartialMonoidOpT (total (||)) False  -- | Addition ('Sum'). Identity is 0. --@@ -461,8 +518,8 @@ -- Just 7 -- >>> identityPartialMonoidOp pmonoidAddition -- 0-pmonoidAddition :: (Num a) => PartialMonoidOp a-pmonoidAddition = PartialMonoidOp (total (+)) 0+pmonoidAddition :: (Num a) => PartialMonoidOp' a+pmonoidAddition = PartialMonoidOpT (total (+)) 0  -- | Multiplication ('Product'). Identity is 1. --@@ -470,8 +527,8 @@ -- Just 12 -- >>> identityPartialMonoidOp pmonoidMultiplication -- 1-pmonoidMultiplication :: (Num a) => PartialMonoidOp a-pmonoidMultiplication = PartialMonoidOp (total (*)) 1+pmonoidMultiplication :: (Num a) => PartialMonoidOp' a+pmonoidMultiplication = PartialMonoidOpT (total (*)) 1  -- | Function composition ('Endo'). Identity is 'id'. --@@ -479,8 +536,8 @@ -- Just 31 -- >>> identityPartialMonoidOp pmonoidEndo 42 -- 42-pmonoidEndo :: PartialMonoidOp (a -> a)-pmonoidEndo = PartialMonoidOp (total (.)) id+pmonoidEndo :: PartialMonoidOp' (a -> a)+pmonoidEndo = PartialMonoidOpT (total (.)) id  -- | Bitwise AND. Identity is all ones ('complement' 'zeroBits'). --@@ -488,8 +545,8 @@ -- Just 15 -- >>> identityPartialMonoidOp pmonoidAnd == (0xFF :: Word8) -- True-pmonoidAnd :: (Bits a) => PartialMonoidOp a-pmonoidAnd = PartialMonoidOp (total (.&.)) (complement zeroBits)+pmonoidAnd :: (Bits a) => PartialMonoidOp' a+pmonoidAnd = PartialMonoidOpT (total (.&.)) (complement zeroBits)  -- | Bitwise inclusive OR. Identity is 'zeroBits'. --@@ -497,8 +554,8 @@ -- Just 255 -- >>> identityPartialMonoidOp pmonoidIor == (0 :: Word8) -- True-pmonoidIor :: (Bits a) => PartialMonoidOp a-pmonoidIor = PartialMonoidOp (total (.|.)) zeroBits+pmonoidIor :: (Bits a) => PartialMonoidOp' a+pmonoidIor = PartialMonoidOpT (total (.|.)) zeroBits  -- | Bitwise exclusive OR. Identity is 'zeroBits'. --@@ -506,8 +563,8 @@ -- Just 240 -- >>> identityPartialMonoidOp pmonoidXor == (0 :: Word8) -- True-pmonoidXor :: (Bits a) => PartialMonoidOp a-pmonoidXor = PartialMonoidOp (total xor) zeroBits+pmonoidXor :: (Bits a) => PartialMonoidOp' a+pmonoidXor = PartialMonoidOpT (total xor) zeroBits  -- | Bitwise equivalence / XNOR. Identity is all ones ('complement' 'zeroBits'). --@@ -515,8 +572,8 @@ -- Just 15 -- >>> identityPartialMonoidOp pmonoidIff == (0xFF :: Word8) -- True-pmonoidIff :: (FiniteBits a) => PartialMonoidOp a-pmonoidIff = PartialMonoidOp (total (\a b -> complement (xor a b))) (complement zeroBits)+pmonoidIff :: (FiniteBits a) => PartialMonoidOp' a+pmonoidIff = PartialMonoidOpT (total (\a b -> complement (xor a b))) (complement zeroBits)  ---- -- Collection values@@ -528,8 +585,8 @@ -- 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+pmonoidSetUnion :: (Ord a) => PartialMonoidOp' (Set a)+pmonoidSetUnion = PartialMonoidOpT (total Set.union) Set.empty  -- | IntSet union. Identity is 'IntSet.empty'. --@@ -537,33 +594,33 @@ -- Just (fromList [1,2,3]) -- >>> identityPartialMonoidOp pmonoidIntSetUnion == IntSet.empty -- True-pmonoidIntSetUnion :: PartialMonoidOp IntSet-pmonoidIntSetUnion = PartialMonoidOp (total IntSet.union) IntSet.empty+pmonoidIntSetUnion :: PartialMonoidOp' IntSet+pmonoidIntSetUnion = PartialMonoidOpT (total IntSet.union) IntSet.empty  -- | HashSet union. Identity is 'HashSet.empty'. -- -- >>> fmap sort (fmap HashSet.toList (run pmonoidHashSetUnion (HashSet.fromList [1,2]) (HashSet.fromList [2,3 :: Int]))) -- Just [1,2,3]-pmonoidHashSetUnion :: (Eq a, Hashable a) => PartialMonoidOp (HashSet a)-pmonoidHashSetUnion = PartialMonoidOp (total HashSet.union) HashSet.empty+pmonoidHashSetUnion :: (Eq a, Hashable a) => PartialMonoidOp' (HashSet a)+pmonoidHashSetUnion = PartialMonoidOpT (total HashSet.union) HashSet.empty  -- | Map union (left-biased on overlapping keys). Identity is 'Map.empty'. -- -- >>> run pmonoidMapUnion (Map.fromList [(1 :: Int,'a'),(2,'b')]) (Map.fromList [(2,'x'),(3,'c')]) -- Just (fromList [(1,'a'),(2,'b'),(3,'c')])-pmonoidMapUnion :: (Ord k) => PartialMonoidOp (Map k v)-pmonoidMapUnion = PartialMonoidOp (total Map.union) Map.empty+pmonoidMapUnion :: (Ord k) => PartialMonoidOp' (Map k v)+pmonoidMapUnion = PartialMonoidOpT (total Map.union) Map.empty  -- | IntMap union (left-biased on overlapping keys). Identity is 'IntMap.empty'. -- -- >>> run pmonoidIntMapUnion (IntMap.fromList [(1,'a'),(2,'b')]) (IntMap.fromList [(2,'x'),(3,'c')]) -- Just (fromList [(1,'a'),(2,'b'),(3,'c')])-pmonoidIntMapUnion :: PartialMonoidOp (IntMap v)-pmonoidIntMapUnion = PartialMonoidOp (total IntMap.union) IntMap.empty+pmonoidIntMapUnion :: PartialMonoidOp' (IntMap v)+pmonoidIntMapUnion = PartialMonoidOpT (total IntMap.union) IntMap.empty  -- | HashMap union (left-biased on overlapping keys). Identity is 'HashMap.empty'. -- -- >>> fmap sort (fmap HashMap.toList (run pmonoidHashMapUnion (HashMap.fromList [(1 :: Int,'a'),(2,'b')]) (HashMap.fromList [(2,'x'),(3,'c')]))) -- Just [(1,'a'),(2,'b'),(3,'c')]-pmonoidHashMapUnion :: (Eq k, Hashable k) => PartialMonoidOp (HashMap k v)-pmonoidHashMapUnion = PartialMonoidOp (total HashMap.union) HashMap.empty+pmonoidHashMapUnion :: (Eq k, Hashable k) => PartialMonoidOp' (HashMap k v)+pmonoidHashMapUnion = PartialMonoidOpT (total HashMap.union) HashMap.empty

@@ -22,6 +22,7 @@     iPartialSemigroupOpT,     iPartialSemigroupOp,     nonPartialSemigroup,+    defaultSemigroupOpT,      -- * Running     runPartialSemigroupOpT,@@ -126,7 +127,7 @@ import Control.Monad.State.Class (MonadState (..)) import Control.Monad.Writer.Class (MonadWriter (..)) import Control.Selective (Selective (..), selectM)-import Data.Associative.SemigroupOp (SemigroupOp, SemigroupOp', op, runSemigroupOp)+import Data.Associative.SemigroupOp (SemigroupOp, SemigroupOp', SemigroupOpT (..), op, runSemigroupOp) import Data.Bits (Bits, FiniteBits, complement, xor, (.&.), (.|.)) import Data.Functor.Alt (Alt (..)) import Data.Functor.Apply (Apply (..), liftF2)@@ -147,6 +148,7 @@ import Data.List.NonEmpty (NonEmpty) import Data.Map (Map) import qualified Data.Map as Map+import Data.Maybe (fromMaybe) import Data.Ord (Down (..)) import Data.Profunctor (Choice (..), Profunctor (..), Strong (..)) import Data.Proxy (Proxy)@@ -180,7 +182,7 @@ -- >>> import qualified Data.Map as Map -- >>> import qualified Data.IntMap as IntMap -- >>> import qualified Data.HashMap.Strict as HashMap--- >>> import Data.Associative.SemigroupOp (SemigroupOp', op, semigroupList)+-- >>> import Data.Associative.SemigroupOp (SemigroupOp', op, semigroupList, runSemigroupOp) -- >>> 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@@ -205,6 +207,17 @@  -- | A partial semigroup where input and output types coincide. type PartialSemigroupOp' x = PartialSemigroupOp x x++-- | Convert a partial semigroup operation to a total one by providing a default+-- value for the undefined case.+--+-- >>> runSemigroupOp (defaultSemigroupOpT 0 addPos) 3 4+-- 7+-- >>> runSemigroupOp (defaultSemigroupOpT 0 addPos) (-1) 4+-- 0+defaultSemigroupOpT :: (Applicative f) => f b -> PartialSemigroupOpT f a b -> SemigroupOpT f a b+defaultSemigroupOpT x (PartialSemigroupOpT k) = SemigroupOpT (\a1 a2 -> fromMaybe <$> x <*> k a1 a2)+{-# INLINE defaultSemigroupOpT #-}  -- | Iso between 'PartialSemigroupOpT' and its underlying function. --