monoid-extras 0.5 → 0.5.1

raw patch · 4 files changed

+184/−7 lines, 4 filesdep ~basedep ~groupsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, groups

API changes (from Hackage documentation)

Files

• CHANGES +7/−0
• monoid-extras.cabal +9/−6
• src/Data/Monoid/Coproduct/Strict.hs +167/−0
• src/Data/Monoid/Recommend.hs +1/−1

@@ -1,3 +1,10 @@+* 0.5.1: 19 Oct 2019++- New module Data.Monoid.Coproduct.Strict for a more efficient coproduct in+  some use cases.+- Update for GHC 8.8.+- Drop support for GHC 7.8.+ * 0.5: 14 May 2018  - Modernize Data.Monoid.WithSemigroup

@@ -1,5 +1,5 @@ name:                monoid-extras-version:             0.5+version:             0.5.1 synopsis:            Various extra monoid-related definitions and utilities description:         Various extra monoid-related definitions and utilities,                      such as monoid actions, monoid coproducts, semi-direct@@ -14,7 +14,7 @@ category:            Data build-type:          Simple cabal-version:       >=1.10-tested-with:         GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.2+tested-with:         GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.2, GHC == 8.6.1, GHC == 8.8.1  source-repository head   type: git@@ -26,6 +26,7 @@                      Data.Monoid.SemiDirectProduct,                      Data.Monoid.SemiDirectProduct.Strict                      Data.Monoid.Coproduct,+                     Data.Monoid.Coproduct.Strict,                      Data.Monoid.Cut,                      Data.Monoid.Deletable,                      Data.Monoid.Endomorphism,@@ -35,13 +36,15 @@                      Data.Monoid.Split,                      Data.Monoid.WithSemigroup -  build-depends:     base >= 4.3 && < 4.12,+  build-depends:     base >= 4.3 && < 4.14,                      groups < 0.5,-                     semigroups >= 0.8 && < 0.19,-                     semigroupoids >= 4.0 && < 5.3+                     semigroups >= 0.8 && < 0.20,+                     semigroupoids >= 4.0 && < 5.4    hs-source-dirs:    src +  ghc-options: -Wall+   other-extensions:  DeriveFunctor,                      FlexibleInstances,                      MultiParamTypeClasses,@@ -52,7 +55,7 @@   hs-source-dirs: benchmarks   main-is: SemiDirectProduct.hs   type: exitcode-stdio-1.0-  build-depends: base          >= 4.3 &&  < 4.12+  build-depends: base          >= 4.3 &&  < 4.14                , semigroups                , criterion                , monoid-extras

