monoid-extras-0.6.1/0000755000000000000000000000000007346545000012500 5ustar0000000000000000monoid-extras-0.6.1/CHANGES0000644000000000000000000000710507346545000013476 0ustar0000000000000000* 0.6.1: 16 Nov 2021 - Add more efficient `stimes` implementations for several `Semigroup` instances. Thanks to BlackCapCoder for the patch! - Allow `base-4.16` and test on GHC 9.2.1. * 0.6: 8 May 2021 - Updates for GHC 8.10 and 9.0. - Drop support for GHC 8.2 or older. - Replace deprecated `Option` type with `Maybe`. * 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 It used to export a type class Monoid' with no methods and a single instance, for use as a "poor man's constraint synonym" for the combination of Monoid and Semigroup. Now Monoid': - Is a real constraint synonym, using ConstraintKinds. - Is simply a synonym for Monoid under base-4.11 and later, in which case Semigroup is already a superclass of Monoid. This technically necessitates a major version bump but should not cause any issues for packages that depend on monoid-extras, other than potentially requiring the addition of a ConstraintKinds pragma under GHC 7.8. * 0.4.4: 8 April 2018 - Fix build on older (< 7.10) GHCs (thanks to George Wilson for the fix) * 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 - allow semigroupoids-5.1 * 0.4.1: 8 June 2016 - new modules Data.Monoid.SemiDirectProduct[.Strict]. * 0.4.0.4: 14 February 2016 - allow base-4.9 for GHC-8 * 0.4.0.3: 10 November 2015 - allow semigroups-0.18 * 0.4.0.2: 16 September 2015 - allow semigroups-0.17 * v0.4.0.1 - allow semigroupoids-5.0 * 0.4: 19 April 2015 - add derived instances where possible: Typeable, Data, Read, Eq, Ord, Functor, Foldable, Traversable - allow base-4.8 * 0.3.3.5: 03 Dec 2014 - allow semigroups-0.15 * 0.3.3.4: 28 May 2014 - allow semigroups-0.15 * 0.3.3.3: 15 May 2014 - allow semigroups-0.14 * 0.3.3.2: 10 April 2014 - allow semigroups-0.13 * 0.3.3.1: 9 March 2014 - drop dependency on deprecated `groupoids` package * 0.3.3: 4 March 2014 - export Pos and Neg types, to improve Haddock documentation * 0.3.2.4: 27 November 2013 - allow semigroups-0.12 * 0.3.2.3: 19 October 2013 - Allow groupoids-4 and semigroupoids-4 * 0.3.2.2: 26 September 2013 - allow semigroups-0.11 * 0.3.2.1: 25 September 2013 - allow groups-0.4 * 0.3.2: 30 August 2013 - new Group instance for Endomorphism * 0.3.1: 20 August 2013 - new module Data.Monoid.Endomorphism - add derived Functor, Foldable, and Traversable instances for Data.Monoid.Inf.Inf * 0.3: 2 May 2013 - generalize PosInf to Inf, which supports making monoids out of semigroups under both min and max * 0.2.2.3: 28 March 2013 - bump upper bound to allow base-4.7 * 0.2.2.2: 7 January 2013 - bump upper bound to allow semigroups-0.9 * 0.2.2.1: 11 December 2012 - Small fix to allow building under older GHCs * 0.2.2.0: 10 December 2012 - Add new module Data.Monoid.Recommend * 0.2.1.0: 28 September 2012 - Add new module Data.Monoid.Cut - Documentation improvements - Add Show instance for Split * 0.2.0.0: 3 September 2012 - Remove instances for actions on pairs and triples, and add some commentary explaining why adding them was a bad idea in the first place. * 0.1.1.0 - Add instances for actions on pairs and triples * 0.1.0.0 - initial release monoid-extras-0.6.1/LICENSE0000644000000000000000000000361407346545000013511 0ustar0000000000000000Copyright (c) 2012-2015, monoid-extras team: Daniel Bergey Christopher Chalmers Nathan van Doorn Daniil Frumin Hans Höglund Moritz Kiefer Piyush P Kurur Daniel Wagner Ryan Yates Brent Yorgey All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * 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. * Neither the name of Brent Yorgey nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT OWNER 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. monoid-extras-0.6.1/Setup.hs0000644000000000000000000000005607346545000014135 0ustar0000000000000000import Distribution.Simple main = defaultMain monoid-extras-0.6.1/benchmarks/0000755000000000000000000000000007346545000014615 5ustar0000000000000000monoid-extras-0.6.1/benchmarks/SemiDirectProduct.hs0000644000000000000000000000234107346545000020542 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Main where import Criterion.Main #if !MIN_VERSION_base(4,8,0) import Data.Monoid import Data.Word #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 (Semigroup, Monoid) instance Action MyMonoid () where act _ = id {-# NOINLINE act #-} main :: IO () main = defaultMain [ bench "mconcat/strict" $ whnf mconcat strict , bench "mconcat/lazy" $ whnf mconcat lazy , bench "strict/quotient" $ whnf (S.quotient . mconcat) strict , bench "lazy/quotient" $ whnf (L.quotient . mconcat) lazy ] where strict :: [S.Semi () MyMonoid] strict = map (S.embed . MyMonoid . Sum) $ take 1000 [1..] lazy :: [L.Semi () (MyMonoid)] lazy = map (L.embed . MyMonoid . Sum) $ take 1000 [1..] monoid-extras-0.6.1/monoid-extras.cabal0000644000000000000000000000422507346545000016260 0ustar0000000000000000name: monoid-extras version: 0.6.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 products, \"deletable\" monoids, \"split\" monoids, and \"cut\" monoids. license: BSD3 license-file: LICENSE extra-source-files: CHANGES author: Brent Yorgey maintainer: diagrams-discuss@googlegroups.com bug-reports: https://github.com/diagrams/monoid-extras/issues category: Data build-type: Simple cabal-version: >=1.10 tested-with: GHC ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1 || ==9.2.1 source-repository head type: git location: https://github.com/diagrams/monoid-extras.git library default-language: Haskell2010 exposed-modules: Data.Monoid.Action, Data.Monoid.SemiDirectProduct, Data.Monoid.SemiDirectProduct.Strict Data.Monoid.Coproduct, Data.Monoid.Coproduct.Strict, Data.Monoid.Cut, Data.Monoid.Deletable, Data.Monoid.Endomorphism, Data.Monoid.Inf, Data.Monoid.MList, Data.Monoid.Recommend, Data.Monoid.Split, Data.Monoid.WithSemigroup build-depends: base >= 4.11 && < 4.17, groups < 0.6, semigroupoids >= 4.0 && < 5.4 hs-source-dirs: src ghc-options: -Wall other-extensions: DeriveFunctor FlexibleInstances MultiParamTypeClasses TypeOperators ConstraintKinds benchmark semi-direct-product default-language: Haskell2010 hs-source-dirs: benchmarks main-is: SemiDirectProduct.hs type: exitcode-stdio-1.0 build-depends: base >= 4.3 && < 4.16 , semigroups , criterion , monoid-extras monoid-extras-0.6.1/src/Data/Monoid/0000755000000000000000000000000007346545000015365 5ustar0000000000000000monoid-extras-0.6.1/src/Data/Monoid/Action.hs0000644000000000000000000000602707346545000017143 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Monoid.Action -- Copyright : (c) 2011 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- Monoid and semigroup actions. -- ----------------------------------------------------------------------------- module Data.Monoid.Action ( Action(..) ) where import Data.Semigroup ------------------------------------------------------------ -- Monoid and semigroup actions ------------------------------------------------------------ -- | Type class for monoid (and semigroup) actions, where monoidal -- values of type @m@ \"act\" on values of another type @s@. -- Instances are required to satisfy the laws -- -- * @act mempty = id@ -- -- * @act (m1 \`mappend\` m2) = act m1 . act m2@ -- -- Semigroup instances are required to satisfy the second law but with -- ('<>') instead of 'mappend'. Additionally, if the type @s@ has -- any algebraic structure, @act m@ should be a homomorphism. For -- example, if @s@ is also a monoid we should have @act m mempty = -- mempty@ and @act m (s1 \`mappend\` s2) = (act m s1) \`mappend\` -- (act m s2)@. -- -- By default, @act = const id@, so for a type @M@ which should have -- no action on anything, it suffices to write -- -- > instance Action M s -- -- with no method implementations. -- -- It is a bit awkward dealing with instances of @Action@, since it -- is a multi-parameter type class but we can't add any functional -- dependencies---the relationship between monoids and the types on -- which they act is truly many-to-many. In practice, this library -- has chosen to have instance selection for @Action@ driven by the -- /first/ type parameter. That is, you should never write an -- instance of the form @Action m SomeType@ since it will overlap -- with instances of the form @Action SomeMonoid t@. Newtype -- wrappers can be used to (awkwardly) get around this. class Action m s where -- | Convert a value of type @m@ to an action on @s@ values. act :: m -> s -> s act = const id -- | @()@ acts as the identity. instance Action () l where act () = id -- | @Nothing@ acts as the identity; @Just m@ acts as @m@. instance Action m s => Action (Maybe m) s where act Nothing s = s act (Just m) s = act m s -- | @Endo@ acts by application. -- -- Note that in order for this instance to satisfy the @Action@ -- laws, whenever the type @a@ has some sort of algebraic structure, -- the type @Endo a@ must be considered to represent /homomorphisms/ -- (structure-preserving maps) on @a@, even though there is no way -- to enforce this in the type system. For example, if @a@ is an -- instance of @Monoid@, then one should only use @Endo a@ values -- @f@ with the property that @f mempty = mempty@ and @f (a <> b) = -- f a <> f b@. instance Action (Endo a) a where act = appEndo monoid-extras-0.6.1/src/Data/Monoid/Coproduct.hs0000644000000000000000000000741407346545000017671 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeOperators #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Monoid.Coproduct -- Copyright : (c) 2011-2015 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- The coproduct of two monoids. -- ----------------------------------------------------------------------------- module Data.Monoid.Coproduct ( (:+:) , inL, inR , mappendL, mappendR , killL, killR , untangle ) where import Data.Either (lefts, rights) import Data.Semigroup import Data.Typeable import Data.Monoid.Action -- | @m :+: n@ is the coproduct of monoids @m@ and @n@. Values of -- type @m :+: n@ consist of alternating lists of @m@ and @n@ -- values. The empty list is the identity, and composition is list -- concatenation, with appropriate combining of adjacent elements -- when possible. newtype m :+: n = MCo { unMCo :: [Either m n] } deriving (Typeable, Show) -- For efficiency and simplicity, we implement it just as [Either m -- n]: of course, this does not preserve the invariant of strictly -- alternating types, but it doesn't really matter as long as we don't -- let anyone inspect the internal representation. -- | Injection from the left monoid into a coproduct. inL :: m -> m :+: n inL m = MCo [Left m] -- | Injection from the right monoid into a coproduct. inR :: n -> m :+: n inR n = MCo [Right n] -- | Prepend a value from the left monoid. mappendL :: m -> m :+: n -> m :+: n mappendL = mappend . inL -- | Prepend a value from the right monoid. mappendR :: n -> m :+: n -> m :+: n mappendR = mappend . inR {- normalize :: (Monoid m, Monoid n) => m :+: n -> m :+: n normalize (MCo es) = MCo (normalize' es) where normalize' [] = [] normalize' [e] = [e] normalize' (Left e1:Left e2 : es) = normalize' (Left (e1 <> e2) : es) normalize' (Left e1:es) = Left e1 : normalize' es normalize' (Right e1:Right e2:es) = normalize' (Right (e1 <> e2) : es) normalize' (Right e1:es) = Right e1 : normalize' es -} instance Semigroup (m :+: n) where (MCo es1) <> (MCo es2) = MCo (es1 ++ es2) -- | The coproduct of two monoids is itself a monoid. instance Monoid (m :+: n) where mempty = MCo [] mappend = (<>) -- | @killR@ takes a value in a coproduct monoid and sends all the -- values from the right monoid to the identity. killR :: Monoid m => m :+: n -> m killR = mconcat . lefts . unMCo -- | @killL@ takes a value in a coproduct monoid and sends all the -- values from the left monoid to the identity. killL :: Monoid n => m :+: n -> n killL = mconcat . rights . unMCo -- | Take a value from a coproduct monoid where the left monoid has an -- action on the right, and \"untangle\" it into a pair of values. In -- particular, -- -- > m1 <> n1 <> m2 <> n2 <> m3 <> n3 <> ... -- -- is sent to -- -- > (m1 <> m2 <> m3 <> ..., (act m1 n1) <> (act (m1 <> m2) n2) <> (act (m1 <> m2 <> m3) n3) <> ...) -- -- That is, before combining @n@ values, every @n@ value is acted on -- by all the @m@ values to its left. untangle :: (Action m n, Monoid m, Monoid n) => m :+: n -> (m,n) untangle (MCo elts) = untangle' mempty elts where untangle' cur [] = cur untangle' (curM, curN) (Left m : elts') = untangle' (curM `mappend` m, curN) elts' untangle' (curM, curN) (Right n : elts') = untangle' (curM, curN `mappend` act curM n) elts' -- | Coproducts act on other things by having each of the components -- act individually. instance (Action m r, Action n r) => Action (m :+: n) r where act = appEndo . mconcat . map (Endo . either act act) . unMCo monoid-extras-0.6.1/src/Data/Monoid/Coproduct/0000755000000000000000000000000007346545000017327 5ustar0000000000000000monoid-extras-0.6.1/src/Data/Monoid/Coproduct/Strict.hs0000644000000000000000000001177207346545000021143 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE ConstraintKinds #-} {-# 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 Maybe 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'' #-} monoid-extras-0.6.1/src/Data/Monoid/Cut.hs0000644000000000000000000000617607346545000016466 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Monoid.Cut -- Copyright : (c) 2012-2015 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- The @Cut@ monoid transformer introduces \"cut points\" such that -- all values between any two cut points are thrown away. That is, -- -- > a b c | d e | f g h i | j k == a b c | j k -- ----------------------------------------------------------------------------- module Data.Monoid.Cut ( Cut(..), cut ) where import Data.Data import Data.Semigroup import Data.Foldable import Data.Traversable infix 5 :||: -- | A value of type @Cut m@ is either a single @m@, or a pair of -- @m@'s separated by a divider. The divider represents a \"cut -- point\". -- -- @Cut@ is similar to "Data.Monoid.Split", but split keeps only the -- rightmost divider and accumulates all values, whereas cut always -- keeps the leftmost and rightmost divider, coalescing them into -- one and throwing away all the information in between. -- -- @Split@ uses the asymmetric constructor @:|@, and @Cut@ the -- symmetric constructor @:||:@, to emphasize the inherent asymmetry -- of @Split@ and symmetry of @Cut@. @Split@ keeps only the -- rightmost split and combines everything on the left; @Cut@ keeps -- the outermost splits and throws away everything in between. data Cut m = Uncut m | m :||: m deriving (Data, Typeable, Show, Read, Functor, Foldable, Traversable) -- | If @m@ is a @Semigroup@, then @Cut m@ is a semigroup which -- contains @m@ as a sub-semigroup, but also contains elements of -- the form @m1 :||: m2@. When elements of @m@ combine with such -- \"cut\" elements they are combined with the value on the -- corresponding side of the cut (/e.g./ @(Uncut m1) \<\> (m1' :||: -- m2) = (m1 \<\> m1') :||: m2@). When two \"cut\" elements meet, the -- two inside values are thrown away and only the outside values are -- kept. instance Semigroup m => Semigroup (Cut m) where (Uncut m1) <> (Uncut m2) = Uncut (m1 <> m2) (Uncut m1) <> (m1' :||: m2) = m1 <> m1' :||: m2 (m1 :||: m2) <> (Uncut m2') = m1 :||: m2 <> m2' (m11 :||: _) <> (_ :||: m22) = m11 :||: m22 stimes n (Uncut m) = Uncut (stimes n m) stimes _ (m ) = m instance (Semigroup m, Monoid m) => Monoid (Cut m) where mempty = Uncut mempty mappend = (<>) -- | A convenient name for @mempty :||: mempty@, so composing with -- @cut@ introduces a cut point. For example, @Uncut a \<\> cut \<\> -- Uncut b == a :||: b@. cut :: Monoid m => Cut m cut = mempty :||: mempty -- Note that it is impossible for a cut monoid to have an action in -- general -- the composition operation can throw away information so -- it is impossible to satisfy the law (act (m1 <> m2) x = act m1 (act -- m2 x)) in general (although it may be possible for specific types -- x). monoid-extras-0.6.1/src/Data/Monoid/Deletable.hs0000644000000000000000000000645707346545000017616 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Monoid.Deletable -- Copyright : (c) 2011-2015 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- A monoid transformer that allows deleting information from a -- concatenation of monoidal values. -- ----------------------------------------------------------------------------- module Data.Monoid.Deletable ( Deletable(..) , unDelete, toDeletable , deleteL, deleteR ) where import Data.Data import Data.Foldable import Data.Traversable import Data.Semigroup -- | If @m@ is a 'Monoid', then @Deletable m@ (intuitively speaking) -- adds two distinguished new elements @[@ and @]@, such that an -- occurrence of [ \"deletes\" everything from it to the next ]. For -- example, -- -- > abc[def]gh == abcgh -- -- This is all you really need to know to /use/ @Deletable m@ -- values; to understand the actual implementation, read on. -- -- To properly deal with nesting and associativity we need to be -- able to assign meanings to things like @[[@, @][@, and so on. (We -- cannot just define, say, @[[ == [@, since then @([[)] == [] == -- id@ but @[([]) == [id == [@.) Formally, elements of @Deletable -- m@ are triples of the form (r, m, l) representing words @]^r m -- [^l@. When combining two triples (r1, m1, l1) and (r2, m2, l2) -- there are three cases: -- -- * If l1 == r2 then the [s from the left and ]s from the right -- exactly cancel, and we are left with (r1, m1 \<\> m2, l2). -- -- * If l1 < r2 then all of the [s cancel with some of the ]s, but -- m1 is still inside the remaining ]s and is deleted, yielding (r1 -- + r2 - l1, m2, l2) -- -- * The remaining case is symmetric with the second. data Deletable m = Deletable Int m Int deriving (Data, Typeable, Show, Read, Functor, Foldable, Traversable) -- | Project the wrapped value out of a `Deletable` value. unDelete :: Deletable m -> m unDelete (Deletable _ m _) = m -- | Inject a value into a `Deletable` wrapper. Satisfies the -- property -- -- > unDelete . toDeletable === id -- toDeletable :: m -> Deletable m toDeletable m = Deletable 0 m 0 instance Semigroup m => Semigroup (Deletable m) where (Deletable r1 m1 l1) <> (Deletable r2 m2 l2) | l1 == r2 = Deletable r1 (m1 <> m2) l2 | l1 < r2 = Deletable (r1 + r2 - l1) m2 l2 | otherwise = Deletable r1 m1 (l2 + l1 - r2) stimes n (Deletable r m l) | r == l = Deletable r (stimes n m) l | l < r = Deletable (i*(r-l) + l) m l | otherwise = Deletable r m (i*(l-r) + r) where i = fromIntegral n :: Int instance (Semigroup m, Monoid m) => Monoid (Deletable m) where mempty = Deletable 0 mempty 0 mappend = (<>) -- | A \"left bracket\", which causes everything between it and the -- next right bracket to be deleted. deleteL :: Monoid m => Deletable m deleteL = Deletable 0 mempty 1 -- | A \"right bracket\", denoting the end of the section that should -- be deleted. deleteR :: Monoid m => Deletable m deleteR = Deletable 1 mempty 0 monoid-extras-0.6.1/src/Data/Monoid/Endomorphism.hs0000644000000000000000000000332507346545000020370 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Monoid.Endomorphism -- Copyright : (c) 2013-2015 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- The monoid of endomorphisms over any 'Category'. -- ----------------------------------------------------------------------------- module Data.Monoid.Endomorphism ( Endomorphism(..) ) where import Control.Category import Data.Group import Data.Groupoid import Data.Monoid (Monoid(..)) import Data.Semigroup (Semigroup(..)) import Data.Semigroupoid import Prelude (Show) -- | An 'Endomorphism' in a given 'Category' is a morphism from some -- object to itself. The set of endomorphisms for a particular -- object form a monoid, with composition as the combining operation -- and the identity morphism as the identity element. newtype Endomorphism k a = Endomorphism {getEndomorphism :: k a a} deriving instance Show (k a a) => Show (Endomorphism k a) instance Semigroupoid k => Semigroup (Endomorphism k a) where Endomorphism a <> Endomorphism b = Endomorphism (a `o` b) 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) monoid-extras-0.6.1/src/Data/Monoid/Inf.hs0000644000000000000000000001077707346545000016451 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Monoid.Inf -- Copyright : (c) 2012-2015 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- Make semigroups under 'min' or 'max' into monoids by adjoining an -- element corresponding to infinity (positive or negative, -- respectively). These types are similar to @Maybe (Min a)@ and -- @Maybe (Max a)@ respectively, except that the 'Ord' instance -- matches the 'Monoid' instance. -- ----------------------------------------------------------------------------- module Data.Monoid.Inf ( Inf(..) , Pos, Neg , PosInf, NegInf , minimum, maximum -- * Type-restricted constructors , posInfty, negInfty , 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 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 negInfty = Infinity posFinite = Finite negFinite = Finite monoid-extras-0.6.1/src/Data/Monoid/MList.hs0000644000000000000000000000775307346545000016765 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} #if __GLASGOW_HASKELL__ < 710 {-# LANGUAGE OverlappingInstances #-} #endif {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Monoid.MList -- Copyright : (c) 2011 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- Heterogeneous lists of monoids. -- ----------------------------------------------------------------------------- module Data.Monoid.MList ( -- * Heterogeneous monoidal lists -- $mlist (:::), (*:) , MList(..) -- * Accessing embedded values , (:>:)(..) -- * Monoid actions of heterogeneous lists -- $mlist-actions , SM(..) ) where import Control.Arrow import Data.Monoid.Action -- $mlist -- -- The idea of /heterogeneous lists/ has been around for a long time. -- Here, we adopt heterogeneous lists where the element types are all -- monoids: this allows us to leave out identity values, so that a -- heterogeneous list containing only a single non-identity value can -- be created without incurring constraints due to all the other -- types, by leaving all the other values out. infixr 5 ::: infixr 5 *: type a ::: l = (Maybe a, l) (*:) :: a -> l -> a ::: l a *: l = (Just a, l) -- MList ----------------------------------- -- | Type class for heterogeneous monoidal lists, with a single method -- allowing construction of an empty list. class MList l where -- | The /empty/ heterogeneous list of type @l@. Of course, @empty -- == 'mempty'@, but unlike 'mempty', @empty@ does not require -- 'Monoid' constraints on all the elements of @l@. empty :: l instance MList () where empty = () instance MList l => MList (a ::: l) where empty = (Nothing, empty) -- Embedding ------------------------------------------- -- | The relation @l :>: a@ holds when @a@ is the type of an element -- in @l@. For example, @(Char ::: Int ::: Bool ::: Nil) :>: Int@. class l :>: a where -- | Inject a value into an otherwise empty heterogeneous list. inj :: a -> l -- | Get the value of type @a@ from a heterogeneous list, if there -- is one. get :: l -> Maybe a -- | Alter the value of type @a@ by applying the given function to it. alt :: (Maybe a -> Maybe a) -> l -> l #if __GLASGOW_HASKELL__ >= 710 instance {-# OVERLAPPING #-} MList t => (:>:) (a ::: t) a where #else instance MList t => (:>:) (a ::: t) a where #endif inj a = (Just a, empty) get = fst alt = first instance (t :>: a) => (:>:) (b ::: t) a where inj a = (Nothing, inj a) get = get . snd alt = second . alt -- Monoid actions ----------------------------------------- -- $mlist-actions -- Monoidal heterogeneous lists may act on one another as you would -- expect, with each element in the first list acting on each in the -- second. Unfortunately, coding this up in type class instances is a -- bit fiddly. -- | @SM@, an abbreviation for \"single monoid\" (as opposed to a -- heterogeneous list of monoids), is only used internally to help -- guide instance selection when defining the action of -- heterogeneous monoidal lists on each other. newtype SM m = SM m deriving Show instance (Action (SM a) l2, Action l1 l2) => Action (a, l1) l2 where act (a,l) = act (SM a) . act l instance Action (SM a) () where act _ _ = () instance (Action a a', Action (SM a) l) => Action (SM a) (Maybe a', l) where act (SM a) (Nothing, l) = (Nothing, act (SM a) l) act (SM a) (Just a', l) = (Just (act a a'), act (SM a) l) monoid-extras-0.6.1/src/Data/Monoid/Recommend.hs0000644000000000000000000000472307346545000017640 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Monoid.Recommend -- Copyright : (c) 2012-2015 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- 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 \"commitment\" (to certainly be -- used, overriding merely recommended values), along with -- corresponding @Semigroup@ and @Monoid@ instances. -- ----------------------------------------------------------------------------- module Data.Monoid.Recommend ( Recommend(..) , getRecommend ) where #if __GLASGOW_HASKELL__ < 710 import Data.Foldable import Data.Traversable #endif import Data.Data import Data.Semigroup -- | A value of type @Recommend a@ consists of a value of type @a@ -- wrapped up in one of two constructors. The @Recommend@ -- constructor indicates a \"non-committal recommendation\"---that -- is, the given value should be used if no other/better values are -- available. The @Commit@ constructor indicates a -- \"commitment\"---a value which should definitely be used, -- overriding any @Recommend@ed values. data Recommend a = Recommend a | Commit a deriving (Show, Read, Functor, Eq, Ord, Typeable, Data, Foldable, Traversable) -- | Extract the value of type @a@ wrapped in @Recommend a@. getRecommend :: Recommend a -> a getRecommend (Recommend a) = a getRecommend (Commit a) = a -- | 'Commit' overrides 'Recommend'. Two values wrapped in the same -- constructor (both 'Recommend' or both 'Commit') are combined -- according to the underlying @Semigroup@ instance. instance Semigroup a => Semigroup (Recommend a) where Recommend a <> Recommend b = Recommend (a <> b) Recommend _ <> Commit b = Commit b Commit a <> Recommend _ = Commit a Commit a <> Commit b = Commit (a <> b) stimes n (Recommend m) = Recommend (stimes n m) stimes n (Commit m) = Commit (stimes n m) instance (Semigroup a, Monoid a) => Monoid (Recommend a) where mappend = (<>) mempty = Recommend mempty monoid-extras-0.6.1/src/Data/Monoid/SemiDirectProduct.hs0000644000000000000000000000541407346545000021316 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TupleSections #-} module Data.Monoid.SemiDirectProduct ( Semi, unSemi, tag, inject, untag, embed, quotient ) where #if !MIN_VERSION_base(4,8,0) import Data.Monoid (Monoid(..)) #endif import Data.Semigroup (Semigroup(..)) import Data.Monoid.Action -- | The semi-direct product of monoids @s@ and @m@, which is a monoid -- when @m@ acts on @s@. Structurally, the semi-direct product is -- just a pair @(s,m)@. However, the monoid instance is different. -- In particular, we have -- -- > (s1,m1) <> (s2,m2) = (s1 <> (m1 `act` s2), m1 <> m2) -- -- We think of the @m@ values as a "tag" decorating the @s@ values, -- which also affect the way the @s@ values combine. -- -- We call the monoid @m@ the quotient monoid and the monoid @s@ the -- sub-monoid of the semi-direct product. The semi-direct product -- @Semi s m@ is an extension of the monoid @s@ with @m@ being the -- 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 (<>) #-} #if MIN_VERSION_base(4,8,0) sconcat = foldr1 (<>) {-# INLINE sconcat #-} #endif 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 #-} -- | Tag an @s@ value with an @m@ value to create an element of the -- semi-direct product. tag :: s -> m -> Semi s m tag s m = Semi (s,m) -- | The injection map, /i.e./ give an @s@ value a trivial tag. inject :: Monoid m => s -> Semi s m inject = Semi . (,mempty) -- | Forget the monoidal tag. Of course, @untag . inject = id@, and -- @untag (tag s m) = s@. untag :: Semi s m -> s untag = fst . unSemi -- | Embed a "tag" value as a value of type @Semi s m@. Note that -- -- @inject s <> embed m = tag s m@ -- -- and -- -- @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 -- product. This is the embedding map. The quotient and embed maps -- should satisfy the equation @quotient . embed = id@. embed :: Monoid s => m -> Semi s m embed = Semi . (mempty,) -- | The quotient map, /i.e./ retrieve the monoidal tag value. quotient :: Semi s m -> m quotient = snd . unSemi monoid-extras-0.6.1/src/Data/Monoid/SemiDirectProduct/0000755000000000000000000000000007346545000020756 5ustar0000000000000000monoid-extras-0.6.1/src/Data/Monoid/SemiDirectProduct/Strict.hs0000644000000000000000000000553307346545000022570 0ustar0000000000000000-- | A strict version of the semi-direct product. If a monoid m acts -- on s then this version of the semi-direct product is strict in -- the m-portion of the semi-direct product. {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TupleSections #-} module Data.Monoid.SemiDirectProduct.Strict ( Semi, unSemi, tag, inject, untag, embed, quotient ) where #if !MIN_VERSION_base(4,8,0) import Data.Monoid (Monoid(..)) #endif import Data.Semigroup (Semigroup(..)) import Data.Monoid.Action -- | The semi-direct product of monoids @s@ and @m@, which is a monoid -- when @m@ acts on @s@. Structurally, the semi-direct product is -- just a pair @(s,m)@. However, the monoid instance is different. -- In particular, we have -- -- > (s1,m1) <> (s2,m2) = (s1 <> (m1 `act` s2), m1 <> m2) -- -- We call the monoid @m@ the quotient monoid and the monoid @s@ the -- sub-monoid of the semi-direct product. The semi-direct product -- @Semi s m@ is an extension of the monoid @s@ with @m@ being the -- quotient. data Semi s m = Semi s !m 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 (<>) #-} #if MIN_VERSION_base(4,8,0) sconcat = foldr1 (<>) {-# INLINE sconcat #-} #endif 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 #-} -- | Tag an @s@ value with an @m@ value to create an element of the -- semi-direct product. tag :: s -> m -> Semi s m tag = Semi -- | The injection map, /i.e./ give an @s@ value a trivial tag. inject :: Monoid m => s -> Semi s m inject = flip Semi mempty -- | Forget the monoidal tag. Of course, @untag . inject = id@, and -- @untag (tag s m) = s@. untag :: Semi s m -> s untag (Semi s _) = s -- | Embed a "tag" value as a value of type @Semi s m@. Note that -- -- @inject s <> embed m = tag s m@ -- -- and -- -- @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 -- product. This is the embedding map. The quotient and embed maps -- should satisfy the equation @quotient . embed = id@. embed :: Monoid s => m -> Semi s m embed = Semi mempty -- | The quotient map, /i.e./ retrieve the monoidal tag value. quotient :: Semi s m -> m quotient (Semi _ m) = m monoid-extras-0.6.1/src/Data/Monoid/Split.hs0000644000000000000000000000700307346545000017014 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Monoid.Split -- Copyright : (c) 2011-2015 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- Sometimes we want to accumulate values from some monoid, but have -- the ability to introduce a \"split\" which separates values on -- either side. Only the rightmost split is kept. For example, -- -- > a b c | d e | f g h == a b c d e | f g h -- -- In the diagrams graphics framework this is used when accumulating -- transformations to be applied to primitive diagrams: the 'freeze' -- operation introduces a split, since only transformations occurring -- outside the freeze should be applied to attributes. -- ----------------------------------------------------------------------------- module Data.Monoid.Split ( Split(..) , split , unsplit ) where import Data.Data import Data.Foldable import Data.Semigroup import Data.Traversable import Data.Monoid.Action infix 5 :| -- | A value of type @Split m@ is either a single @m@, or a pair of -- @m@'s separated by a divider. Single @m@'s combine as usual; -- single @m@'s combine with split values by combining with the -- value on the appropriate side; when two split values meet only -- the rightmost split is kept, with both the values from the left -- split combining with the left-hand value of the right split. -- -- "Data.Monoid.Cut" is similar, but uses a different scheme for -- composition. @Split@ uses the asymmetric constructor @:|@, and -- @Cut@ the symmetric constructor @:||:@, to emphasize the inherent -- asymmetry of @Split@ and symmetry of @Cut@. @Split@ keeps only -- the rightmost split and combines everything on the left; @Cut@ -- keeps the outermost splits and throws away everything in between. data Split m = M m | m :| m deriving (Data, Typeable, Show, Read, Eq, Functor, Foldable, Traversable) -- | If @m@ is a @Semigroup@, then @Split m@ is a semigroup which -- combines values on either side of a split, keeping only the -- rightmost split. instance Semigroup m => Semigroup (Split m) where (M m1) <> (M m2) = M (m1 <> m2) (M m1) <> (m1' :| m2) = m1 <> m1' :| m2 (m1 :| m2) <> (M m2') = m1 :| m2 <> m2' (m11 :| m12) <> (m21 :| m22) = m11 <> m12 <> m21 :| m22 stimes n (M m ) = M (stimes n m) stimes 1 (m ) = m stimes n (m1 :| m2) = m1 <> stimes (pred n) (m2 <> m1) :| m2 instance (Semigroup m, Monoid m) => Monoid (Split m) where mempty = M mempty mappend = (<>) -- | A convenient name for @mempty :| mempty@, so @M a \<\> split \<\> -- M b == a :| b@. split :: Monoid m => Split m split = mempty :| mempty -- | \"Unsplit\" a split monoid value, combining the two values into -- one (or returning the single value if there is no split). unsplit :: Semigroup m => Split m -> m unsplit (M m) = m unsplit (m1 :| m2) = m1 <> m2 -- | By default, the action of a split monoid is the same as for -- the underlying monoid, as if the split were removed. instance Action m n => Action (Split m) n where act (M m) n = act m n act (m1 :| m2) n = act m1 (act m2 n) monoid-extras-0.6.1/src/Data/Monoid/WithSemigroup.hs0000644000000000000000000000221107346545000020523 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Monoid.WithSemigroup -- Copyright : (c) 2011 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- Convenience alias for the combination of @Monoid@ and @Semigroup@ constraints. -- ----------------------------------------------------------------------------- module Data.Monoid.WithSemigroup ( Monoid' ) where import Data.Semigroup -- | For base < 4.11, the @Monoid'@ constraint is a synonym for things -- which are instances of both 'Semigroup' and 'Monoid'. For base -- version 4.11 and onwards, @Monoid@ has @Semigroup@ as a -- superclass already, so for backwards compatibility @Monoid'@ is -- provided as a synonym for @Monoid@. #if MIN_VERSION_base(4,11,0) type Monoid' = Monoid #else type Monoid' m = (Semigroup m, Monoid m) #endif