monoid-extras (empty) → 0.1.0.0

raw patch · 11 files changed

+576/−0 lines, 11 filesdep +basedep +semigroupssetup-changed

Dependencies added: base, semigroups

Files

• CHANGES +3/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• monoid-extras.cabal +33/−0
• src/Data/Monoid/Action.hs +56/−0
• src/Data/Monoid/Coproduct.hs +109/−0
• src/Data/Monoid/Deletable.hs +87/−0
• src/Data/Monoid/MList.hs +126/−0
• src/Data/Monoid/PosInf.hs +33/−0
• src/Data/Monoid/Split.hs +65/−0
• src/Data/Monoid/WithSemigroup.hs +32/−0

@@ -0,0 +1,3 @@+* 0.1.0.0++  - initial release

@@ -0,0 +1,30 @@+Copyright (c) 2012, 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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,33 @@+name:                monoid-extras+version:             0.1.0.0+synopsis:            Various extra monoid-related definitions and utilities+description:         Various extra monoid-related definitions and utilities, +                     such as monoid actions, monoid coproducts, "deletable" +                     monoids, and "split" monoids.+license:             BSD3+license-file:        LICENSE+extra-source-files:  CHANGES+author:              Brent Yorgey+maintainer:          diagrams-discuss@googlegroups.com+category:            Data+build-type:          Simple+cabal-version:       >=1.10++source-repository head+  type:     git+  location: git://github.com/diagrams/monoid-extras.git++library+  default-language:  Haskell2010+  exposed-modules:   Data.Monoid.Action,+                     Data.Monoid.Coproduct,+                     Data.Monoid.Deletable,+                     Data.Monoid.MList,+                     Data.Monoid.PosInf,+                     Data.Monoid.Split,+                     Data.Monoid.WithSemigroup++  build-depends:     base >= 4.3 && < 4.7,+                     semigroups >= 0.8 && < 0.9++  hs-source-dirs:    src

@@ -0,0 +1,56 @@+{-# LANGUAGE MultiParamTypeClasses+           , FlexibleInstances+  #-}++-----------------------------------------------------------------------------+-- |+-- 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 same 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.+class Action m s where++  -- | Convert a value of type @m@ to an action on @s@ values.+  act :: m -> s -> s+  act = const 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

@@ -0,0 +1,109 @@+{-# 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) . unMCo

@@ -0,0 +1,87 @@+{-# 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

@@ -0,0 +1,126 @@+{-# LANGUAGE TypeOperators+           , MultiParamTypeClasses+           , FlexibleInstances+           , OverlappingInstances+           , UndecidableInstances+           , TypeFamilies+           , GeneralizedNewtypeDeriving+  #-}++-----------------------------------------------------------------------------+-- |+-- 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 () l where+  act _ a = a++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)

@@ -0,0 +1,33 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.PosInf+-- Copyright   :  (c) 2012 diagrams-core team (see LICENSE)+-- License     :  BSD-style (see LICENSE)+-- Maintainer  :  diagrams-discuss@googlegroups.com+--+-- Make a semigroup under 'min' into a monoid by adjoining an element+-- corresponding to positive infinity.+--+-----------------------------------------------------------------------------++module Data.Monoid.PosInf+       ( PosInf(..)+       , minimum+       ) where++import           Data.Semigroup+import qualified Prelude as P+import           Prelude hiding (minimum)++data PosInf a = Finite a | PosInfty+  deriving (Eq, Ord, Show)++instance Ord a => Semigroup (PosInf a) where+  (<>) = min++instance Ord a => Monoid (PosInf a) where+  mempty = PosInfty+  mappend = (<>)++minimum :: Ord a => [a] -> PosInf a+minimum xs = P.minimum (PosInfty : map Finite xs)

@@ -0,0 +1,65 @@+{-# 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.  For example, 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.+data Split m = M m+             | m :| m++-- | 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 @a \<\> split \<\> 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)

@@ -0,0 +1,32 @@+{-# 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