@@ -0,0 +1,167 @@+{-# LANGUAGE BangPatterns          #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MonoLocalBinds        #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes            #-}+{-# LANGUAGE TypeOperators         #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.Coproduct.Strict+-- Copyright   :  (c) 2015 diagrams-core team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- A strict coproduct of two monoids.+--+-----------------------------------------------------------------------------++module Data.Monoid.Coproduct.Strict+  (+    -- * Coproduct+    (:+:)+  , inL, inR+  , prependL, prependR+  , killL, killR+  , untangle++  -- ** Lenses+  , untangled+  , _L+  , _R++  ) where++import           Data.Monoid.Action+import           Data.Monoid.WithSemigroup+import           Data.Semigroup+import           Prelude++-- Internal strict version of 'Data.Semigroup.Option'+data Possible a = Only !a | Nought++instance Semigroup a => Semigroup (Possible a) where+  Only a <> Only b = Only (a <> b)+  Nought <> b      = b+  a      <> _      = a+  {-# INLINE (<>) #-}++instance Semigroup a => Monoid (Possible a) where+  mempty = Nought+  {-# INLINE mempty #-}+  mappend = (<>)+  {-# INLINE mappend #-}++-- | @m :+: n@ is the coproduct of monoids @m@ and @n@. Concatentation+--   is equivilent to+--+-- @+-- (m1 :+: n1) <> (m2 :+: n2) = (m1 <> m2) :+: (n1 <> act m1 n2)@+-- @+--+--   but has a more efficient internal implimentation.+data m :+: n = C !(Possible n) !(Possible m) !(Possible n)+-- The left n already has the action m applied. The right n still needs+-- m applied, but it kept there incase more n comes to reduce the number+-- of actions that need to be applied.++instance (Action m n, Monoid m, Monoid' n, Show m, Show n) => Show (m :+: n) where+  showsPrec p c = showParen (p > 5) $+    showsPrec 11 m . showString " :+: " . showsPrec 11 n+    where (m,n) = untangle c++instance (Action m n, Semigroup m, Semigroup n) => Semigroup (m :+: n) where+  C n1 m1 o1 <> C n2 m2 o2 = C (n1 <> act' m1 (o1 <> n2)) (m1 <> m2) o2+  {-# INLINE (<>) #-}++instance (Action m n, Semigroup m, Semigroup n) => Monoid (m :+: n) where+  mempty  = C Nought Nought Nought+  {-# INLINE mempty #-}+  mappend = (<>)+  {-# INLINE mappend #-}++-- | Coproducts act on other things by having each of the components+--   act individually.+instance (Action m n, Action m r, Action n r, Semigroup n) => Action (m :+: n) r where+  act (C n m o) = act'' n' . act'' m+    where !n' = n <> act' m o+  {-# INLINE act #-}++-- | Construct a coproduct with a left value.+inL :: m -> m :+: n+inL m = C Nought (Only m) Nought+{-# INLINE inL #-}++-- | Construct a coproduct with a right value.+inR :: n -> m :+: n+inR r = C (Only r) Nought Nought+{-# INLINE inR #-}++-- | Prepend a value from the left.+prependL :: Semigroup m => m -> m :+: n -> m :+: n+prependL m' (C n m o) = C n (Only m' <> m) o+{-# INLINE prependL #-}++-- | Prepend a value from the right.+prependR :: Semigroup n => n -> m :+: n -> m :+: n+prependR n' (C n m o) = C (Only n' <> n) m o+{-# INLINE prependR #-}++-- | Extract @m@ from a coproduct.+killR :: Monoid m => m :+: n -> m+killR (C _ m _) = get m+{-# INLINE killR #-}++-- | Extract @n@ from a coproduct.+killL :: (Action m n, Monoid' n) => m :+: n -> n+killL (C n m o) = get $ n <> act' m o+{-# INLINE killL #-}++untangle :: (Action m n, Monoid m, Monoid' n) => m :+: n -> (m,n)+untangle (C n m o) = (get m, get n')+  where !n' = n <> act' m o+{-# INLINE untangle #-}++-- Lenses --------------------------------------------------------------++type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t++-- | Lens onto the both @m@ and @n@.+untangled :: (Action m n, Monoid m, Monoid' n) => Lens (m :+: n) (m' :+: n') (m,n) (m',n')+untangled f c = f (untangle c) <&> \(m',n') -> C (Only n') (Only m') Nought+{-# INLINE untangled #-}+-- this could be an iso if we depended on profunctors++-- | Lens onto the left value of a coproduct.+_L :: (Action m n, Monoid m, Semigroup n) => Lens (m :+: n) (m' :+: n) m m'+_L f (C n m o) = f (get m) <&> \m' -> C (n <> act' m o) (Only m') Nought+{-# INLINE _L #-}+-- this could be a prism if we depended on profunctors++-- | Lens onto the right value of a coproduct.+_R :: (Action m n, Monoid' n) => Lens (m :+: n) (m :+: n') n n'+_R f (C n m o) = f (get $ n `mappend` act' m o) <&> \n' -> C (Only n') m Nought+{-# INLINE _R #-}++-- Internal utilities --------------------------------------------------++get :: Monoid a => Possible a -> a+get (Only a) = a+get _        = mempty+{-# INLINE get #-}++(<&>) :: Functor f => f a -> (a -> b) -> f b+(<&>) = flip fmap+{-# INLINE (<&>) #-}++-- Act on a possible with a possible+act' :: Action m n => Possible m -> Possible n -> Possible n+act' (Only m) (Only n) = Only (act m n)+act' _        n        = n+{-# INLINE act' #-}++-- Act with a possible+act'' :: Action m n => Possible m -> n -> n+act'' (Only m) = act m+act'' _        = id+{-# INLINE act'' #-}

@@ -14,7 +14,7 @@ -- -- A type for representing values with an additional bit saying -- whether the value is \"just a recommendation\" (to be used only if--- nothing better comes along) or a \"committment\" (to certainly be+-- nothing better comes along) or a \"commitment\" (to certainly be -- used, overriding merely recommended values), along with -- corresponding @Semigroup@ and @Monoid@ instances. --