diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,6 +1,15 @@ +* 0.4.3: 3 April 2018 + +- Allow base-4.11 +- Fix compilation on GHC 8.4 +- Add more instances for Inf + * 0.4.2: 16 July 2016 - Additions to Data.Monoid.SemiDirectProduct (unSemi, tag, untag) + +- Hackage revision 1: allow semigroupoids-5.2 +- Hackage revision 2: allow base-4.10 * 0.4.1.2: 16 June 2016 diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -5,6 +5,8 @@ Nathan van Doorn Daniil Frumin Hans Höglund + Moritz Kiefer + Piyush P Kurur Daniel Wagner Ryan Yates Brent Yorgey diff --git a/benchmarks/SemiDirectProduct.hs b/benchmarks/SemiDirectProduct.hs --- a/benchmarks/SemiDirectProduct.hs +++ b/benchmarks/SemiDirectProduct.hs @@ -13,12 +13,15 @@ #else import Data.Monoid (Sum(..)) #endif +#if !MIN_VERSION_base(4,11,0) +import Data.Semigroup (Semigroup) +#endif import Data.Monoid.Action import qualified Data.Monoid.SemiDirectProduct as L import qualified Data.Monoid.SemiDirectProduct.Strict as S -newtype MyMonoid = MyMonoid (Sum Word) deriving Monoid +newtype MyMonoid = MyMonoid (Sum Word) deriving (Semigroup, Monoid) instance Action MyMonoid () where act _ = id diff --git a/monoid-extras.cabal b/monoid-extras.cabal --- a/monoid-extras.cabal +++ b/monoid-extras.cabal @@ -1,5 +1,5 @@ name: monoid-extras -version: 0.4.2 +version: 0.4.3 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.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.1 +tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1, GHC == 8.2.2, GHC == 8.4.1 source-repository head type: git @@ -35,10 +35,10 @@ Data.Monoid.Split, Data.Monoid.WithSemigroup - build-depends: base >= 4.3 && < 4.10, + build-depends: base >= 4.3 && < 4.12, groups < 0.5, semigroups >= 0.8 && < 0.19, - semigroupoids >= 4.0 && < 5.2 + semigroupoids >= 4.0 && < 5.3 hs-source-dirs: src @@ -52,6 +52,6 @@ hs-source-dirs: benchmarks main-is: SemiDirectProduct.hs type: exitcode-stdio-1.0 - build-depends: base >= 4.3 && < 4.10 + build-depends: base >= 4.3 && < 4.12 , criterion , monoid-extras diff --git a/src/Data/Monoid/Endomorphism.hs b/src/Data/Monoid/Endomorphism.hs --- a/src/Data/Monoid/Endomorphism.hs +++ b/src/Data/Monoid/Endomorphism.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} @@ -20,7 +21,8 @@ import Control.Category import Data.Group import Data.Groupoid -import Data.Semigroup +import Data.Monoid (Monoid(..)) +import Data.Semigroup (Semigroup(..)) import Data.Semigroupoid import Prelude (Show) @@ -35,9 +37,11 @@ instance Semigroupoid k => Semigroup (Endomorphism k a) where Endomorphism a <> Endomorphism b = Endomorphism (a `o` b) -instance Category k => Monoid (Endomorphism k a) where +instance (Semigroupoid k, Category k) => Monoid (Endomorphism k a) where mempty = Endomorphism id +#if !MIN_VERSION_base(4,11,0) Endomorphism a `mappend` Endomorphism b = Endomorphism (a . b) +#endif instance (Category k, Groupoid k) => Group (Endomorphism k a) where invert (Endomorphism a) = Endomorphism (inv a) diff --git a/src/Data/Monoid/Inf.hs b/src/Data/Monoid/Inf.hs --- a/src/Data/Monoid/Inf.hs +++ b/src/Data/Monoid/Inf.hs @@ -31,59 +31,111 @@ , posFinite, negFinite ) where +import Control.Applicative (Applicative(..), liftA2) import Data.Data import Data.Semigroup -import Prelude hiding (maximum, minimum) -import qualified Prelude as P +import Prelude hiding (maximum, minimum) +import qualified Prelude as P -import Data.Foldable (Foldable) -import Data.Traversable (Traversable) +import Data.Foldable (Foldable) +import Data.Traversable (Traversable) +-- | Type index indicating positive infinity. data Pos +-- | Type index indicating negative infinity. data Neg +-- | @Inf p a@ represents the type 'a' extended with a new "infinite" +-- value, which is treated as either positive or negative infinity +-- depending on the type index 'p'. This type exists mostly for its +-- 'Ord', 'Semigroup', and 'Monoid' instances. data Inf p a = Infinity | Finite a deriving (Data, Typeable, Show, Read, Eq, Functor, Foldable, Traversable) +-- | The type 'a' extended with positive infinity. type PosInf a = Inf Pos a + +-- | The type 'a' extended with negative infinity. type NegInf a = Inf Neg a +-- | Positive infinity is greater than any finite value. instance Ord a => Ord (Inf Pos a) where compare Infinity Infinity = EQ compare Infinity Finite{} = GT compare Finite{} Infinity = LT compare (Finite a) (Finite b) = compare a b +-- | Negative infinity is less than any finite value. instance Ord a => Ord (Inf Neg a) where compare Infinity Infinity = EQ compare Infinity Finite{} = LT compare Finite{} Infinity = GT compare (Finite a) (Finite b) = compare a b +-- | An ordered type extended with positive infinity is a semigroup +-- under 'min'. instance Ord a => Semigroup (Inf Pos a) where (<>) = min +-- | An ordered type extended with negative infinity is a semigroup +-- under 'max'. instance Ord a => Semigroup (Inf Neg a) where (<>) = max +-- | An ordered type extended with positive infinity is a monoid under +-- 'min', with positive infinity as the identity element. instance Ord a => Monoid (Inf Pos a) where mempty = Infinity mappend = (<>) +-- | An ordered type extended with negative infinity is a monoid under +-- 'max', with negative infinity as the identity element. instance Ord a => Monoid (Inf Neg a) where mempty = Infinity mappend = (<>) +instance Applicative (Inf p) where + pure = Finite + Infinity <*> _ = Infinity + _ <*> Infinity = Infinity + Finite f <*> Finite x = Finite $ f x + +instance Monad (Inf p) where + Infinity >>= _ = Infinity + Finite x >>= f = f x + return = pure + +instance Bounded a => Bounded (NegInf a) where + minBound = Infinity + maxBound = Finite maxBound + +instance Bounded a => Bounded (PosInf a) where + minBound = Finite minBound + maxBound = Infinity + +-- | Find the minimum of a list of values. Returns positive infinity +-- iff the list is empty. minimum :: Ord a => [a] -> PosInf a minimum xs = P.minimum (Infinity : map Finite xs) +-- | Find the maximum of a list of values. Returns negative infinity +-- iff the list is empty. maximum :: Ord a => [a] -> NegInf a maximum xs = P.maximum (Infinity : map Finite xs) +-- | Positive infinity. posInfty :: PosInf a + +-- | Negative infinity. negInfty :: NegInf a + +-- | Embed a finite value into the space of such values extended with +-- positive infinity. posFinite :: a -> PosInf a + +-- | Embed a finite value into the space of such values extended with +-- negative infinity. negFinite :: a -> NegInf a posInfty = Infinity diff --git a/src/Data/Monoid/SemiDirectProduct.hs b/src/Data/Monoid/SemiDirectProduct.hs --- a/src/Data/Monoid/SemiDirectProduct.hs +++ b/src/Data/Monoid/SemiDirectProduct.hs @@ -8,8 +8,9 @@ ) where #if !MIN_VERSION_base(4,8,0) -import Data.Monoid +import Data.Monoid (Monoid(..)) #endif +import Data.Semigroup (Semigroup(..)) import Data.Monoid.Action @@ -29,16 +30,27 @@ -- quotient. newtype Semi s m = Semi { unSemi :: (s,m) } +instance (Semigroup m, Semigroup s, Action m s) => Semigroup (Semi s m) where + x <> y = Semi (xs <> (xm `act` ys), xm <> ym) + where (xs, xm) = unSemi x + (ys, ym) = unSemi y + {-# INLINE (<>) #-} + sconcat = foldr1 (<>) + {-# INLINE sconcat #-} + instance (Monoid m, Monoid s, Action m s) => Monoid (Semi s m) where mempty = Semi (mempty, mempty) {-# INLINE mempty #-} +#if !MIN_VERSION_base(4,11,0) mappend x y = Semi (xs `mappend` (xm `act` ys), xm `mappend` ym) where (xs, xm) = unSemi x (ys, ym) = unSemi y {-# INLINE mappend #-} +#endif + mconcat = foldr mappend mempty {-# INLINE mconcat #-} @@ -47,7 +59,7 @@ tag :: s -> m -> Semi s m tag s m = Semi (s,m) --- | The injection map, *i.e.* give an @s@ value a trivial tag. +-- | The injection map, /i.e./ give an @s@ value a trivial tag. inject :: Monoid m => s -> Semi s m inject = Semi . (,mempty) @@ -62,7 +74,7 @@ -- -- and -- --- @embed m <> inject s@ = tag (act m s) m@. +-- @embed m <> inject s@ = tag (act m s) m@ -- -- The semi-direct product gives a split extension of @s@ by -- @m@. This allows us to embed @m@ into the semi-direct @@ -71,7 +83,7 @@ embed :: Monoid s => m -> Semi s m embed = Semi . (mempty,) --- | The quotient map, *i.e.* retrieve the monoidal tag value. +-- | The quotient map, /i.e./ retrieve the monoidal tag value. quotient :: Semi s m -> m quotient = snd . unSemi diff --git a/src/Data/Monoid/SemiDirectProduct/Strict.hs b/src/Data/Monoid/SemiDirectProduct/Strict.hs --- a/src/Data/Monoid/SemiDirectProduct/Strict.hs +++ b/src/Data/Monoid/SemiDirectProduct/Strict.hs @@ -12,8 +12,9 @@ ) where #if !MIN_VERSION_base(4,8,0) -import Data.Monoid +import Data.Monoid (Monoid(..)) #endif +import Data.Semigroup (Semigroup(..)) import Data.Monoid.Action @@ -33,11 +34,19 @@ unSemi :: Semi s m -> (s,m) unSemi (Semi s m) = (s,m) +instance (Semigroup m, Semigroup s, Action m s) => Semigroup (Semi s m) where + Semi xs xm <> Semi ys ym = Semi (xs <> (xm `act` ys)) (xm <> ym) + {-# INLINE (<>) #-} + sconcat = foldr1 (<>) + {-# INLINE sconcat #-} + instance (Monoid m, Monoid s, Action m s) => Monoid (Semi s m) where mempty = Semi mempty mempty {-# INLINE mempty #-} +#if !MIN_VERSION_base(4,11,0) mappend (Semi xs xm) (Semi ys ym) = Semi (xs `mappend` (xm `act` ys)) (xm `mappend` ym) {-# INLINE mappend #-} +#endif mconcat = foldr mappend mempty {-# INLINE mconcat #-} @@ -46,7 +55,7 @@ tag :: s -> m -> Semi s m tag = Semi --- | The injection map, *i.e.* give an @s@ value a trivial tag. +-- | The injection map, /i.e./ give an @s@ value a trivial tag. inject :: Monoid m => s -> Semi s m inject = flip Semi mempty @@ -61,7 +70,7 @@ -- -- and -- --- @embed m <> inject s@ = tag (act m s) m@. +-- @embed m <> inject s@ = tag (act m s) m@ -- -- The semi-direct product gives a split extension of @s@ by -- @m@. This allows us to embed @m@ into the semi-direct @@ -70,6 +79,6 @@ embed :: Monoid s => m -> Semi s m embed = Semi mempty --- | The quotient map, *i.e.* retrieve the monoidal tag value. +-- | The quotient map, /i.e./ retrieve the monoidal tag value. quotient :: Semi s m -> m quotient (Semi _ m) = m