monoid-extras-0.3.2.4/0000755000000000000000000000000012245542520012636 5ustar0000000000000000monoid-extras-0.3.2.4/Setup.hs0000644000000000000000000000005612245542520014273 0ustar0000000000000000import Distribution.Simple main = defaultMain monoid-extras-0.3.2.4/CHANGES0000644000000000000000000000236412245542520013636 0ustar0000000000000000* 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 releasemonoid-extras-0.3.2.4/LICENSE0000644000000000000000000000340612245542520013646 0ustar0000000000000000Copyright (c) 2012-2013, monoid-extras team: Daniel Bergey Nathan van Doorn Daniil Frumin Hans Höglund 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.3.2.4/monoid-extras.cabal0000644000000000000000000000314312245542520016414 0ustar0000000000000000name: monoid-extras version: 0.3.2.4 synopsis: Various extra monoid-related definitions and utilities description: Various extra monoid-related definitions and utilities, such as monoid actions, monoid coproducts, \"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 source-repository head type: git location: https://github.com/diagrams/monoid-extras.git library default-language: Haskell2010 exposed-modules: Data.Monoid.Action, Data.Monoid.Coproduct, 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.3 && < 4.8, groups < 0.5, groupoids < 5, semigroups >= 0.8 && < 0.13, semigroupoids < 5 hs-source-dirs: src other-extensions: DeriveFunctor, FlexibleInstances, MultiParamTypeClasses, TypeOperators monoid-extras-0.3.2.4/src/0000755000000000000000000000000012245542520013425 5ustar0000000000000000monoid-extras-0.3.2.4/src/Data/0000755000000000000000000000000012245542520014276 5ustar0000000000000000monoid-extras-0.3.2.4/src/Data/Monoid/0000755000000000000000000000000012245542520015523 5ustar0000000000000000monoid-extras-0.3.2.4/src/Data/Monoid/Deletable.hs0000644000000000000000000000550512245542520017745 0ustar0000000000000000{-# LANGUAGE DeriveFunctor #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Monoid.Deletable -- Copyright : (c) 2011 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.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 Functor -- | 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) 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.3.2.4/src/Data/Monoid/Split.hs0000644000000000000000000000604112245542520017153 0ustar0000000000000000{-# LANGUAGE FlexibleInstances , MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Monoid.Split -- Copyright : (c) 2011 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.Semigroup 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 (Show) -- | 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 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.3.2.4/src/Data/Monoid/Endomorphism.hs0000644000000000000000000000261312245542520020525 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Monoid.Endomorphism -- Copyright : (c) 2013 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.Semigroup import Data.Semigroupoid import Prelude hiding (id, (.)) -- | 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} instance Semigroupoid k => Semigroup (Endomorphism k a) where Endomorphism a <> Endomorphism b = Endomorphism (a `o` b) instance Category k => Monoid (Endomorphism k a) where mempty = Endomorphism id Endomorphism a `mappend` Endomorphism b = Endomorphism (a . b) instance (Category k, Groupoid k) => Group (Endomorphism k a) where invert (Endomorphism a) = Endomorphism (inv a)monoid-extras-0.3.2.4/src/Data/Monoid/Coproduct.hs0000644000000000000000000000722512245542520020027 0ustar0000000000000000{-# LANGUAGE TypeOperators , FlexibleInstances , MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Monoid.Coproduct -- Copyright : (c) 2011 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.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] } -- 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) . unMComonoid-extras-0.3.2.4/src/Data/Monoid/Cut.hs0000644000000000000000000000537712245542520016626 0ustar0000000000000000 ----------------------------------------------------------------------------- -- | -- Module : Data.Monoid.Cut -- Copyright : (c) 2012 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.Semigroup 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 (Show) -- | 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 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.3.2.4/src/Data/Monoid/WithSemigroup.hs0000644000000000000000000000224212245542520020665 0ustar0000000000000000{-# LANGUAGE FlexibleInstances , UndecidableInstances #-} ----------------------------------------------------------------------------- -- | -- 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 -- Poor man's constraint synonym. Eventually, once it becomes -- standard, we can make this a real constraint synonym and get rid of -- the UndecidableInstances flag. Better yet, hopefully the Monoid -- class will eventually have a Semigroup superclass. -- | The @Monoid'@ class is a synonym for things which are instances -- of both 'Semigroup' and 'Monoid'. Ideally, the 'Monoid' class -- itself will eventually include a 'Semigroup' superclass and we -- can get rid of this. class (Semigroup m, Monoid m) => Monoid' m instance (Semigroup m, Monoid m) => Monoid' m monoid-extras-0.3.2.4/src/Data/Monoid/Recommend.hs0000644000000000000000000000364312245542520017776 0ustar0000000000000000 ----------------------------------------------------------------------------- -- | -- Module : Data.Monoid.Recommend -- Copyright : (c) 2012 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 \"committment\" (to certainly be -- used, overriding merely recommended values), along with -- corresponding @Semigroup@ and @Monoid@ instances. -- ----------------------------------------------------------------------------- module Data.Monoid.Recommend ( Recommend(..), getRecommend ) where 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 -- | 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) instance (Semigroup a, Monoid a) => Monoid (Recommend a) where mappend = (<>) mempty = Recommend memptymonoid-extras-0.3.2.4/src/Data/Monoid/Action.hs0000644000000000000000000000605212245542520017277 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 (Option m) s where act (Option Nothing) s = s act (Option (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.3.2.4/src/Data/Monoid/Inf.hs0000644000000000000000000000457212245542520016603 0ustar0000000000000000{-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Monoid.Inf -- Copyright : (c) 2012 diagrams-core team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com -- -- Make semigroup under 'min' or 'max' into monoids by adjoining an -- element corresponding to infinity (positive or negative, -- respectively). These types are similar to @Option (Min a)@ and -- @Option (Max a)@ respectively, except that the 'Ord' instance -- matches the 'Monoid' instance. -- ----------------------------------------------------------------------------- module Data.Monoid.Inf ( Inf(..) , PosInf, NegInf , minimum, maximum -- * Type-restricted constructors , posInfty, negInfty , posFinite, negFinite ) where import Data.Semigroup import Prelude hiding (maximum, minimum) import qualified Prelude as P import Data.Foldable (Foldable) import Data.Traversable (Traversable) data Pos data Neg data Inf p a = Infinity | Finite a deriving (Eq, Show, Read, Functor, Foldable, Traversable) type PosInf a = Inf Pos a type NegInf a = Inf Neg a 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 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 instance Ord a => Semigroup (Inf Pos a) where (<>) = min instance Ord a => Semigroup (Inf Neg a) where (<>) = max instance Ord a => Monoid (Inf Pos a) where mempty = Infinity mappend = (<>) instance Ord a => Monoid (Inf Neg a) where mempty = Infinity mappend = (<>) minimum :: Ord a => [a] -> PosInf a minimum xs = P.minimum (Infinity : map Finite xs) maximum :: Ord a => [a] -> NegInf a maximum xs = P.maximum (Infinity : map Finite xs) posInfty :: PosInf a negInfty :: NegInf a posFinite :: a -> PosInf a negFinite :: a -> NegInf a posInfty = Infinity negInfty = Infinity posFinite = Finite negFinite = Finite monoid-extras-0.3.2.4/src/Data/Monoid/MList.hs0000644000000000000000000000756612245542520017125 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverlappingInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# 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 import Data.Semigroup -- $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 = (Option a, l) (*:) :: a -> l -> a ::: l a *: l = (Option (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 = (Option 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 -> Option a -- | Alter the value of type @a@ by applying the given function to it. alt :: (Option a -> Option a) -> l -> l instance MList t => (:>:) (a ::: t) a where inj a = (Option (Just a), empty) get = fst alt = first instance (t :>: a) => (:>:) (b ::: t) a where inj a = (Option 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 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) (Option a', l) where act (SM a) (Option Nothing, l) = (Option Nothing, act (SM a) l) act (SM a) (Option (Just a'), l) = (Option (Just (act a a')), act (SM a) l)