diagrams-core-0.5: Core libraries for diagrams EDSL

Maintainerdiagrams-discuss@googlegroups.com
Safe HaskellNone

Graphics.Rendering.Diagrams.Monoids

Contents

Description

Various monoid-related definitions (monoid actions, split monoids, applicative monoids) used in the core diagrams library.

Synopsis

Monoids and semigroups

class (Semigroup m, Monoid m) => Monoid' m Source

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.

Instances

(Semigroup m, Monoid m) => Monoid' m 

Monoid actions

class Action m s whereSource

Type class for monoid 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

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 monoidal type M which should have no action on anything, it suffices to write

 instance Action M s

with no method implementations.

Methods

act :: m -> s -> sSource

Convert a monoidal value of type m to an action on s values.

Instances

Action Name a

Names don't act on anything else.

Action Nil l 
Action Name (NameMap v)

A name acts on a name map by qualifying every name in it.

Action m n => Action (Forgetful m) n 
Action m n => Action (Split m) n

By default, the action of a split monoid is the same as for the underlying monoid, as if the split were removed.

(HasLinearMap v, ~ * v (V a), Transformable a) => Action (Transformation v) a

Transformations can act on transformable things.

Action (Style v) m

Styles have no action on other monoids.

Monoid a => Action (SM a) Nil 
(Action a a', Action (SM a) l) => Action (SM a) (::: a' l) 
(Action m r, Action n r) => Action (:+: m n) r

Coproducts act on other things by having each of the components act individually.

(Action m n, Foldable f, Functor f, Monoid n) => Action (AM f m) n

An applicative monoid acts on a value of a monoidal type by having each element in the structure act on the value independently, and then folding the resulting structure.

(Monoid a, Action (SM a) l2, Action l1 l2) => Action (::: a l1) l2 

Split monoids

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, 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.

data Split m Source

A value of type Split m is either a single m, or a pair of m's separated by a divider.

Constructors

M m 
m :| m 

Instances

(Semigroup m, Monoid m) => Monoid (Split m) 
Semigroup m => Semigroup (Split 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.

Action m n => Action (Split m) n

By default, the action of a split monoid is the same as for the underlying monoid, as if the split were removed.

Newtype (QDiagram b v m) (UDTree (UpAnnots v m) (DownAnnots v) (Prim b v)) 

split :: Monoid m => Split mSource

A convenient name for mempty :| mempty, so a <> split <> b == a :| b.

Forgetful monoids

Sometimes we want to be able to "forget" some information. We define two monoid transformers that allow forgetting information. Forgetful introduces special values which cause anything to their right to be forgotten. Deletable introduces special "left and right bracket" elements which cause everything inside them to be forgotten.

data Forgetful m Source

A value of type Forgetful m is either a "normal" value of type m, which combines normally with other normal values, or a "forgetful" value, which combines normally with other values to its left but discards values combined on the right. Also, when combining a forgetful value with a normal one the result is always forgetful.

Constructors

Normal m 
Forgetful m 

Instances

Functor Forgetful 
(Semigroup m, Monoid m) => Monoid (Forgetful m) 
Semigroup m => Semigroup (Forgetful m)

If m is a Semigroup, then Forgetful m is a semigroup with two sorts of values, "normal" and "forgetful": the normal ones combine normally and the forgetful ones discard anything to the right.

Transformable m => Transformable (Forgetful m) 
Action m n => Action (Forgetful m) n 

unForget :: Forgetful m -> mSource

Project the wrapped value out of a Forgetful value.

forget :: Monoid m => Forgetful mSource

A convenient name for Forgetful mempty, so a <> forget <> b == Forgetful a.

data Deletable m Source

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.

Constructors

Deletable Int m Int 

unDelete :: Deletable m -> mSource

Project the wrapped value out of a Deletable value.

toDeletable :: m -> Deletable mSource

Inject a value into a Deletable wrapper. Satisfies the property

 unDelete . toDeletable === id

deleteL :: Monoid m => Deletable mSource

A "left bracket", which causes everything between it and the next right bracket to be deleted.

deleteR :: Monoid m => Deletable mSource

A "right bracket", denoting the end of the section that should be deleted.

Applicative monoids

newtype AM f m Source

A wrapper for an Applicative structure containing a monoid. Such structures have a Monoid instance based on "idiomatic" application of mappend within the Applicative context. instance Monoid m => Monoid (e -> m) is one well-known special case. (However, the standard Monoid instance for Maybe is not an instance of this pattern; nor is the standard instance for lists.)

Constructors

AM (f m) 

Instances

Functor f => Functor (AM f) 
Applicative f => Applicative (AM f) 
(Applicative f, Monoid m) => Monoid (AM f m)

f1 `mappend` f2 is defined as mappend <$> f1 <*> f2.

(Applicative f, Semigroup m) => Semigroup (AM f m) 
(Action m n, Foldable f, Functor f, Monoid n) => Action (AM f m) n

An applicative monoid acts on a value of a monoidal type by having each element in the structure act on the value independently, and then folding the resulting structure.

Newtype (QDiagram b v m) (UDTree (UpAnnots v m) (DownAnnots v) (Prim b v)) 

inAM2 :: (f m -> f m -> f m) -> AM f m -> AM f m -> AM f mSource

Apply a binary function inside an AM newtype wrapper.

Coproduct monoid

data m :+: n Source

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.

Instances

Monoid (:+: m n)

The coproduct of two monoids is itself a monoid.

Semigroup (:+: m n) 
(Action m r, Action n r) => Action (:+: m n) r

Coproducts act on other things by having each of the components act individually.

Newtype (QDiagram b v m) (UDTree (UpAnnots v m) (DownAnnots v) (Prim b v)) 

inL :: m -> m :+: nSource

Injection from the left monoid into a coproduct.

inR :: n -> m :+: nSource

Injection from the right monoid into a coproduct.

mappendL :: m -> (m :+: n) -> m :+: nSource

Prepend a value from the left monoid.

mappendR :: n -> (m :+: n) -> m :+: nSource

Prepend a value from the right monoid.

killL :: Monoid n => (m :+: n) -> nSource

killL takes a value in a coproduct monoid and sends all the values from the left monoid to the identity.

killR :: Monoid m => (m :+: n) -> mSource

killR takes a value in a coproduct monoid and sends all the values from the right monoid to the identity.

untangle :: (Action m n, Monoid m, Monoid n) => (m :+: n) -> (m, n)Source

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.