[initialized documentation ekmett@gmail.com**20090329044124] { adddir ./doc adddir ./doc/html adddir ./doc/html/monoids adddir ./doc/html/monoids/src addfile ./doc/html/monoids/Data-Group-Combinators.html hunk ./doc/html/monoids/Data-Group-Combinators.html 1 + + +
| ||||||||
| ||||||||
Description | ||||||||
Utilities for working with Groups that conflict with names from the Prelude. + Intended to be imported qualified. + import Data.Group.Combinators as Group (replicate) + | ||||||||
Documentation | ||||||||
module Data.Group | ||||||||
| ||||||||
Produced by Haddock version 2.3.0 |
| ||||||||
| ||||||||
Description | ||||||||
Syntactic sugar for working with groups that conflicts with names from the Prelude. + import Prelude hiding ((-), (+), negate, subtract) + import Data.Group.Sugar + | ||||||||
Documentation | ||||||||
module Data.Monoid.Additive.Sugar | ||||||||
module Data.Group | ||||||||
| ||||||||
| ||||||||
| ||||||||
Produced by Haddock version 2.3.0 |
| ||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||
Description | ||||||||||||||||||||||||||||
Extends Monoid to support Group operations + | ||||||||||||||||||||||||||||
Synopsis | ||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||
Documentation | ||||||||||||||||||||||||||||
module Data.Monoid.Additive | ||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||
Produced by Haddock version 2.3.0 |
| ||||||||
| ||||||||
Description | ||||||||
Syntactic sugar for working with a Monoid that conflicts with names from the Prelude. + import Prelude hiding ((+)) + import Data.Monoid.Additive.Sugar + | ||||||||
Documentation | ||||||||
module Data.Monoid.Additive | ||||||||
| ||||||||
Produced by Haddock version 2.3.0 |
| ||||||||
| ||||||||
Description | ||||||||
More easily understood aliases for mappend and mempty + import Data.Monoid.Additive + | ||||||||
Documentation | ||||||||
| ||||||||
| ||||||||
Produced by Haddock version 2.3.0 |
| ||||||||||||||||||||||||||
| ||||||||||||||||||||||||||
Description | ||||||||||||||||||||||||||
Monoids for working with an Applicative Functor. + | ||||||||||||||||||||||||||
Synopsis | ||||||||||||||||||||||||||
| ||||||||||||||||||||||||||
Documentation | ||||||||||||||||||||||||||
module Data.Monoid.Reducer | ||||||||||||||||||||||||||
module Data.Ring.Semi.Near | ||||||||||||||||||||||||||
module Data.Ring.Module | ||||||||||||||||||||||||||
| ||||||||||||||||||||||||||
| ||||||||||||||||||||||||||
| ||||||||||||||||||||||||||
| ||||||||||||||||||||||||||
| ||||||||||||||||||||||||||
| ||||||||||||||||||||||||||
| ||||||||||||||||||||||||||
Efficiently avoid needlessly rebinding when using snoc on an action that already returns () + A rewrite rule automatically applies this when possible + | ||||||||||||||||||||||||||
Produced by Haddock version 2.3.0 |
| |||||||||||
| |||||||||||
| |||||||||||
Description | |||||||||||
Synopsis | |||||||||||
| |||||||||||
Documentation | |||||||||||
module Data.Monoid.Reducer | |||||||||||
Generalized Endo + | |||||||||||
| |||||||||||
| |||||||||||
Monoids as Categories + | |||||||||||
| |||||||||||
| |||||||||||
| |||||||||||
Extract the Monoid from its representation as a Category + | |||||||||||
Produced by Haddock version 2.3.0 |
| |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
Description | |||||||||||||||||||||||||||||||||||||||||
Utilities for working with Monoids that conflict with names from the Prelude, + Data.Foldable, Control.Monad or elsewhere. Intended to be imported qualified. + import Data.Group.Combinators as Monoid + | |||||||||||||||||||||||||||||||||||||||||
Synopsis | |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
Documentation | |||||||||||||||||||||||||||||||||||||||||
module Data.Monoid.Generator | |||||||||||||||||||||||||||||||||||||||||
Monadic Reduction + | |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
Efficiently mapReduce a Generator using the Action monoid. A specialized version of its namesake from Data.Foldable and Control.Monad + | |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
flipped mapM_ as in Data.Foldable and Control.Monad + | |||||||||||||||||||||||||||||||||||||||||
Applicative Reduction + | |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
Efficiently mapReduce a Generator using the Traversal monoid. A specialized version of its namesake in Data.Foldable + | |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
flipped traverse_ as in Data.Foldable + | |||||||||||||||||||||||||||||||||||||||||
Logical Reduction + | |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
Efficiently reduce a Generator that contains values of type Bool + | |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
Efficiently reduce a Generator that contains values of type Bool + | |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
Efficiently mapReduce any Generator checking to see if any of its values match the supplied predicate + | |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
Efficiently mapReduce any Generator checking to see if all of its values match the supplied predicate + | |||||||||||||||||||||||||||||||||||||||||
Monoidal Reduction + | |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
Efficiently mapReduce a Generator using the Self monoid. A specialized version of its namesake from Data.Foldable + | |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
Efficiently reduce a Generator using the Self monoid. A specialized version of its namesake from Data.Foldable + | |||||||||||||||||||||||||||||||||||||||||
List-Like Reduction + | |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
A further specialization of foldMap + | |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
Check to see if any member of the Generator matches the supplied value + | |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
Efficiently mapReduce a subset of the elements in a Generator + | |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
A specialization of filter using the First Monoid, analogous to Data.List.find + | |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
Efficiently mapReduce any Generator using the Sum Monoid + | |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
Efficiently mapReduce any Generator using the Product Monoid + | |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
Check to make sure that the supplied value is not a member of the Generator + | |||||||||||||||||||||||||||||||||||||||||
List-Like Monoid Generation + | |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
A generalization of Data.List.repeat to an arbitrary Monoid. May fail to terminate for some values in some monoids. + | |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
A generalization of Data.List.replicate to an arbitrary Monoid. Adapted from + http://augustss.blogspot.com/2008/07/lost-and-found-if-i-write-108-in.html + | |||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||
A generalization of Data.List.cycle to an arbitrary Monoid. May fail to terminate for some values in some monoids. + | |||||||||||||||||||||||||||||||||||||||||
Produced by Haddock version 2.3.0 |
| ||||||||||||||||||||
| ||||||||||||||||||||
Description | ||||||||||||||||||||
Transform any Char Reducer into an IsString instance so it can be + used directly with overloaded string literals. + | ||||||||||||||||||||
Documentation | ||||||||||||||||||||
module Data.Monoid.Reducer | ||||||||||||||||||||
| ||||||||||||||||||||
| ||||||||||||||||||||
Produced by Haddock version 2.3.0 |
| ||||||||||
| ||||||||||
Documentation | ||||||||||
module Data.Monoid.Generator | ||||||||||
| ||||||||||
| ||||||||||
| ||||||||||
| ||||||||||
Produced by Haddock version 2.3.0 |
| ||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||
Description | ||||||||||||||||||||||||||||||||||||||||||||
A Generator c is a possibly-specialized container, which contains values of + type Elem c, and which knows how to efficiently apply a Reducer to extract + an answer. + Since a Generator is not polymorphic in its contents, it is more specialized + than Data.Foldable.Foldable, and a Reducer may supply efficient left-to-right + and right-to-left reduction strategies that a Generator may avail itself of. + | ||||||||||||||||||||||||||||||||||||||||||||
Synopsis | ||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||
Documentation | ||||||||||||||||||||||||||||||||||||||||||||
module Data.Monoid.Reducer | ||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||
Apply a Reducer directly to the elements of a Generator + | ||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||
Produced by Haddock version 2.3.0 |
| ||||||||
| ||||||||
Description | ||||||||
A collection of orphan instance declarations for Monoids that should + eventually be pushed back down to the source packages. + Every package that uses these instances includes this package internally. + Includes: +
This module is automatically included everywhere this functionality is required + within this package. You should only have to import this module yourself if you + want these instances for your own purposes. + | ||||||||
Produced by Haddock version 2.3.0 |
| ||||||||||
| ||||||||||
Description | ||||||||||
A simple Monoid transformer that turns any monoidal Reducer into a + a reducer that expects to be supplied both a run length n with each item + and which efficiently exponentiates the result of unit n times through + replicate. + | ||||||||||
Documentation | ||||||||||
module Data.Monoid.Reducer | ||||||||||
| ||||||||||
| ||||||||||
Produced by Haddock version 2.3.0 |
| |||||||||||||||||
| |||||||||||||||||
Description | |||||||||||||||||
Incrementally determine locations in a source file through local information + This allows for efficient recomputation of line #s and token locations + while the file is being interactively updated by storing this as a supplemental + measure on a FingerTree. + The general idea is to use this as part of a measure in a FingerTree so you can + use mappend to prepend a startOfFile with the file information. + | |||||||||||||||||
Synopsis | |||||||||||||||||
| |||||||||||||||||
Documentation | |||||||||||||||||
module Data.Monoid.Reducer.Char | |||||||||||||||||
| |||||||||||||||||
Compute the location of the next standard 8-column aligned tab + | |||||||||||||||||
| |||||||||||||||||
| |||||||||||||||||
| |||||||||||||||||
| |||||||||||||||||
| |||||||||||||||||
extract partial information about the current line number if possible + | |||||||||||||||||
| |||||||||||||||||
extract partial information about the current column, even in the absence of knowledge of the source file + | |||||||||||||||||
| |||||||||||||||||
lift information about a source file into a starting SourcePosition for that file + | |||||||||||||||||
| |||||||||||||||||
extract the standard format for an absolute source position + | |||||||||||||||||
Produced by Haddock version 2.3.0 |
| ||||||||
| ||||||||
Description | ||||||||
UTF8 encoded unicode characters can be parsed both forwards and backwards, + since the start of each Char is clearly marked. This Monoid accumulates + information about the characters represented and reduces that information + using a CharReducer, which is just a Reducer Monoid that knows what + it wants to do about an invalidChar -- a string of Word8 values that + don't form a valid UTF8 character. + As this monoid parses chars it just feeds them upstream to the underlying + CharReducer. Efficient left-to-right and right-to-left traversals are + supplied so that a lazy ByteString can be parsed efficiently by + chunking it into strict chunks, and batching the traversals over each + before stitching the edges together. + Because this needs to be a Monoid and should return the exact same result + regardless of forward or backwards parsing, it chooses to parse only + canonical UTF8 unlike most Haskell UTF8 parsers, which will blissfully + accept illegal alternative long encodings of a character. + This actually fixes a potential class of security issues in some scenarios: + http://prowebdevelopmentblog.com/content/big-overhaul-java-utf-8-charset + NB: Due to naive use of a list to track the tail of an unfinished character + this may exhibit O(n^2) behavior parsing backwards along an invalid sequence + of a large number of bytes that all claim to be in the tail of a character. + | ||||||||
Documentation | ||||||||
module Data.Monoid.Reducer.Char | ||||||||
| ||||||||
| ||||||||
| ||||||||
Produced by Haddock version 2.3.0 |
| |||||||||||||||||
| |||||||||||||||||
| |||||||||||||||||
Description | |||||||||||||||||
A simple demonstration of tokenizing a Generator into distinct words + and/or lines using a word-parsing Monoid that accumulates partial + information about words and then builds up a token stream. + | |||||||||||||||||
Synopsis | |||||||||||||||||
| |||||||||||||||||
Documentation | |||||||||||||||||
module Data.Monoid.Reducer.Char | |||||||||||||||||
Words + | |||||||||||||||||
| |||||||||||||||||
| |||||||||||||||||
| |||||||||||||||||
Extract the matched words from the Words Monoid + | |||||||||||||||||
| |||||||||||||||||
| |||||||||||||||||
| |||||||||||||||||
Utility function to extract words using accumulator, inside-word, and until-next-word monoids + | |||||||||||||||||
Lines + | |||||||||||||||||
| |||||||||||||||||
| |||||||||||||||||
| |||||||||||||||||
Extract the matched lines from the Lines Monoid + | |||||||||||||||||
| |||||||||||||||||
| |||||||||||||||||
| |||||||||||||||||
Utility function to extract lines using accumulator, inside-line, and until-next-line monoids + | |||||||||||||||||
Produced by Haddock version 2.3.0 |
| |||||||||||||||||||||||||
| |||||||||||||||||||||||||
| |||||||||||||||||||||||||
Description | |||||||||||||||||||||||||
Monoid instances for working with a Monad + | |||||||||||||||||||||||||
Synopsis | |||||||||||||||||||||||||
| |||||||||||||||||||||||||
Documentation | |||||||||||||||||||||||||
module Data.Monoid.Reducer | |||||||||||||||||||||||||
module Data.Ring.Semi.Near | |||||||||||||||||||||||||
Actions + | |||||||||||||||||||||||||
| |||||||||||||||||||||||||
| |||||||||||||||||||||||||
| |||||||||||||||||||||||||
Efficiently avoid needlessly rebinding when using snoc on an action that already returns () + A rewrite rule automatically applies this when possible + | |||||||||||||||||||||||||
Lifting Modules + | |||||||||||||||||||||||||
| |||||||||||||||||||||||||
| |||||||||||||||||||||||||
Wrapped Monads + | |||||||||||||||||||||||||
| |||||||||||||||||||||||||
| |||||||||||||||||||||||||
Produced by Haddock version 2.3.0 |
| ||||||||
| ||||||||
Description | ||||||||
Syntactic sugar for working with a Multiplicative monoids that conflicts with names from the Prelude. + import Prelude hiding ((+),(*)) + import Data.Monoid.Multiplicative.Sugar + | ||||||||
Documentation | ||||||||
module Data.Monoid.Additive.Sugar | ||||||||
module Data.Monoid.Multiplicative | ||||||||
| ||||||||
Produced by Haddock version 2.3.0 |
| ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
Description | ||||||||||||||||
When dealing with a Ring or other structure, you often need a pair of + Monoid instances that are closely related. Making a newtype for one + is unsatisfying and yields an unnatural programming style. + A Multiplicative is a Monoid that is intended for use in a scenario + that can be extended to have another Monoid slot in for addition. This + enables one to use common notation. + Any Multiplicative can be turned into a Monoid using the Log wrapper. + Any Monoid can be turned into a Multiplicative using the Exp wrapper. + Instances are supplied for common Monads of Monoids, in a fashion + which can be extended if the Monad is a MonadPlus to yield a LeftSemiNearRing + Instances are also supplied for common Applicatives of Monoids, in a + fashion which can be extended if the Applicative is Alternative to + yield a LeftSemiNearRing + | ||||||||||||||||
Synopsis | ||||||||||||||||
| ||||||||||||||||
Documentation | ||||||||||||||||
module Data.Monoid.Additive | ||||||||||||||||
Multiplicative Monoids + | ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
Multiplicative to Monoid + | ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
Monoid to Multiplicative + | ||||||||||||||||
| ||||||||||||||||
| ||||||||||||||||
Produced by Haddock version 2.3.0 |
| |||||||||||||||||||||
| |||||||||||||||||||||
| |||||||||||||||||||||
Synopsis | |||||||||||||||||||||
| |||||||||||||||||||||
Documentation | |||||||||||||||||||||
module Data.Monoid.Reducer | |||||||||||||||||||||
Max + | |||||||||||||||||||||
| |||||||||||||||||||||
| |||||||||||||||||||||
Min + | |||||||||||||||||||||
| |||||||||||||||||||||
| |||||||||||||||||||||
MaxPriority: Max semigroup w/ added bottom + | |||||||||||||||||||||
| |||||||||||||||||||||
| |||||||||||||||||||||
| |||||||||||||||||||||
MinPriority: Min semigroup w/ added top + | |||||||||||||||||||||
| |||||||||||||||||||||
| |||||||||||||||||||||
| |||||||||||||||||||||
Produced by Haddock version 2.3.0 |
| |||||||||||||||||||||||
| |||||||||||||||||||||||
Description | |||||||||||||||||||||||
Synopsis | |||||||||||||||||||||||
| |||||||||||||||||||||||
Documentation | |||||||||||||||||||||||
module Data.Monoid.Reducer | |||||||||||||||||||||||
| |||||||||||||||||||||||
| |||||||||||||||||||||||
| |||||||||||||||||||||||
| |||||||||||||||||||||||
Produced by Haddock version 2.3.0 |
| |||||||||||||
| |||||||||||||
Description | |||||||||||||
Synopsis | |||||||||||||
| |||||||||||||
Documentation | |||||||||||||
module Data.Monoid.Reducer | |||||||||||||
| |||||||||||||
| |||||||||||||
Produced by Haddock version 2.3.0 |
| ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Description | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
A c-Reducer is a Monoid with a canonical mapping from c to the Monoid. + This unit acts in many ways like return for a Monad but is limited + to a single type. + | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Synopsis | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Documentation | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Convert a value into a Monoid + | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Append a value to a Monoid for use in left-to-right reduction + | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Prepend a value onto a Monoid for use during right-to-left reduction + | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Apply a Reducer to a Foldable container, after mapping the contents into a suitable form for reduction. + | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Apply a Reducer to a Foldable mapping each element through unit + | ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Produced by Haddock version 2.3.0 |
| |||||||||||||||||||
| |||||||||||||||||||
Description | |||||||||||||||||||
A simple Monoid transformer that takes a Monoid m and produces a new m-Reducer named Self m + This is useful when you have a generator that already contains monoidal values or someone supplies + the map to the monoid in the form of a function rather than as a Reducer instance. You can just + getSelf . reduce or getSelf . mapReduce f in those scenarios. These behaviors are encapsulated + into the fold and foldMap combinators in Data.Monoid.Combinators respectively. + | |||||||||||||||||||
Documentation | |||||||||||||||||||
module Data.Monoid.Reducer | |||||||||||||||||||
| |||||||||||||||||||
| |||||||||||||||||||
Produced by Haddock version 2.3.0 |
| |||||||||||||||||||||||||
| |||||||||||||||||||||||||
| |||||||||||||||||||||||||
Synopsis | |||||||||||||||||||||||||
| |||||||||||||||||||||||||
Documentation | |||||||||||||||||||||||||
module Data.Monoid.Reducer | |||||||||||||||||||||||||
Unions of Containers + | |||||||||||||||||||||||||
| |||||||||||||||||||||||||
| |||||||||||||||||||||||||
| |||||||||||||||||||||||||
| |||||||||||||||||||||||||
| |||||||||||||||||||||||||
| |||||||||||||||||||||||||
Unions of Containers of Monoids + | |||||||||||||||||||||||||
| |||||||||||||||||||||||||
| |||||||||||||||||||||||||
| |||||||||||||||||||||||||
| |||||||||||||||||||||||||
| |||||||||||||||||||||||||
| |||||||||||||||||||||||||
Produced by Haddock version 2.3.0 |
| ||||||||||
| ||||||||||
Description | ||||||||||
A Boolean Ring over Bool. Note well that the mappend of this ring is + symmetric difference and not disjunction like you might expect. To get that + you should use use Ord from Data.Ring.Semi.Ord.Order on Bool to get the '&&'/'||'-based + distributive-lattice SemiRing + | ||||||||||
Documentation | ||||||||||
module Data.Ring | ||||||||||
| ||||||||||
| ||||||||||
Produced by Haddock version 2.3.0 |
| |||||||||||||||||||||
| |||||||||||||||||||||
Description | |||||||||||||||||||||
A wrapper that lies for you and claims any instance of Num is a Ring. + Who knows, for your type it might even be telling the truth! + | |||||||||||||||||||||
Documentation | |||||||||||||||||||||
module Data.Ring | |||||||||||||||||||||
| |||||||||||||||||||||
| |||||||||||||||||||||
Produced by Haddock version 2.3.0 |
| ||||||||||
| ||||||||||
Documentation | ||||||||||
module Data.Ring.Module | ||||||||||
| ||||||||||
| ||||||||||
Produced by Haddock version 2.3.0 |
| |||||||||||||||
| |||||||||||||||
Description | |||||||||||||||
Left- and right- modules over rings, semirings, and Seminearrings. + To avoid a proliferation of classes. These only require that there + be an addition and multiplication operation for the Ring + | |||||||||||||||
Synopsis | |||||||||||||||
| |||||||||||||||
Documentation | |||||||||||||||
module Data.Ring | |||||||||||||||
| |||||||||||||||
| |||||||||||||||
| |||||||||||||||
| |||||||||||||||
| |||||||||||||||
| |||||||||||||||
| |||||||||||||||
| |||||||||||||||
Produced by Haddock version 2.3.0 |
| ||||||||||||||||||||||||||
| ||||||||||||||||||||||||||
Description | ||||||||||||||||||||||||||
Defines left- and right- seminearrings. Every MonadPlus wrapped around + a Monoid qualifies due to the distributivity of (>>=) over mplus. + See http://conway.rutgers.edu/~ccshan/wiki/blog/posts/WordNumbers1/ + | ||||||||||||||||||||||||||
Synopsis | ||||||||||||||||||||||||||
| ||||||||||||||||||||||||||
Documentation | ||||||||||||||||||||||||||
module Data.Monoid.Multiplicative | ||||||||||||||||||||||||||
| ||||||||||||||||||||||||||
| ||||||||||||||||||||||||||
| ||||||||||||||||||||||||||
| ||||||||||||||||||||||||||
Produced by Haddock version 2.3.0 |
| |||||||||||||||||||||||||||
| |||||||||||||||||||||||||||
Description | |||||||||||||||||||||||||||
Turn an instance of Ord into a SemiRing over max and min + | |||||||||||||||||||||||||||
Synopsis | |||||||||||||||||||||||||||
| |||||||||||||||||||||||||||
Documentation | |||||||||||||||||||||||||||
module Data.Ring.Semi | |||||||||||||||||||||||||||
| |||||||||||||||||||||||||||
| |||||||||||||||||||||||||||
| |||||||||||||||||||||||||||
| |||||||||||||||||||||||||||
Produced by Haddock version 2.3.0 |
| |||||||||||||||||||||||||
| |||||||||||||||||||||||||
| |||||||||||||||||||||||||
Synopsis | |||||||||||||||||||||||||
| |||||||||||||||||||||||||
Documentation | |||||||||||||||||||||||||
module Data.Monoid.Reducer | |||||||||||||||||||||||||
module Data.Ring.Semi | |||||||||||||||||||||||||
Tropical Semirings + | |||||||||||||||||||||||||
| |||||||||||||||||||||||||
| |||||||||||||||||||||||||
| |||||||||||||||||||||||||
Produced by Haddock version 2.3.0 |
| ||||||||
| ||||||||
Description | ||||||||
Synopsis | ||||||||
| ||||||||
Documentation | ||||||||
module Data.Ring.Semi.Near | ||||||||
| ||||||||
| ||||||||
Produced by Haddock version 2.3.0 |
| ||||||||
| ||||||||
Description | ||||||||
Syntactic sugar for working with rings that conflicts with names from the Prelude. + import Prelude hiding ((-), (+), (*), negate, subtract) + import Data.Ring.Sugar + | ||||||||
Documentation | ||||||||
module Data.Monoid.Multiplicative.Sugar | ||||||||
module Data.Ring.Semi.Near | ||||||||
Produced by Haddock version 2.3.0 |
| |||||
| |||||
Documentation | |||||
module Data.Group | |||||
module Data.Ring.Semi | |||||
| |||||
| |||||
Produced by Haddock version 2.3.0 |
| ||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
| |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
monoids-0.1.8: Lots of Monoids | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Lots of Monoids + | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Modules | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
| |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Produced by Haddock version 2.3.0 |
----------------------------------------------------------------------------- +-- | +-- Module : Data.Group.Combinators +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : portable +-- +-- Utilities for working with Groups that conflict with names from the "Prelude". +-- +-- Intended to be imported qualified. +-- +-- > import Data.Group.Combinators as Group (replicate) +-- +----------------------------------------------------------------------------- + +module Data.Group.Combinators + ( module Data.Group + , replicate + ) where + +import Prelude hiding (replicate) +import Data.Group + +-- shamelessly stolen from Lennart Augustsson's post: +-- http://augustss.blogspot.com/2008/07/lost-and-found-if-i-write-108-in.html +-- adapted to groups, which can permit negative exponents +replicate :: (Group m, Integral n) => m -> n -> m +replicate x0 y0 + | y0 < 0 = f (gnegate x0) (negate y0) + | y0 == 0 = mempty + | otherwise = f x0 y0 + where + f x y + | even y = f (x `mappend` x) (y `quot` 2) + | y == 1 = x + | otherwise = g (x `mappend` x) ((y - 1) `quot` 2) x + g x y z + | even y = g (x `mappend` x) (y `quot` 2) z + | y == 1 = x `mappend` z + | otherwise = g (x `mappend` x) ((y - 1) `quot` 2) (x `mappend` z) + ++ addfile ./doc/html/monoids/src/Data-Group-Sugar.html hunk ./doc/html/monoids/src/Data-Group-Sugar.html 1 + + + + +
----------------------------------------------------------------------------- +-- | +-- Module : Data.Group.Sugar +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : portable +-- +-- Syntactic sugar for working with groups that conflicts with names from the "Prelude". +-- +-- > import Prelude hiding ((-), (+), negate, subtract) +-- > import Data.Group.Sugar +-- +----------------------------------------------------------------------------- + +module Data.Group.Sugar + ( module Data.Monoid.Additive.Sugar + , module Data.Group + , (-) + , negate + , subtract + ) where + +import Data.Monoid.Additive.Sugar +import Data.Group +import Prelude hiding ((-), negate, subtract) + +infixl 7 - + +(-) :: Group g => g -> g -> g +(-) = minus + +negate :: Group g => g -> g +negate = gnegate + +subtract :: Group g => g -> g -> g +subtract = gsubtract ++ addfile ./doc/html/monoids/src/Data-Group.html hunk ./doc/html/monoids/src/Data-Group.html 1 + + + + +
---------------------------------------------------------------------------- +-- | +-- Module : Data.Group +-- Copyright : 2007-2009 Edward Kmett +-- License : BSD +-- +-- Maintainer : Edward Kmett <ekmett@gmail.com> +-- Stability : experimental +-- Portability : portable +-- +-- Extends 'Monoid' to support 'Group' operations +----------------------------------------------------------------------------- + +module Data.Group + ( module Data.Monoid.Additive + , Group + , gnegate + , gsubtract + , minus + ) where + +import Data.Monoid.Additive +import Data.Monoid.Self +import Data.Monoid.FromString + +infixl 6 `minus` + +-- | Minimal complete definition: 'gnegate' or 'minus' +class Monoid a => Group a where + -- additive inverse + gnegate :: a -> a + minus :: a -> a -> a + gsubtract :: a -> a -> a + + gnegate = minus zero + a `minus` b = a `plus` gnegate b + a `gsubtract` b = gnegate a `plus` b + +instance Num a => Group (Sum a) where + gnegate = Sum . negate . getSum + Sum a `minus` Sum b = Sum (a - b) + +instance Fractional a => Group (Product a) where + gnegate = Product . negate . getProduct + Product a `minus` Product b = Product (a / b) + +instance Group a => Group (Dual a) where + gnegate = Dual . gnegate . getDual + +instance Group a => Group (Self a) where + gnegate = Self . gnegate . getSelf + Self a `minus` Self b = Self (a `minus` b) + +instance Group a => Group (FromString a) where + gnegate = FromString . gnegate . getFromString + FromString a `minus` FromString b = FromString (a `minus` b) ++ addfile ./doc/html/monoids/src/Data-Monoid-Additive-Sugar.html hunk ./doc/html/monoids/src/Data-Monoid-Additive-Sugar.html 1 + + + + +
----------------------------------------------------------------------------- +-- | +-- Module : Data.Monoid.Additive.Sugar +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : portable +-- +-- Syntactic sugar for working with a 'Monoid' that conflicts with names from the "Prelude". +-- +-- > import Prelude hiding ((+)) +-- > import Data.Monoid.Additive.Sugar +-- +----------------------------------------------------------------------------- + +module Data.Monoid.Additive.Sugar + ( module Data.Monoid.Additive + , (+) + ) where + +import Data.Monoid.Additive +import Prelude hiding ((+)) + +infixl 6 + + +(+) :: Monoid m => m -> m -> m +(+) = mappend ++ addfile ./doc/html/monoids/src/Data-Monoid-Additive.html hunk ./doc/html/monoids/src/Data-Monoid-Additive.html 1 + + + + +
----------------------------------------------------------------------------- +-- | +-- Module : Data.Monoid.Additive +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : portable +-- +-- More easily understood aliases for "mappend" and "mempty" +-- +-- > import Data.Monoid.Additive +-- +----------------------------------------------------------------------------- + +module Data.Monoid.Additive + ( module Data.Monoid + , plus + , zero + ) where + +import Data.Monoid + +infixl 6 `plus` + +plus :: Monoid m => m -> m -> m +plus = mappend + +zero :: Monoid m => m +zero = mempty ++ addfile ./doc/html/monoids/src/Data-Monoid-Applicative.html hunk ./doc/html/monoids/src/Data-Monoid-Applicative.html 1 + + + + +
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts, TypeOperators #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Monoid.Applicative +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable (MPTCs) +-- +-- Monoids for working with an 'Applicative' 'Functor'. +-- +----------------------------------------------------------------------------- + +module Data.Monoid.Applicative + ( module Data.Monoid.Reducer + , module Data.Ring.Semi.Near + , module Data.Ring.Module + , Traversal(Traversal,getTraversal) + , WrappedApplicative(WrappedApplicative,getWrappedApplicative) + , TraversalWith(TraversalWith,getTraversalWith) + , snocTraversal + ) where + +import Control.Applicative +import Data.Monoid.Reducer +import Data.Ring.Semi.Near +import Data.Ring.Module +import Control.Functor.Pointed + +-- | A 'Traversal' uses an glues together 'Applicative' actions with (*>) +-- in the manner of 'traverse_' from "Data.Foldable". Any values returned by +-- reduced actions are discarded. +newtype Traversal f = Traversal { getTraversal :: f () } + +instance Applicative f => Monoid (Traversal f) where + mempty = Traversal (pure ()) + Traversal a `mappend` Traversal b = Traversal (a *> b) + +instance Applicative f => Reducer (f a) (Traversal f) where + unit a = Traversal (a *> pure ()) + a `cons` Traversal b = Traversal (a *> b) + Traversal a `snoc` b = Traversal (a *> b *> pure ()) + +{-# RULES "unitTraversal" unit = Traversal #-} +{-# RULES "snocTraversal" snoc = snocTraversal #-} + +-- | Efficiently avoid needlessly rebinding when using 'snoc' on an action that already returns () +-- A rewrite rule automatically applies this when possible +snocTraversal :: Reducer (f ()) (Traversal f) => Traversal f -> f () -> Traversal f +snocTraversal a = mappend a . Traversal + + +-- | A 'WrappedApplicative' turns any 'Alternative' instance into a 'Monoid'. +-- It also provides a 'Multiplicative' instance for an 'Applicative' functor wrapped around a 'Monoid' +-- and asserts that any 'Alternative' applied to a 'Monoid' forms a 'LeftSemiNearRing' +-- under these operations. + +newtype WrappedApplicative f a = WrappedApplicative { getWrappedApplicative :: f a } + deriving (Eq,Ord,Show,Read,Functor,Pointed,Applicative,Alternative,Copointed) + +instance Alternative f => Monoid (WrappedApplicative f a) where + mempty = empty + WrappedApplicative a `mappend` WrappedApplicative b = WrappedApplicative (a <|> b) + +instance (Alternative f, Monoid a) => Multiplicative (WrappedApplicative f a) where + one = pure mempty + times = liftA2 mappend + +instance (Alternative f, c `Reducer` a) => Reducer c (WrappedApplicative f a) where + unit = WrappedApplicative . pure . unit + +instance (Alternative f, Monoid a) => LeftSemiNearRing (WrappedApplicative f a) + +-- | if @m@ is a 'Module' and @f@ is a 'Applicative' then @f `TraversalWith` m@ is a 'Module' as well + +newtype TraversalWith f m = TraversalWith { getTraversalWith :: f m } + deriving (Eq,Ord,Show,Read,Functor,Pointed,Applicative,Alternative,Copointed) + +instance (Monoid m, Applicative f) => Monoid (f `TraversalWith` m) where + mempty = pure mempty + mappend = liftA2 mappend + +instance (Group m, Applicative f) => Group (f `TraversalWith` m) where + gnegate = fmap gnegate + minus = liftA2 minus + gsubtract = liftA2 gsubtract + +instance (c `Reducer` m, Applicative f) => Reducer c (f `TraversalWith` m) where + unit = pure . unit + +instance (LeftModule r m, Applicative f) => LeftModule r (f `TraversalWith` m) where + x *. m = (x *.) <$> m + +instance (RightModule r m, Applicative f) => RightModule r (f `TraversalWith` m) where + m .* y = (.* y) <$> m + +instance (Module r m, Applicative f) => Module r (f `TraversalWith` m) ++ addfile ./doc/html/monoids/src/Data-Monoid-Categorical.html hunk ./doc/html/monoids/src/Data-Monoid-Categorical.html 1 + + + + +
{-# LANGUAGE GADTs, FlexibleInstances, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Monoid.Categorical +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : portable +-- +----------------------------------------------------------------------------- + +module Data.Monoid.Categorical + ( module Data.Monoid.Reducer + , module Control.Category + -- * Generalized Endo + , GEndo(GEndo, getGEndo) + -- * Monoids as Categories + , Mon(Mon) + , getMon + ) where + +import Prelude hiding ((.),id) +import Data.Monoid.Reducer +import Control.Category + +-- | The 'Monoid' of the endomorphisms over some object in an arbitrary 'Category'. +data GEndo k a = GEndo { getGEndo :: k a a } + +instance Category k => Monoid (GEndo k a) where + mempty = GEndo id + GEndo f `mappend` GEndo g = GEndo (f . g) + +-- | A 'Monoid' is just a 'Category' with one object. +data Mon m n o where + Mon :: Monoid m => m -> Mon m a a + +-- | Extract the 'Monoid' from its representation as a 'Category' +getMon :: Mon m m m -> m +getMon (Mon m) = m + +instance Monoid m => Category (Mon m) where + id = Mon mempty + Mon a . Mon b = Mon (a `mappend` b) + +instance Monoid m => Monoid (Mon m m m) where + mempty = id + mappend = (.) + +instance (c `Reducer` m) => Reducer c (Mon m m m) where + unit = Mon . unit ++ addfile ./doc/html/monoids/src/Data-Monoid-Combinators.html hunk ./doc/html/monoids/src/Data-Monoid-Combinators.html 1 + + + + +
{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Monoid.Combinators +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable (type families, MPTCs) +-- +-- Utilities for working with Monoids that conflict with names from the "Prelude", +-- "Data.Foldable", "Control.Monad" or elsewhere. Intended to be imported qualified. +-- +-- > import Data.Group.Combinators as Monoid +-- +----------------------------------------------------------------------------- + +module Data.Monoid.Combinators + ( module Data.Monoid.Generator + -- * Monadic Reduction + , mapM_ + , forM_ + -- * Applicative Reduction + , traverse_ + , for_ + -- * Logical Reduction + , and + , or + , any + , all + -- * Monoidal Reduction + , foldMap + , fold + -- * List-Like Reduction + , concatMap + , elem + , filter + , find + , sum + , product + , notElem + -- * List-Like Monoid Generation + , repeat + , replicate + , cycle + ) where + +import Prelude hiding (mapM_, any, elem, filter, concatMap, and, or, all, sum, product, notElem, replicate, cycle, repeat) +import Control.Applicative +import Data.Monoid.Generator +import Data.Monoid.Applicative +import Data.Monoid.Self +import Data.Monoid.Monad + +-- | Efficiently 'mapReduce' a 'Generator' using the 'Traversal' monoid. A specialized version of its namesake in "Data.Foldable" +traverse_ :: (Generator c, Applicative f) => (Elem c -> f b) -> c -> f () +traverse_ f = getTraversal . mapReduce f + +-- | flipped 'traverse_' as in "Data.Foldable" +for_ :: (Generator c, Applicative f) => c -> (Elem c -> f b) -> f () +for_ = flip traverse_ + +-- | Efficiently 'mapReduce' a 'Generator' using the 'Action' monoid. A specialized version of its namesake from "Data.Foldable" and "Control.Monad" +mapM_ :: (Generator c, Monad m) => (Elem c -> m b) -> c -> m () +mapM_ f = getAction . mapReduce f + +-- | flipped 'mapM_' as in "Data.Foldable" and "Control.Monad" +forM_ :: (Generator c, Monad m) => c -> (Elem c -> m b) -> m () +forM_ = flip mapM_ + +-- | Efficiently 'mapReduce' a 'Generator' using the 'Self' monoid. A specialized version of its namesake from "Data.Foldable" +foldMap :: (Monoid m, Generator c) => (Elem c -> m) -> c -> m +foldMap f = getSelf . mapReduce f + +-- | Efficiently 'reduce' a 'Generator' using the 'Self' monoid. A specialized version of its namesake from "Data.Foldable" +fold :: (Monoid m, Generator c, Elem c ~ m) => c -> m +fold = getSelf . reduce + +-- | A further specialization of "foldMap" +concatMap :: Generator c => (Elem c -> [b]) -> c -> [b] +concatMap = foldMap + +-- | Efficiently 'reduce' a 'Generator' that contains values of type 'Bool' +and :: (Generator c, Elem c ~ Bool) => c -> Bool +and = getAll . reduce + +-- | Efficiently 'reduce' a 'Generator' that contains values of type 'Bool' +or :: (Generator c, Elem c ~ Bool) => c -> Bool +or = getAny . reduce + +-- | Efficiently 'mapReduce' any 'Generator' checking to see if any of its values match the supplied predicate +any :: Generator c => (Elem c -> Bool) -> c -> Bool +any f = getAny . mapReduce f + +-- | Efficiently 'mapReduce' any 'Generator' checking to see if all of its values match the supplied predicate +all :: Generator c => (Elem c -> Bool) -> c -> Bool +all f = getAll . mapReduce f + +-- | Efficiently 'mapReduce' any 'Generator' using the 'Sum' 'Monoid' +sum :: (Generator c, Num (Elem c)) => c -> Elem c +sum = getSum . reduce + +-- | Efficiently 'mapReduce' any 'Generator' using the 'Product' 'Monoid' +product :: (Generator c, Num (Elem c)) => c -> Elem c +product = getProduct . reduce + +-- | Check to see if 'any' member of the 'Generator' matches the supplied value +elem :: (Generator c, Eq (Elem c)) => Elem c -> c -> Bool +elem = any . (==) + +-- | Check to make sure that the supplied value is not a member of the 'Generator' +notElem :: (Generator c, Eq (Elem c)) => Elem c -> c -> Bool +notElem x = not . elem x + +-- | Efficiently 'mapReduce' a subset of the elements in a 'Generator' +filter :: (Generator c, Elem c `Reducer` m) => (Elem c -> Bool) -> c -> m +filter p = foldMap f where + f x | p x = unit x + | otherwise = mempty + +-- | A specialization of 'filter' using the 'First' 'Monoid', analogous to 'Data.List.find' +find :: Generator c => (Elem c -> Bool) -> c -> Maybe (Elem c) +find p = getFirst . filter p + +-- | A generalization of 'Data.List.replicate' to an arbitrary 'Monoid'. Adapted from +-- <http://augustss.blogspot.com/2008/07/lost-and-found-if-i-write-108-in.html> +replicate :: (Monoid m, Integral n) => m -> n -> m +replicate x0 y0 + | y0 < 0 = mempty -- error "negative length" + | y0 == 0 = mempty + | otherwise = f x0 y0 + where + f x y + | even y = f (x `mappend` x) (y `quot` 2) + | y == 1 = x + | otherwise = g (x `mappend` x) ((y - 1) `quot` 2) x + g x y z + | even y = g (x `mappend` x) (y `quot` 2) z + | y == 1 = x `mappend` z + | otherwise = g (x `mappend` x) ((y - 1) `quot` 2) (x `mappend` z) + +-- | A generalization of 'Data.List.cycle' to an arbitrary 'Monoid'. May fail to terminate for some values in some monoids. +cycle :: Monoid m => m -> m +cycle xs = xs' where xs' = xs `mappend` xs' + +-- | A generalization of 'Data.List.repeat' to an arbitrary 'Monoid'. May fail to terminate for some values in some monoids. +repeat :: (e `Reducer` m) => e -> m +repeat x = xs where xs = cons x xs ++ addfile ./doc/html/monoids/src/Data-Monoid-FromString.html hunk ./doc/html/monoids/src/Data-Monoid-FromString.html 1 + + + + +
{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Monoid.Additive +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable (overloaded strings, MPTCs) +-- +-- Transform any 'Char' 'Reducer' into an 'IsString' instance so it can be +-- used directly with overloaded string literals. +-- +----------------------------------------------------------------------------- + +module Data.Monoid.FromString + ( module Data.Monoid.Reducer + , FromString(FromString,getFromString) + ) where + +import Control.Functor.Pointed +import Data.Monoid.Generator +import Data.Monoid.Reducer +import Data.Monoid.Instances () +import GHC.Exts + +data FromString m = FromString { getFromString :: m } + +instance Monoid m => Monoid (FromString m) where + mempty = FromString mempty + FromString a `mappend` FromString b = FromString (a `mappend` b) + +instance (Char `Reducer` m) => Reducer Char (FromString m) where + unit = FromString . unit + +instance (Char `Reducer` m) => IsString (FromString m) where + fromString = FromString . reduce + +instance Pointed FromString where + point = FromString + +instance Copointed FromString where + extract = getFromString + +instance Functor FromString where + fmap f (FromString x) = FromString (f x) ++ addfile ./doc/html/monoids/src/Data-Monoid-Generator-LZ78.html hunk ./doc/html/monoids/src/Data-Monoid-Generator-LZ78.html 1 + + + + +
{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-} +module Data.Monoid.Generator.LZ78 + ( module Data.Monoid.Generator + , LZ78(LZ78, getLZ78) + , decode + , encode + ) where + +import qualified Data.Sequence as Seq +import Data.Sequence (Seq,(|>)) +import qualified Data.Map as Map +import Data.Map (Map) +import Data.Monoid.Generator +import Data.Monoid.Self + +newtype LZ78 a = LZ78 { getLZ78 :: [(Int,a)] } + +emptyDict :: Monoid m => Seq m +emptyDict = Seq.singleton mempty + +instance Generator (LZ78 a) where + type Elem (LZ78 a) = a + mapTo f m (LZ78 xs) = mapTo' f m emptyDict xs + +mapTo' :: (e `Reducer` m) => (a -> e) -> m -> Seq m -> [(Int,a)] -> m +mapTo' _ m _ [] = m +mapTo' f m s ((w,c):ws) = mapTo' f (m `mappend` v) (s |> v) ws + where + v = Seq.index s w `mappend` unit (f c) + +decode :: LZ78 a -> [a] +decode = reduce + +encode :: Ord a => [a] -> LZ78 a +encode = LZ78 . encode' Map.empty 1 0 + +encode' :: Ord a => Map (Int,a) Int -> Int -> Int -> [a] -> [(Int,a)] +encode' _ _ p [c] = [(p,c)] +encode' d f p (c:cs) = case Map.lookup (p,c) d of + Just p' -> encode' d f p' cs + Nothing -> (p,c):encode' (Map.insert (p,c) f d) (succ f) 0 cs +encode' _ _ _ [] = [] + + +-- QuickCheck properties, this holds as long as Eq is structural +prop_DecodeEncode :: Ord a => [a] -> Bool +prop_DecodeEncode xs = decode (encode xs) == xs ++ addfile ./doc/html/monoids/src/Data-Monoid-Generator.html hunk ./doc/html/monoids/src/Data-Monoid-Generator.html 1 + + + + +
{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Monoid.Generator +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : portable +-- +-- A 'Generator' @c@ is a possibly-specialized container, which contains values of +-- type 'Elem' @c@, and which knows how to efficiently apply a 'Reducer' to extract +-- an answer. +-- +-- Since a 'Generator' is not polymorphic in its contents, it is more specialized +-- than "Data.Foldable.Foldable", and a 'Reducer' may supply efficient left-to-right +-- and right-to-left reduction strategies that a 'Generator' may avail itself of. +----------------------------------------------------------------------------- + +module Data.Monoid.Generator + ( module Data.Monoid.Reducer + , Generator + , Elem + , mapReduce + , mapTo + , mapFrom + , reduce + , Keys(Keys, getKeys) + , Values(Values, getValues) + , Char8(Char8, getChar8) + ) where + +import Data.Array +import Data.Word (Word8) +import Data.Text (Text) +import Data.Foldable (fold,foldMap) +import qualified Data.Text as Text +import qualified Data.ByteString as Strict (ByteString, foldl') +import qualified Data.ByteString.Char8 as Strict8 (foldl') +import qualified Data.ByteString.Lazy as Lazy (ByteString, toChunks) +import qualified Data.ByteString.Lazy.Char8 as Lazy8 (toChunks) +import qualified Data.Sequence as Seq +import Data.FingerTree (Measured, FingerTree) +import Data.Sequence (Seq) +import qualified Data.Set as Set +import Data.Set (Set) +import qualified Data.IntSet as IntSet +import Data.IntSet (IntSet) +import qualified Data.IntMap as IntMap +import Data.IntMap (IntMap) +import qualified Data.Map as Map +import Data.Map (Map) + +import Control.Parallel.Strategies +import Data.Monoid.Reducer + +-- | minimal definition 'mapReduce' or 'mapTo' +class Generator c where + type Elem c :: * + mapReduce :: (e `Reducer` m) => (Elem c -> e) -> c -> m + mapTo :: (e `Reducer` m) => (Elem c -> e) -> m -> c -> m + mapFrom :: (e `Reducer` m) => (Elem c -> e) -> c -> m -> m + + mapReduce f = mapTo f mempty + mapTo f m = mappend m . mapReduce f + mapFrom f = mappend . mapReduce f + +instance Generator Strict.ByteString where + type Elem Strict.ByteString = Word8 + mapTo f = Strict.foldl' (\a -> snoc a . f) + +instance Generator Lazy.ByteString where + type Elem Lazy.ByteString = Word8 + mapReduce f = fold . parMap rwhnf (mapReduce f) . Lazy.toChunks + +instance Generator Text where + type Elem Text = Char + mapTo f = Text.foldl' (\a -> snoc a . f) + +instance Generator [c] where + type Elem [c] = c + mapReduce f = foldMap (unit . f) + +instance Measured v e => Generator (FingerTree v e) where + type Elem (FingerTree v e) = e + mapReduce f = foldMap (unit . f) + +instance Generator (Seq c) where + type Elem (Seq c) = c + mapReduce f = foldMap (unit . f) + +instance Generator IntSet where + type Elem IntSet = Int + mapReduce f = mapReduce f . IntSet.toList + +instance Generator (Set a) where + type Elem (Set a) = a + mapReduce f = mapReduce f . Set.toList + +instance Generator (IntMap v) where + type Elem (IntMap v) = (Int,v) + mapReduce f = mapReduce f . IntMap.toList + +instance Generator (Map k v) where + type Elem (Map k v) = (k,v) + mapReduce f = mapReduce f . Map.toList + +instance Ix i => Generator (Array i e) where + type Elem (Array i e) = (i,e) + mapReduce f = mapReduce f . assocs + +-- | a 'Generator' transformer that asks only for the keys of an indexed container +newtype Keys c = Keys { getKeys :: c } + +instance Generator (Keys (IntMap v)) where + type Elem (Keys (IntMap v)) = Int + mapReduce f = mapReduce f . IntMap.keys . getKeys + +instance Generator (Keys (Map k v)) where + type Elem (Keys (Map k v)) = k + mapReduce f = mapReduce f . Map.keys . getKeys + +instance Ix i => Generator (Keys (Array i e)) where + type Elem (Keys (Array i e)) = i + mapReduce f = mapReduce f . range . bounds . getKeys + +-- | a 'Generator' transformer that asks only for the values contained in an indexed container +newtype Values c = Values { getValues :: c } + +instance Generator (Values (IntMap v)) where + type Elem (Values (IntMap v)) = v + mapReduce f = mapReduce f . IntMap.elems . getValues + +instance Generator (Values (Map k v)) where + type Elem (Values (Map k v)) = v + mapReduce f = mapReduce f . Map.elems . getValues + +instance Ix i => Generator (Values (Array i e)) where + type Elem (Values (Array i e)) = e + mapReduce f = mapReduce f . elems . getValues + +-- | a 'Generator' transformer that treats 'Word8' as 'Char' +-- This lets you use a 'ByteString' as a 'Char' source without going through a 'Monoid' transformer like 'UTF8' +newtype Char8 c = Char8 { getChar8 :: c } + +instance Generator (Char8 Strict.ByteString) where + type Elem (Char8 Strict.ByteString) = Char + mapTo f m = Strict8.foldl' (\a -> snoc a . f) m . getChar8 + +instance Generator (Char8 Lazy.ByteString) where + type Elem (Char8 Lazy.ByteString) = Char + mapReduce f = fold . parMap rwhnf (mapReduce f . Char8) . Lazy8.toChunks . getChar8 + +{-# SPECIALIZE reduce :: (Word8 `Reducer` m) => Strict.ByteString -> m #-} +{-# SPECIALIZE reduce :: (Word8 `Reducer` m) => Lazy.ByteString -> m #-} +{-# SPECIALIZE reduce :: (Char `Reducer` m) => Char8 Strict.ByteString -> m #-} +{-# SPECIALIZE reduce :: (Char `Reducer` m) => Char8 Lazy.ByteString -> m #-} +{-# SPECIALIZE reduce :: (c `Reducer` m) => [c] -> m #-} +{-# SPECIALIZE reduce :: (Generator (FingerTree v e), e `Reducer` m) => FingerTree v e -> m #-} +{-# SPECIALIZE reduce :: (Char `Reducer` m) => Text -> m #-} +{-# SPECIALIZE reduce :: (e `Reducer` m) => Seq e -> m #-} +{-# SPECIALIZE reduce :: (Int `Reducer` m) => IntSet -> m #-} +{-# SPECIALIZE reduce :: (a `Reducer` m) => Set a -> m #-} +{-# SPECIALIZE reduce :: ((Int,v) `Reducer` m) => IntMap v -> m #-} +{-# SPECIALIZE reduce :: ((k,v) `Reducer` m) => Map k v -> m #-} +{-# SPECIALIZE reduce :: (Int `Reducer` m) => Keys (IntMap v) -> m #-} +{-# SPECIALIZE reduce :: (k `Reducer` m) => Keys (Map k v) -> m #-} +{-# SPECIALIZE reduce :: (v `Reducer` m) => Values (IntMap v) -> m #-} +{-# SPECIALIZE reduce :: (v `Reducer` m) => Values (Map k v) -> m #-} +-- | Apply a 'Reducer' directly to the elements of a 'Generator' +reduce :: (Generator c, Elem c `Reducer` m) => c -> m +reduce = mapReduce id ++ addfile ./doc/html/monoids/src/Data-Monoid-Lexical-RunLengthEncoding.html hunk ./doc/html/monoids/src/Data-Monoid-Lexical-RunLengthEncoding.html 1 + + + + +
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Monoid.Lexical.RunLengthEncoding +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable (MPTCs) +-- +-- A simple 'Monoid' transformer that turns any monoidal 'Reducer' into a +-- a reducer that expects to be supplied both a run length @n@ with each item +-- and which efficiently exponentiates the result of 'unit' @n@ times through +-- 'replicate'. +-- +----------------------------------------------------------------------------- + +module Data.Monoid.Lexical.RunLengthEncoding + ( module Data.Monoid.Reducer + , RLE(RLE,getRLE) + ) where + +import Prelude hiding (replicate) +import Data.Monoid.Reducer +import Data.Monoid.Combinators (replicate) + +newtype RLE n m = RLE { getRLE :: m } + +instance (Integral n, Monoid m) => Monoid (RLE n m) where + mempty = RLE mempty + RLE a `mappend` RLE b = RLE (a `mappend` b) + +instance (Integral n, Reducer c m) => Reducer (n,c) (RLE n m) where + unit ~(n,c) = RLE $ replicate (unit c) n ++ addfile ./doc/html/monoids/src/Data-Monoid-Lexical-SourcePosition.html hunk ./doc/html/monoids/src/Data-Monoid-Lexical-SourcePosition.html 1 + + + + +
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Monoid.Lexical.SourcePosition +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable (MPTCs, OverloadedStrings) +-- +-- Incrementally determine locations in a source file through local information +-- This allows for efficient recomputation of line #s and token locations +-- while the file is being interactively updated by storing this as a supplemental +-- measure on a 'FingerTree'. +-- +-- The general idea is to use this as part of a measure in a 'FingerTree' so you can +-- use `mappend` to prepend a 'startOfFile' with the file information. +----------------------------------------------------------------------------- + +module Data.Monoid.Lexical.SourcePosition + ( module Data.Monoid.Reducer.Char + , nextTab + , SourcePosition + , SourceLine + , SourceColumn + , sourceLine + , sourceColumn + , startOfFile + , showSourcePosition + ) where + +import Prelude hiding (lex) +import Control.Functor.Extras +import Control.Functor.Pointed +import Data.Monoid.Reducer.Char +import Data.Monoid.Generator +import Data.String + +type SourceLine = Int +type SourceColumn = Int + +-- | A 'Monoid' of partial information about locations in a source file. +-- This is polymorphic in the kind of information you want to maintain about each source file. +data SourcePosition file + = Pos file {-# UNPACK #-} !SourceLine !SourceColumn -- ^ An absolute position in a file is known, or an overriding #line directive has been seen + | Lines {-# UNPACK #-} !SourceLine !SourceColumn -- ^ We've seen some carriage returns. + | Columns {-# UNPACK #-} !SourceColumn -- ^ We've only seen part of a line. + | Tab {-# UNPACK #-} !SourceColumn !SourceColumn -- ^ We have an unhandled tab to deal with. + deriving (Read,Show,Eq) + +-- | Compute the location of the next standard 8-column aligned tab +nextTab :: Int -> Int +nextTab x = x + (8 - (x-1) `mod` 8) + +instance Functor SourcePosition where + fmap g (Pos f l c) = Pos (g f) l c + fmap _ (Lines l c) = Lines l c + fmap _ (Columns c) = Columns c + fmap _ (Tab x y) = Tab x y + +instance Pointed SourcePosition where + point f = Pos f 1 1 + +instance FunctorZero SourcePosition where + fzero = mempty + +instance FunctorPlus SourcePosition where + fplus = mappend + +instance IsString (SourcePosition file) where + fromString = reduce + +-- accumulate partial information +instance Monoid (SourcePosition file) where + mempty = Columns 0 + + Pos f l _ `mappend` Lines m d = Pos f (l + m) d + Pos f l c `mappend` Columns d = Pos f l (c + d) + Pos f l c `mappend` Tab x y = Pos f l (nextTab (c + x) + y) + Lines l _ `mappend` Lines m d = Lines (l + m) d + Lines l c `mappend` Columns d = Lines l (c + d) + Lines l c `mappend` Tab x y = Lines l (nextTab (c + x) + y) + Columns c `mappend` Columns d = Columns (c + d) + Columns c `mappend` Tab x y = Tab (c + x) y + Tab _ _ `mappend` Lines m d = Lines m d + Tab x y `mappend` Columns d = Tab x (y + d) + Tab x y `mappend` Tab x' y' = Tab x (nextTab (y + x') + y') + _ `mappend` pos = pos + +instance Reducer Char (SourcePosition file) where + unit '\n' = Lines 1 1 + unit '\t' = Tab 0 0 + unit _ = Columns 1 + +-- Indicate that we ignore invalid characters to the UTF8 parser +instance CharReducer (SourcePosition file) + +-- | lift information about a source file into a starting 'SourcePosition' for that file +startOfFile :: f -> SourcePosition f +startOfFile = point + +-- | extract partial information about the current column, even in the absence of knowledge of the source file +sourceColumn :: SourcePosition f -> Maybe SourceColumn +sourceColumn (Pos _ _ c) = Just c +sourceColumn (Lines _ c) = Just c +sourceColumn _ = Nothing + +-- | extract partial information about the current line number if possible +sourceLine :: SourcePosition f -> Maybe SourceLine +sourceLine (Pos _ l _) = Just l +sourceLine _ = Nothing + +-- | extract the standard format for an absolute source position +showSourcePosition :: SourcePosition String -> String +showSourcePosition pos = showSourcePosition' (point "-" `mappend` pos) where + showSourcePosition' (Pos f l c) = f ++ ":" ++ show l ++ ":" ++ show c + showSourcePosition' _ = undefined ++ addfile ./doc/html/monoids/src/Data-Monoid-Lexical-UTF8-Decoder.html hunk ./doc/html/monoids/src/Data-Monoid-Lexical-UTF8-Decoder.html 1 + + + + +
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Monoid.Lexical.UTF8.Decoder +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable (MPTCs) +-- +-- UTF8 encoded unicode characters can be parsed both forwards and backwards, +-- since the start of each 'Char' is clearly marked. This 'Monoid' accumulates +-- information about the characters represented and reduces that information +-- using a 'CharReducer', which is just a 'Reducer' 'Monoid' that knows what +-- it wants to do about an 'invalidChar' -- a string of 'Word8' values that +-- don't form a valid UTF8 character. +-- +-- As this monoid parses chars it just feeds them upstream to the underlying +-- CharReducer. Efficient left-to-right and right-to-left traversals are +-- supplied so that a lazy 'ByteString' can be parsed efficiently by +-- chunking it into strict chunks, and batching the traversals over each +-- before stitching the edges together. +-- +-- Because this needs to be a 'Monoid' and should return the exact same result +-- regardless of forward or backwards parsing, it chooses to parse only +-- canonical UTF8 unlike most Haskell UTF8 parsers, which will blissfully +-- accept illegal alternative long encodings of a character. +-- +-- This actually fixes a potential class of security issues in some scenarios: +-- +-- <http://prowebdevelopmentblog.com/content/big-overhaul-java-utf-8-charset> +-- +-- NB: Due to naive use of a list to track the tail of an unfinished character +-- this may exhibit @O(n^2)@ behavior parsing backwards along an invalid sequence +-- of a large number of bytes that all claim to be in the tail of a character. +-- +----------------------------------------------------------------------------- + + +module Data.Monoid.Lexical.UTF8.Decoder + ( module Data.Monoid.Reducer.Char + , UTF8 + , runUTF8 + ) where + +import Data.Bits (shiftL,(.&.),(.|.)) +import Data.Word (Word8) + + +import Control.Functor.Pointed + +import Data.Monoid.Reducer.Char + +-- Incrementally reduce canonical RFC3629 UTF-8 Characters + +-- utf8 characters are at most 4 characters long, so we need only retain state for 3 of them +-- moreover their length is able to be determined a priori, so lets store that intrinsically in the constructor +data H = H0 + | H2_1 {-# UNPACK #-} !Word8 + | H3_1 {-# UNPACK #-} !Word8 + | H3_2 {-# UNPACK #-} !Word8 !Word8 + | H4_1 {-# UNPACK #-} !Word8 + | H4_2 {-# UNPACK #-} !Word8 !Word8 + | H4_3 {-# UNPACK #-} !Word8 !Word8 !Word8 + +-- words expressing the tail of a character, each between 0x80 and 0xbf +-- this is arbitrary length to simplify making the parser truly monoidal +-- this probably means we have O(n^2) worst case performance in the face of very long runs of chars that look like 10xxxxxx +type T = [Word8] + +-- S is a segment that contains a possible tail of a character, the result of reducing some full characters, and the start of another character +-- T contains a list of bytes each between 0x80 and 0xbf +data UTF8 m = S T m !H + | T T + +-- flush any extra characters in a head, when the next character isn't between 0x80 and 0xbf +flushH :: CharReducer m => H -> m +flushH (H0) = mempty +flushH (H2_1 x) = invalidChar [x] +flushH (H3_1 x) = invalidChar [x] +flushH (H3_2 x y) = invalidChar [x,y] +flushH (H4_1 x) = invalidChar [x] +flushH (H4_2 x y) = invalidChar [x,y] +flushH (H4_3 x y z) = invalidChar [x,y,z] + +-- flush a character tail +flushT :: CharReducer m => [Word8] -> m +flushT = invalidChar + +snocH :: CharReducer m => H -> Word8 -> (m -> H -> UTF8 m) -> m -> UTF8 m +snocH H0 c k m + | c < 0x80 = k (m `mappend` b1 c) H0 + | c < 0xc0 = k (m `mappend` invalidChar [c]) H0 + | c < 0xe0 = k m (H2_1 c) + | c < 0xf0 = k m (H3_1 c) + | c < 0xf5 = k m (H4_1 c) + | otherwise = k (m `mappend` invalidChar [c]) H0 +snocH (H2_1 c) d k m + | d >= 0x80 && d < 0xc0 = k (m `mappend` b2 c d) H0 + | otherwise = k (m `mappend` invalidChar [c]) H0 +snocH (H3_1 c) d k m + | d >= 0x80 && d < 0xc0 = k m (H3_2 c d) + | otherwise = k (m `mappend` invalidChar [c]) H0 +snocH (H3_2 c d) e k m + | d >= 0x80 && d < 0xc0 = k (m `mappend` b3 c d e) H0 + | otherwise = k (m `mappend` invalidChar [c,d]) H0 +snocH (H4_1 c) d k m + | d >= 0x80 && d < 0xc0 = k m (H4_2 c d) + | otherwise = k (m `mappend` invalidChar [c,d]) H0 +snocH (H4_2 c d) e k m + | d >= 0x80 && d < 0xc0 = k m (H4_3 c d e) + | otherwise = k (m `mappend` invalidChar [c,d,e]) H0 +snocH (H4_3 c d e) f k m + | d >= 0x80 && d < 0xc0 = k (m `mappend` b4 c d e f) H0 + | otherwise = k (m `mappend` invalidChar [c,d,e,f]) H0 + +mask :: Word8 -> Word8 -> Int +mask c m = fromEnum (c .&. m) + +combine :: Int -> Word8 -> Int +combine a r = shiftL a 6 .|. fromEnum (r .&. 0x3f) + +b1 :: CharReducer m => Word8 -> m +b1 c | c < 0x80 = fromChar . toEnum $ fromEnum c + | otherwise = invalidChar [c] + +b2 :: CharReducer m => Word8 -> Word8 -> m +b2 c d | valid_b2 c d = fromChar (toEnum (combine (mask c 0x1f) d)) + | otherwise = invalidChar [c,d] + +b3 :: CharReducer m => Word8 -> Word8 -> Word8 -> m +b3 c d e | valid_b3 c d e = fromChar (toEnum (combine (combine (mask c 0x0f) d) e)) + | otherwise = invalidChar [c,d,e] + + +b4 :: CharReducer m => Word8 -> Word8 -> Word8 -> Word8 -> m +b4 c d e f | valid_b4 c d e f = fromChar (toEnum (combine (combine (combine (mask c 0x07) d) e) f)) + | otherwise = invalidChar [c,d,e,f] + +valid_b2 :: Word8 -> Word8 -> Bool +valid_b2 c d = (c >= 0xc2 && c <= 0xdf && d >= 0x80 && d <= 0xbf) + +valid_b3 :: Word8 -> Word8 -> Word8 -> Bool +valid_b3 c d e = (c == 0xe0 && d >= 0xa0 && d <= 0xbf && e >= 0x80 && e <= 0xbf) || + (c >= 0xe1 && c <= 0xef && d >= 0x80 && d <= 0xbf && e >= 0x80 && e <= 0xbf) + +valid_b4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool +valid_b4 c d e f = (c == 0xf0 && d >= 0x90 && d <= 0xbf && e >= 0x80 && e <= 0xbf && f >= 0x80 && f <= 0xbf) || + (c >= 0xf1 && c <= 0xf3 && d >= 0x80 && d <= 0xbf && e >= 0x80 && e <= 0xbf && f >= 0x80 && f <= 0xbf) || + (c == 0xf4 && d >= 0x80 && d <= 0x8f && e >= 0x80 && e <= 0xbf && f >= 0x80 && f <= 0xbf) + +consT :: CharReducer m => Word8 -> T -> (H -> UTF8 m) -> (m -> UTF8 m) -> (T -> UTF8 m) -> UTF8 m +consT c cs h m t + | c < 0x80 = m $ b1 c `mappend` invalidChars cs + | c < 0xc0 = t (c:cs) + | c < 0xe0 = case cs of + [] -> h $ H2_1 c + (d:ds) -> m $ b2 c d `mappend` invalidChars ds + | c < 0xf0 = case cs of + [] -> h $ H3_1 c + [d] -> h $ H3_2 c d + (d:e:es) -> m $ b3 c d e `mappend` invalidChars es + | c < 0xf5 = case cs of + [] -> h $ H4_1 c + [d] -> h $ H4_2 c d + [d,e] -> h $ H4_3 c d e + (d:e:f:fs) -> m $ b4 c d e f `mappend` invalidChars fs + | otherwise = mempty + +invalidChars :: CharReducer m => [Word8] -> m +invalidChars = foldr (mappend . invalidChar . return) mempty + +merge :: CharReducer m => H -> T -> (m -> a) -> (H -> a) -> a +merge H0 cs k _ = k $ invalidChars cs +merge (H2_1 c) [] _ p = p $ H2_1 c +merge (H2_1 c) (d:ds) k _ = k $ b2 c d `mappend` invalidChars ds +merge (H3_1 c) [] _ p = p $ H3_1 c +merge (H3_1 c) [d] _ p = p $ H3_2 c d +merge (H3_1 c) (d:e:es) k _ = k $ b3 c d e `mappend` invalidChars es +merge (H3_2 c d) [] _ p = p $ H3_2 c d +merge (H3_2 c d) (e:es) k _ = k $ b3 c d e `mappend` invalidChars es +merge (H4_1 c) [] _ p = p $ H4_1 c +merge (H4_1 c) [d] _ p = p $ H4_2 c d +merge (H4_1 c) [d,e] _ p = p $ H4_3 c d e +merge (H4_1 c) (d:e:f:fs) k _ = k $ b4 c d e f `mappend` invalidChars fs +merge (H4_2 c d) [] _ p = p $ H4_2 c d +merge (H4_2 c d) [e] _ p = p $ H4_3 c d e +merge (H4_2 c d) (e:f:fs) k _ = k $ b4 c d e f `mappend` invalidChars fs +merge (H4_3 c d e) [] _ p = p $ H4_3 c d e +merge (H4_3 c d e) (f:fs) k _ = k $ b4 c d e f `mappend` invalidChars fs + +instance CharReducer m => Monoid (UTF8 m) where + mempty = T [] + T c `mappend` T d = T (c ++ d) + T c `mappend` S l m r = S (c ++ l) m r + S l m c `mappend` S c' m' r = S l (m `mappend` merge c c' id flushH `mappend` m') r + s@(S _ _ _) `mappend` T [] = s + S l m c `mappend` T c' = merge c c' k (S l m) where + k m' = S l (m `mappend` m') H0 + +instance CharReducer m => Reducer Word8 (UTF8 m) where + unit c | c >= 0x80 && c < 0xc0 = T [c] + | otherwise = snocH H0 c (S []) mempty + S t m h `snoc` c = snocH h c (S t) m + T t `snoc` c | c >= 0x80 && c < 0xc0 = T (t ++ [c]) + | otherwise = snocH H0 c (S t) mempty + + c `cons` T cs = consT c cs (S [] mempty) (flip (S []) H0) T + c `cons` S cs m h = consT c cs k1 k2 k3 where + k1 h' = S [] (flushH h' `mappend` m) h + k2 m' = S [] (m' `mappend` m) h + k3 t' = S t' m h + +instance Functor UTF8 where + fmap f (S t x h) = S t (f x) h + fmap _ (T t) = T t + +instance Pointed UTF8 where + point f = S [] f H0 + +runUTF8 :: CharReducer m => UTF8 m -> m +runUTF8 (T t) = flushT t +runUTF8 (S t m h) = flushT t `mappend` m `mappend` flushH h ++ addfile ./doc/html/monoids/src/Data-Monoid-Lexical-Words.html hunk ./doc/html/monoids/src/Data-Monoid-Lexical-Words.html 1 + + + + +
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, GeneralizedNewtypeDeriving, ParallelListComp, TypeFamilies, OverloadedStrings, UndecidableInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Monoid.Lexical.Words +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable (MPTCs, OverloadedStrings) +-- +-- A simple demonstration of tokenizing a 'Generator' into distinct words +-- and/or lines using a word-parsing 'Monoid' that accumulates partial +-- information about words and then builds up a token stream. +-- +----------------------------------------------------------------------------- + +module Data.Monoid.Lexical.Words + ( module Data.Monoid.Reducer.Char + -- * Words + , Words + , runWords + , Unspaced(runUnspaced) + , wordsFrom + -- * Lines + , Lines + , runLines + , Unlined(runUnlined) + , linesFrom + ) where + +import Data.String +import Data.Char (isSpace) +import Data.Maybe (maybeToList) +import Data.Monoid.Reducer.Char +import Data.Monoid.Generator +import Control.Functor.Pointed + +-- | A 'CharReducer' transformer that breaks a 'Char' 'Generator' into distinct words, feeding a 'Char' 'Reducer' each line in turn +data Words m = Chunk (Maybe m) + | Segment (Maybe m) [m] (Maybe m) + deriving (Show,Read) + +-- | Extract the matched words from the 'Words' 'Monoid' +runWords :: Words m -> [m] +runWords (Chunk m) = maybeToList m +runWords (Segment l m r) = maybeToList l ++ m ++ maybeToList r + +instance Monoid m => Monoid (Words m) where + mempty = Chunk mempty + Chunk l `mappend` Chunk r = Chunk (l `mappend` r) + Chunk l `mappend` Segment l' m r = Segment (l `mappend` l') m r + Segment l m r `mappend` Chunk r' = Segment l m (r `mappend` r') + Segment l m r `mappend` Segment l' m' r' = Segment l (m ++ maybeToList (r `mappend` l') ++ m') r' + +instance Reducer Char m => Reducer Char (Words m) where + unit c | isSpace c = Segment (Just (unit c)) [] mempty + | otherwise = Chunk (Just (unit c)) + +instance Functor Words where + fmap f (Chunk m) = Chunk (fmap f m) + fmap f (Segment m ms m') = Segment (fmap f m) (fmap f ms) (fmap f m') + +instance (CharReducer m) => CharReducer (Words m) where + invalidChar xs = Segment (Just (invalidChar xs)) [] mempty + +instance Reducer Char m => IsString (Words m) where + fromString = reduce + +-- | A 'CharReducer' transformer that breaks a 'Char' 'Generator' into distinct lines, feeding a 'Char' 'Reducer' each line in turn. +newtype Lines m = Lines (Words m) deriving (Show,Read,Monoid,Functor) + +instance Reducer Char m => Reducer Char (Lines m) where + unit '\n' = Lines $ Segment (Just (unit '\n')) [] mempty + unit c = Lines $ Chunk (Just (unit c)) + +instance (CharReducer m) => CharReducer (Lines m) where + invalidChar xs = Lines $ Segment (Just (invalidChar xs)) [] mempty + +instance Reducer Char m => IsString (Lines m) where + fromString = reduce + +-- | Extract the matched lines from the 'Lines' 'Monoid' +runLines :: Lines m -> [m] +runLines (Lines x) = runWords x + +-- | A 'CharReducer' transformer that strips out any character matched by `isSpace` +newtype Unspaced m = Unspaced { runUnspaced :: m } deriving (Eq,Ord,Show,Read,Monoid) + +instance Reducer Char m => Reducer Char (Unspaced m) where + unit c | isSpace c = mempty + | otherwise = Unspaced (unit c) + +instance CharReducer m => CharReducer (Unspaced m) where + invalidChar = Unspaced . invalidChar + +instance Functor Unspaced where + fmap f (Unspaced x) = Unspaced (f x) + +instance Pointed Unspaced where + point = Unspaced + +instance Copointed Unspaced where + extract = runUnspaced + +instance Reducer Char m => IsString (Unspaced m) where + fromString = reduce + +-- | A 'CharReducer' transformer that strips out newlines +newtype Unlined m = Unlined { runUnlined :: m } deriving (Eq,Ord,Show,Read,Monoid) + +instance Reducer Char m => Reducer Char (Unlined m) where + unit '\n' = mempty + unit c = Unlined (unit c) + +instance CharReducer m => CharReducer (Unlined m) where + invalidChar = Unlined . invalidChar + +instance Functor Unlined where + fmap f (Unlined x) = Unlined (f x) + +instance Pointed Unlined where + point = Unlined + +instance Copointed Unlined where + extract = runUnlined + +instance Reducer Char m => IsString (Unlined m) where + fromString = reduce + +-- | Utility function to extract words using accumulator, inside-word, and until-next-word monoids +wordsFrom :: (Generator c, Elem c ~ Char, Char `Reducer` m, Char `Reducer` n, Char `Reducer` o) => m -> c -> [(m,n,o)] +wordsFrom s c = [(x,runUnlined y,z) | x <- scanl mappend s ls | (y,z) <- rs ] where + (ls,rs) = unzip (runWords (mapReduce id c)) + +-- | Utility function to extract lines using accumulator, inside-line, and until-next-line monoids +linesFrom :: (Generator c, Elem c ~ Char, Char `Reducer` m, Char `Reducer` n, Char `Reducer` o) => m -> c -> [(m,n,o)] +linesFrom s c = [(x,runUnlined y,z) | x <- scanl mappend s ls | (y,z) <- rs ] where + (ls,rs) = unzip (runLines (mapReduce id c)) ++ addfile ./doc/html/monoids/src/Data-Monoid-Monad.html hunk ./doc/html/monoids/src/Data-Monoid-Monad.html 1 + + + + +
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts, TypeOperators #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Monoid.Applicative +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable (MPTCs) +-- +-- 'Monoid' instances for working with a 'Monad' +-- +----------------------------------------------------------------------------- + +module Data.Monoid.Monad + ( module Data.Monoid.Reducer + , module Data.Ring.Semi.Near + -- * Actions + , Action(Action,getAction) + , snocAction + -- * Lifting Modules + , ActionWith(ActionWith,getActionWith) + -- * Wrapped Monads + , WrappedMonad(WrappedMonad, getWrappedMonad) + ) where + +import Control.Functor.Pointed +import Data.Monoid.Reducer +import Data.Ring.Semi.Near +import Data.Ring.Module +import Control.Monad + +-- | An 'Action' uses glues together 'Monad' actions with (>>) +-- in the manner of 'mapM_' from "Data.Foldable". Any values returned by +-- reduced actions are discarded. +newtype Action m = Action { getAction :: m () } + +instance Monad m => Monoid (Action m) where + mempty = Action (return ()) + Action a `mappend` Action b = Action (a >> b) + +instance Monad m => Reducer (m a) (Action m) where + unit a = Action (a >> return ()) + a `cons` Action b = Action (a >> b) + Action a `snoc` b = Action (a >> b >> return ()) + +{-# RULES "unitAction" unit = Action #-} +{-# RULES "snocAction" snoc = snocAction #-} + +-- | Efficiently avoid needlessly rebinding when using 'snoc' on an action that already returns () +-- A rewrite rule automatically applies this when possible +snocAction :: Reducer (m ()) (Action m) => Action m -> m () -> Action m +snocAction a = mappend a . Action + +-- | A 'WrappedMonad' turns any 'MonadPlus' instance into a 'Monoid'. +-- It also provides a 'Multiplicative' instance for a 'Monad' wrapped around a 'Monoid' +-- and asserts that any 'MonadPlus' applied to a 'Monoid' forms a 'LeftSemiNearRing' +-- under these operations. + +newtype WrappedMonad m a = WrappedMonad { getWrappedMonad :: m a } + deriving (Eq,Ord,Show,Read,Functor,Pointed, Monad,MonadPlus) + +instance (Monad m, Monoid a) => Multiplicative (WrappedMonad m a) where + one = WrappedMonad (return mempty) + WrappedMonad m `times` WrappedMonad n = WrappedMonad (liftM2 mappend m n) + +instance (MonadPlus m) => Monoid (WrappedMonad m a) where + mempty = mzero + mappend = mplus + +instance (MonadPlus m, c `Reducer` a) => Reducer c (WrappedMonad m a) where + unit = WrappedMonad . return . unit + +instance (MonadPlus m, Monoid a) => LeftSemiNearRing (WrappedMonad m a) + +-- | if @m@ is a 'Module' over @r@ and @f@ is a 'Monad' then @f `ActionWith` m@ is a 'Module' as well + +newtype ActionWith f m = ActionWith { getActionWith :: f m } + deriving (Eq,Ord,Show,Read,Functor,Pointed, Monad,MonadPlus) + +instance (Monoid m, Monad f) => Monoid (f `ActionWith` m) where + mempty = return mempty + mappend = liftM2 mappend + +instance (Group m, Monad f) => Group (f `ActionWith` m) where + gnegate = liftM gnegate + minus = liftM2 minus + gsubtract = liftM2 gsubtract + +instance (c `Reducer` m, Monad f) => Reducer c (f `ActionWith` m) where + unit = return . unit + +instance (LeftModule r m, Monad f) => LeftModule r (f `ActionWith` m) where + x *. m = liftM (x *.) m + +instance (RightModule r m, Monad f) => RightModule r (f `ActionWith` m) where + m .* y = liftM (.* y) m + +instance (Module r m, Monad f) => Module r (f `ActionWith` m) ++ addfile ./doc/html/monoids/src/Data-Monoid-Multiplicative-Sugar.html hunk ./doc/html/monoids/src/Data-Monoid-Multiplicative-Sugar.html 1 + + + + +
----------------------------------------------------------------------------- +-- | +-- Module : Data.Monoid.Multiplicative.Sugar +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : portable +-- +-- Syntactic sugar for working with a 'Multiplicative' monoids that conflicts with names from the "Prelude". +-- +-- > import Prelude hiding ((+),(*)) +-- > import Data.Monoid.Multiplicative.Sugar +-- +----------------------------------------------------------------------------- + +module Data.Monoid.Multiplicative.Sugar + ( module Data.Monoid.Additive.Sugar + , module Data.Monoid.Multiplicative + , (*) + ) where + +import Data.Monoid.Additive.Sugar +import Data.Monoid.Multiplicative +import Prelude hiding ((*)) + +infixl 7 * + +(*) :: Multiplicative r => r -> r -> r +(*) = times ++ addfile ./doc/html/monoids/src/Data-Monoid-Multiplicative.html hunk ./doc/html/monoids/src/Data-Monoid-Multiplicative.html 1 + + + + +
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Monoid.Multiplicative +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : portable (but instances use MPTCs) +-- +-- When dealing with a 'Ring' or other structure, you often need a pair of +-- 'Monoid' instances that are closely related. Making a @newtype@ for one +-- is unsatisfying and yields an unnatural programming style. +-- +-- A 'Multiplicative' is a 'Monoid' that is intended for use in a scenario +-- that can be extended to have another 'Monoid' slot in for addition. This +-- enables one to use common notation. +-- +-- Any 'Multiplicative' can be turned into a 'Monoid' using the 'Log' wrapper. +-- +-- Any 'Monoid' can be turned into a 'Multiplicative' using the 'Exp' wrapper. +-- +-- Instances are supplied for common Monads of Monoids, in a fashion +-- which can be extended if the 'Monad' is a 'MonadPlus' to yield a 'LeftSemiNearRing' +-- +-- Instances are also supplied for common Applicatives of Monoids, in a +-- fashion which can be extended if the 'Applicative' is 'Alternative' to +-- yield a 'LeftSemiNearRing' +----------------------------------------------------------------------------- + +module Data.Monoid.Multiplicative + ( module Data.Monoid.Additive + -- * Multiplicative Monoids + , Multiplicative + , one, times + -- * Multiplicative to Monoid + , Log(Log, getLog) + -- * Monoid to Multiplicative + , Exp(Exp, getExp) + ) where + +import Control.Applicative + +import Control.Concurrent.STM + +import Control.Monad.Cont +import Control.Monad.Identity + +import Control.Monad.Reader + +import qualified Control.Monad.RWS.Lazy as LRWS +import qualified Control.Monad.RWS.Strict as SRWS + +import qualified Control.Monad.State.Lazy as LState +import qualified Control.Monad.State.Strict as SState + +import qualified Control.Monad.Writer.Lazy as LWriter +import qualified Control.Monad.Writer.Strict as SWriter + +import qualified Control.Monad.ST.Lazy as LST +import qualified Control.Monad.ST.Strict as SST + +import Data.FingerTree + +import Data.Monoid.Additive +import Data.Monoid.FromString +import Data.Monoid.Generator +import Data.Monoid.Instances () +import Data.Monoid.Self + +import Data.Ratio + +import qualified Data.Sequence as Seq +import Data.Sequence (Seq) + +import Text.Parsec.Prim + +class Multiplicative m where + one :: m + times :: m -> m -> m + +-- | Convert a 'Multiplicative' into a 'Monoid'. Mnemonic: @Log a + Log b = Log (a * b)@ +data Log m = Log { getLog :: m } + +instance Multiplicative m => Monoid (Log m) where + mempty = Log one + Log a `mappend` Log b = Log (a `times` b) + +-- | Convert a 'Monoid' into a 'Multiplicative'. Mnemonic: @Exp a * Exp b = Exp (a + b)@ +data Exp m = Exp { getExp :: m } + +instance Monoid m => Multiplicative (Exp m) where + one = Exp mempty + Exp a `times` Exp b = Exp (a `mappend` b) + +-- simple monoid transformer instances +instance Multiplicative m => Multiplicative (Self m) where + one = Self one + Self a `times` Self b = Self (a `times` b) + +instance Multiplicative m => Multiplicative (FromString m) where + one = FromString one + FromString a `times` FromString b = FromString (a `times` b) + +-- the goal of this is that I can make left seminearrings out of any 'Alternative' wrapped around a monoid +-- in particular its useful for containers + +instance Monoid m => Multiplicative [m] where + one = return mempty + times = liftM2 mappend + +instance Monoid m => Multiplicative (Seq m) where + one = return mempty + times = liftM2 mappend + +-- and things that can't quite be a Monad in Haskell +instance (Measured v m, Monoid m) => Multiplicative (FingerTree v m) where + one = singleton mempty + xss `times` yss = getSelf $ mapReduce (flip fmap' yss . mappend) xss + +-- but it can at least serve as a canonical multiplication for any monad. +instance Monoid m => Multiplicative (Maybe m) where + one = return mempty + times = liftM2 mappend + +instance Monoid m => Multiplicative (Identity m) where + one = return mempty + times = liftM2 mappend + +instance (Monoid m) => Multiplicative (Cont r m) where + one = return mempty + times = liftM2 mappend + +instance (Monoid w, Monoid m) => Multiplicative (SRWS.RWS r w s m) where + one = return mempty + times = liftM2 mappend + +instance (Monoid w, Monoid m) => Multiplicative (LRWS.RWS r w s m) where + one = return mempty + times = liftM2 mappend + +instance Monoid m => Multiplicative (SState.State s m) where + one = return mempty + times = liftM2 mappend + +instance Monoid m => Multiplicative (LState.State s m) where + one = return mempty + times = liftM2 mappend + +instance Monoid m => Multiplicative (Reader e m) where + one = return mempty + times = liftM2 mappend + +instance (Monoid w, Monoid m) => Multiplicative (SWriter.Writer w m) where + one = return mempty + times = liftM2 mappend + +instance (Monoid w, Monoid m) => Multiplicative (LWriter.Writer w m) where + one = return mempty + times = liftM2 mappend + +instance (Monad m, Monoid n) => Multiplicative (ContT r m n) where + one = return mempty + times = liftM2 mappend + +instance (Monad m, Monoid w, Monoid n) => Multiplicative (SRWS.RWST r w s m n) where + one = return mempty + times = liftM2 mappend + +instance (Monad m, Monoid w, Monoid n) => Multiplicative (LRWS.RWST r w s m n) where + one = return mempty + times = liftM2 mappend + +instance (Monad m, Monoid n) => Multiplicative (SState.StateT s m n) where + one = return mempty + times = liftM2 mappend + +instance (Monad m, Monoid n) => Multiplicative (LState.StateT s m n) where + one = return mempty + times = liftM2 mappend + +instance (Monad m, Monoid n) => Multiplicative (ReaderT e m n) where + one = return mempty + times = liftM2 mappend + +instance (Monad m, Monoid w, Monoid n) => Multiplicative (SWriter.WriterT w m n) where + one = return mempty + times = liftM2 mappend + +instance (Monad m, Monoid w, Monoid n) => Multiplicative (LWriter.WriterT w m n) where + one = return mempty + times = liftM2 mappend + +instance Monoid n => Multiplicative (IO n) where + one = return mempty + times = liftM2 mappend + +instance Monoid n => Multiplicative (SST.ST s n) where + one = return mempty + times = liftM2 mappend + +instance Monoid n => Multiplicative (LST.ST s n) where + one = return mempty + times = liftM2 mappend + +instance Monoid n => Multiplicative (STM n) where + one = return mempty + times = liftM2 mappend + +instance (Stream s m t, Monoid n) => Multiplicative (ParsecT s u m n) where + one = return mempty + times = liftM2 mappend + +-- Applicative instances + +instance Monoid n => Multiplicative (ZipList n) where + one = pure mempty + times = liftA2 mappend + +instance Monoid m => Multiplicative (Const m a) where + one = pure undefined + times = liftA2 undefined + + +-- Numeric instances + +instance Multiplicative Int where + one = 1 + times = (*) + + +instance Multiplicative Integer where + one = 1 + times = (*) + +instance Integral m => Multiplicative (Ratio m) where + one = 1 + times = (*) + ++ addfile ./doc/html/monoids/src/Data-Monoid-Ord.html hunk ./doc/html/monoids/src/Data-Monoid-Ord.html 1 + + + + +
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +----------------------------------------------------------------------------- +---- | +---- Module : Data.Monoid.Ord +---- Copyright : (c) Edward Kmett 2009 +---- License : BSD-style +---- Maintainer : libraries@haskell.org +---- Stability : experimental +---- Portability : portable +---- +---- Some 'Monoid' instances that should probably be in "Data.Monoid". +---- +----------------------------------------------------------------------------- + +module Data.Monoid.Ord + ( module Data.Monoid.Reducer + -- * Max + , Max(Max,getMax) + -- * Min + , Min(Min,getMin) + -- * MaxPriority: Max semigroup w/ added bottom + , MaxPriority(MaxPriority,getMaxPriority) + , minfinity + -- * MinPriority: Min semigroup w/ added top + , MinPriority(MinPriority,getMinPriority) + , infinity + ) where + +import Control.Functor.Pointed +import Data.Monoid.Reducer (Reducer, unit, Monoid, mappend, mempty) +import Data.Ring.Semi + +-- | The 'Monoid' @('max','minBound')@ +newtype Max a = Max { getMax :: a } deriving (Eq,Ord,Show,Read,Bounded) + +instance (Ord a, Bounded a) => Monoid (Max a) where + mempty = Max minBound + mappend = max + +instance (Ord a, Bounded a) => Reducer a (Max a) where + unit = Max + +instance Functor Max where + fmap f (Max a) = Max (f a) + +instance Pointed Max where + point = Max + +instance Copointed Max where + extract = getMax + +-- | The 'Monoid' given by @('min','maxBound')@ +newtype Min a = Min { getMin :: a } deriving (Eq,Ord,Show,Read,Bounded) + +instance (Ord a, Bounded a) => Monoid (Min a) where + mempty = Min maxBound + mappend = min + +instance (Ord a, Bounded a) => Reducer a (Min a) where + unit = Min + +instance Functor Min where + fmap f (Min a) = Min (f a) + +instance Pointed Min where + point = Min + +instance Copointed Min where + extract = getMin + +minfinity :: MaxPriority a +minfinity = MaxPriority Nothing + +-- | The 'Monoid' @('max','Nothing')@ over @'Maybe' a@ where 'Nothing' is the bottom element +newtype MaxPriority a = MaxPriority { getMaxPriority :: Maybe a } deriving (Eq,Ord,Show,Read) + +instance Ord a => Monoid (MaxPriority a) where + mempty = MaxPriority Nothing + mappend = max + +instance Ord a => Reducer (Maybe a) (MaxPriority a) where + unit = MaxPriority + +instance Functor MaxPriority where + fmap f (MaxPriority a) = MaxPriority (fmap f a) + +instance Pointed MaxPriority where + point = MaxPriority . Just + +infinity :: MinPriority a +infinity = MinPriority Nothing + +-- | The 'Monoid' @('min','Nothing')@ over @'Maybe' a@ where 'Nothing' is the top element +newtype MinPriority a = MinPriority { getMinPriority :: Maybe a } deriving (Eq,Show,Read) + +instance Ord a => Ord (MinPriority a) where + MinPriority Nothing `compare` MinPriority Nothing = EQ + MinPriority Nothing `compare` _ = GT + _ `compare` MinPriority Nothing = LT + MinPriority (Just a) `compare` MinPriority (Just b) = a `compare` b + +instance Ord a => Monoid (MinPriority a) where + mempty = MinPriority Nothing + mappend = min + +instance Ord a => Reducer (Maybe a) (MinPriority a) where + unit = MinPriority + +instance Functor MinPriority where + fmap f (MinPriority a) = MinPriority (fmap f a) + +instance Pointed MinPriority where + point = MinPriority . Just ++ addfile ./doc/html/monoids/src/Data-Monoid-Reducer-Char.html hunk ./doc/html/monoids/src/Data-Monoid-Reducer-Char.html 1 + + + + +
{-# LANGUAGE UndecidableInstances, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Monoid.Reducer.Char +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable (MPTCs) +-- +----------------------------------------------------------------------------- + +module Data.Monoid.Reducer.Char + ( module Data.Monoid.Reducer + , CharReducer + , invalidChar + , fromChar + ) where + +import Data.Monoid.Reducer +import Data.Word (Word8) + +-- | Provides a mechanism for the UTF8 'Monoid' to report invalid characters to one or more monoids. + +class Reducer Char m => CharReducer m where + fromChar :: Char -> m + fromChar = unit + + invalidChar :: [Word8] -> m + invalidChar = const mempty + +instance (CharReducer m, CharReducer m') => CharReducer (m,m') where + invalidChar bs = (invalidChar bs, invalidChar bs) + +instance (CharReducer m, CharReducer m', CharReducer m'') => CharReducer (m,m',m'') where + invalidChar bs = (invalidChar bs, invalidChar bs, invalidChar bs) + +instance (CharReducer m, CharReducer m', CharReducer m'', CharReducer m''') => CharReducer (m,m',m'',m''') where + invalidChar bs = (invalidChar bs, invalidChar bs, invalidChar bs, invalidChar bs) + +instance CharReducer [Char] ++ addfile ./doc/html/monoids/src/Data-Monoid-Reducer-With.html hunk ./doc/html/monoids/src/Data-Monoid-Reducer-With.html 1 + + + + +
{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Monoid.Reducer.With +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable (MPTCs) +-- +----------------------------------------------------------------------------- + +module Data.Monoid.Reducer.With + ( module Data.Monoid.Reducer + , WithReducer(WithReducer,withoutReducer) + ) where + +import Data.Monoid.Reducer +import Data.FingerTree + +-- | If @m@ is a @c@-"Reducer", then m is @(c `WithReducer` m)@-"Reducer" +-- This can be used to quickly select a "Reducer" for use as a 'FingerTree' +-- 'measure'. + +newtype WithReducer c m = WithReducer { withoutReducer :: c } + +instance (c `Reducer` m) => Reducer (c `WithReducer` m) m where + unit = unit . withoutReducer + +instance (c `Reducer` m) => Measured m (c `WithReducer` m) where + measure = unit . withoutReducer ++ addfile ./doc/html/monoids/src/Data-Monoid-Reducer.html hunk ./doc/html/monoids/src/Data-Monoid-Reducer.html 1 + + + + +
{-# LANGUAGE UndecidableInstances , FlexibleContexts , MultiParamTypeClasses , FlexibleInstances , GeneralizedNewtypeDeriving #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Monoid.Reducer +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable (MPTCs) +-- +-- A @c@-'Reducer' is a 'Monoid' with a canonical mapping from @c@ to the Monoid. +-- This 'unit' acts in many ways like 'return' for a 'Monad' but is limited +-- to a single type. +-- +----------------------------------------------------------------------------- + +module Data.Monoid.Reducer + ( module Data.Monoid + , Reducer + , unit, snoc, cons + , foldMapReduce + , foldReduce + , pureUnit + , returnUnit + ) where + +import Control.Applicative +import Control.Monad + +import Data.Monoid +import Data.Monoid.Instances () + +import Data.Foldable +import Data.FingerTree + +import qualified Data.Sequence as Seq +import Data.Sequence (Seq) + +import qualified Data.Set as Set +import Data.Set (Set) + +import qualified Data.IntSet as IntSet +import Data.IntSet (IntSet) + +import qualified Data.IntMap as IntMap +import Data.IntMap (IntMap) + +import qualified Data.Map as Map + +import Data.Map (Map) + +import Text.Parsec.Prim + +--import qualified Data.BitSet as BitSet +--import Data.BitSet (BitSet) + +-- | This type may be best read infix. A @c `Reducer` m@ is a 'Monoid' @m@ that maps +-- values of type @c@ through @unit@ to values of type @m@. A @c@-'Reducer' may also +-- supply operations which tack-on another @c@ to an existing 'Monoid' @m@ on the left +-- or right. These specialized reductions may be more efficient in some scenarios +-- and are used when appropriate by a 'Generator'. The names 'cons' and 'snoc' work +-- by analogy to the synonymous operations in the list monoid. +-- +-- This class deliberately avoids functional-dependencies, so that () can be a @c@-Reducer +-- for all @c@, and so many common reducers can work over multiple types, for instance, +-- First and Last may reduce both @a@ and 'Maybe' @a@. Since a 'Generator' has a fixed element +-- type, the input to the reducer is generally known and extracting from the monoid usually +-- is sufficient to fix the result type. Combinators are available for most scenarios where +-- this is not the case, and the few remaining cases can be handled by using an explicit +-- type annotation. +-- +-- Minimal definition: 'unit' or 'snoc' +class Monoid m => Reducer c m where + -- | Convert a value into a 'Monoid' + unit :: c -> m + -- | Append a value to a 'Monoid' for use in left-to-right reduction + snoc :: m -> c -> m + -- | Prepend a value onto a 'Monoid' for use during right-to-left reduction + cons :: c -> m -> m + + unit = snoc mempty + snoc m = mappend m . unit + cons = mappend . unit + +-- | Apply a 'Reducer' to a 'Foldable' container, after mapping the contents into a suitable form for reduction. +foldMapReduce :: (Foldable f, e `Reducer` m) => (a -> e) -> f a -> m +foldMapReduce f = foldMap (unit . f) + +-- | Apply a 'Reducer' to a 'Foldable' mapping each element through 'unit' +foldReduce :: (Foldable f, e `Reducer` m) => f e -> m +foldReduce = foldMap unit + +returnUnit :: (Monad m, c `Reducer` n) => c -> m n +returnUnit = return . unit + +pureUnit :: (Applicative f, c `Reducer` n) => c -> f n +pureUnit = pure . unit + +instance (Reducer c m, Reducer c n) => Reducer c (m,n) where + unit x = (unit x,unit x) + (m,n) `snoc` x = (m `snoc` x, n `snoc` x) + x `cons` (m,n) = (x `cons` m, x `cons` n) + +instance (Reducer c m, Reducer c n, Reducer c o) => Reducer c (m,n,o) where + unit x = (unit x,unit x, unit x) + (m,n,o) `snoc` x = (m `snoc` x, n `snoc` x, o `snoc` x) + x `cons` (m,n,o) = (x `cons` m, x `cons` n, x `cons` o) + +instance (Reducer c m, Reducer c n, Reducer c o, Reducer c p) => Reducer c (m,n,o,p) where + unit x = (unit x,unit x, unit x, unit x) + (m,n,o,p) `snoc` x = (m `snoc` x, n `snoc` x, o `snoc` x, p `snoc` x) + x `cons` (m,n,o,p) = (x `cons` m, x `cons` n, x `cons` o, x `cons` p) + +instance Reducer c [c] where + unit = return + cons = (:) + xs `snoc` x = xs ++ [x] + +instance Reducer c () where + unit _ = () + _ `snoc` _ = () + _ `cons` _ = () + +instance Reducer Bool Any where + unit = Any + +instance Reducer Bool All where + unit = All + +instance Reducer (a -> a) (Endo a) where + unit = Endo + +instance Monoid a => Reducer a (Dual a) where + unit = Dual + +instance Num a => Reducer a (Sum a) where + unit = Sum + +instance Num a => Reducer a (Product a) where + unit = Product + +instance Reducer (Maybe a) (First a) where + unit = First + +instance Reducer a (First a) where + unit = First . Just + +instance Reducer (Maybe a) (Last a) where + unit = Last + +instance Reducer a (Last a) where + unit = Last . Just + +instance Measured v a => Reducer a (FingerTree v a) where + unit = singleton + cons = (<|) + snoc = (|>) + +instance (Stream s m t, c `Reducer` a) => Reducer c (ParsecT s u m a) where + unit = return . unit + +instance Reducer a (Seq a) where + unit = Seq.singleton + cons = (Seq.<|) + snoc = (Seq.|>) + +instance Reducer Int IntSet where + unit = IntSet.singleton + cons = IntSet.insert + snoc = flip IntSet.insert -- left bias irrelevant + +instance Ord a => Reducer a (Set a) where + unit = Set.singleton + cons = Set.insert + -- pedantic about order in case 'Eq' doesn't implement structural equality + snoc s m | Set.member m s = s + | otherwise = Set.insert m s + +instance Reducer (Int,v) (IntMap v) where + unit = uncurry IntMap.singleton + cons = uncurry IntMap.insert + snoc = flip . uncurry . IntMap.insertWith $ const id + +instance Ord k => Reducer (k,v) (Map k v) where + unit = uncurry Map.singleton + cons = uncurry Map.insert + snoc = flip . uncurry . Map.insertWith $ const id + +{- +instance Enum a => Reducer a (BitSet a) where + unit m = BitSet.insert m BitSet.empty +-} ++ addfile ./doc/html/monoids/src/Data-Monoid-Union.html hunk ./doc/html/monoids/src/Data-Monoid-Union.html 1 + + + + +
{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, GeneralizedNewtypeDeriving #-} +module Data.Monoid.Union + ( module Data.Monoid.Reducer + -- * Unions of Containers + , HasUnion + , empty + , union + , Union(Union,getUnion) + -- * Unions of Containers of Monoids + , HasUnionWith + , emptyWith + , unionWith + , UnionWith(UnionWith,getUnionWith) + ) where + +import qualified Data.IntMap as IntMap +import Data.IntMap (IntMap) + +import qualified Data.IntSet as IntSet +import Data.IntSet (IntSet) + +import qualified Data.Map as Map +import Data.Map (Map) + +import qualified Data.Set as Set +import Data.Set (Set) + +import qualified Data.List as List + +import Control.Functor.Pointed + +import Data.Monoid.Reducer (Reducer, unit, cons, snoc, Monoid, mappend, mempty) + +-- | A Container suitable for the 'Union' 'Monoid' +class HasUnion f where + empty :: f + {-# SPECIALIZE union :: IntMap a -> IntMap a -> IntMap a #-} + {-# SPECIALIZE union :: Ord k => Map k a -> Map k a -> Map k a #-} + {-# SPECIALIZE union :: Eq a => [a] -> [a] -> [a] #-} + {-# SPECIALIZE union :: Ord a => Set a -> Set a -> Set a #-} + {-# SPECIALIZE union :: IntSet -> IntSet -> IntSet #-} + union :: f -> f -> f + +instance HasUnion (IntMap a) where + empty = IntMap.empty + union = IntMap.union + +instance Ord k => HasUnion (Map k a) where + empty = Map.empty + union = Map.union + +instance Eq a => HasUnion [a] where + empty = [] + union = List.union + +instance Ord a => HasUnion (Set a) where + empty = Set.empty + union = Set.union + +instance HasUnion IntSet where + empty = IntSet.empty + union = IntSet.union + +-- | The 'Monoid' @('union','empty')@ +newtype Union f = Union { getUnion :: f } + deriving (Eq,Ord,Show,Read) + +instance (HasUnion f) => Monoid (Union f) where + mempty = Union empty + Union a `mappend` Union b = Union (a `union` b) + +instance (HasUnion f) => Reducer f (Union f) where + unit = Union + +instance Functor Union where + fmap f (Union a) = Union (f a) + +instance Pointed Union where + point = Union + +instance Copointed Union where + extract = getUnion + +-- | Polymorphic containers that we can supply an operation to handle unions with +class HasUnionWith f where + {-# SPECIALIZE unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a #-} + {-# SPECIALIZE unionWith :: Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a #-} + unionWith :: (a -> a -> a) -> f a -> f a -> f a + emptyWith :: f a + +instance HasUnionWith IntMap where + emptyWith = IntMap.empty + unionWith = IntMap.unionWith + +instance Ord k => HasUnionWith (Map k) where + emptyWith = Map.empty + unionWith = Map.unionWith + + +-- | The 'Monoid' @('unionWith mappend','empty')@ for containers full of monoids. +newtype UnionWith f m = UnionWith { getUnionWith :: f m } + deriving (Eq,Ord,Show,Read,Functor,Pointed,Monad) + +instance (HasUnionWith f, Monoid m) => Monoid (UnionWith f m) where + mempty = UnionWith emptyWith + UnionWith a `mappend` UnionWith b = UnionWith (unionWith mappend a b) + +instance (HasUnionWith f, Monoid m) => Reducer (f m) (UnionWith f m) where + unit = UnionWith + ++ addfile ./doc/html/monoids/src/Data-Ring-Boolean.html hunk ./doc/html/monoids/src/Data-Ring-Boolean.html 1 + + + + +
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Ring.Boolean +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable (MPTCs) +-- +-- A Boolean 'Ring' over 'Bool'. Note well that the 'mappend' of this ring is +-- symmetric difference and not disjunction like you might expect. To get that +-- you should use use 'Ord' from "Data.Ring.Semi.Ord.Order" on 'Bool' to get the '&&'/'||'-based +-- distributive-lattice 'SemiRing' +----------------------------------------------------------------------------- + +module Data.Ring.Boolean + ( module Data.Ring + , BoolRing(BoolRing, getBoolRing) + ) where + +import Data.Ring +import Data.Monoid.Reducer + +newtype BoolRing = BoolRing { getBoolRing :: Bool } deriving (Eq,Ord,Show,Read) + +instance Monoid BoolRing where + mempty = BoolRing False + BoolRing a `mappend` BoolRing b = BoolRing ((a || b) && not (a && b)) + +instance Group BoolRing where + gnegate = BoolRing . not . getBoolRing + +instance Multiplicative BoolRing where + one = BoolRing True + BoolRing a `times` BoolRing b = BoolRing (a && b) + +instance LeftSemiNearRing BoolRing +instance RightSemiNearRing BoolRing +instance SemiRing BoolRing +instance Ring BoolRing + +instance Reducer Bool BoolRing where + unit = BoolRing ++ addfile ./doc/html/monoids/src/Data-Ring-FromNum.html hunk ./doc/html/monoids/src/Data-Ring-FromNum.html 1 + + + + +
{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Ring.FromNum +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable (MPTCs) +-- +-- A wrapper that lies for you and claims any instance of 'Num' is a 'Ring'. +-- Who knows, for your type it might even be telling the truth! +-- +----------------------------------------------------------------------------- + +module Data.Ring.FromNum + ( module Data.Ring + , FromNum(FromNum, getFromNum) + ) where + +import Data.Ring +import Data.Monoid.Reducer + +newtype FromNum a = FromNum { getFromNum :: a } deriving (Eq,Show,Num) + +instance Num a => Monoid (FromNum a) where + mempty = fromInteger 0 + mappend = (+) + +instance Num a => Group (FromNum a) where + minus = (-) + gnegate = negate + +instance Num a => Multiplicative (FromNum a) where + one = fromInteger 1 + times = (*) + +-- you can assume these, but you're probably lying to yourself +instance Num a => LeftSemiNearRing (FromNum a) +instance Num a => RightSemiNearRing (FromNum a) +instance Num a => SemiRing (FromNum a) +instance Num a => Ring (FromNum a) + +instance Num a => Reducer Integer (FromNum a) where + unit = fromInteger + ++ addfile ./doc/html/monoids/src/Data-Ring-Module-AutomaticDifferentiation.html hunk ./doc/html/monoids/src/Data-Ring-Module-AutomaticDifferentiation.html 1 + + + + +
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +module Data.Ring.Module.AutomaticDifferentiation + ( module Data.Ring.Module + , D + ) where + +import Prelude hiding ((*),(+),(-),subtract,negate) +import Data.Ring.Sugar +import Data.Ring.Module +import Data.Monoid.Reducer + +data D r m = D r m + +instance (Monoid r, Monoid m) => Monoid (D r m) where + mempty = D mempty mempty + D x m `mappend` D y n = D (x + y) (m + n) + +instance (Module r m) => Multiplicative (D r m) where + one = D one zero + D x m `times` D y n = D (x * y) (x *. n + m .* y) + +instance (Group r, Module r m, Group m) => Group (D r m) where + gnegate (D x m) = D (gnegate x) (gnegate m) + D x m `minus` D y n = D (x `minus` y) (m `minus` n) + D x m `gsubtract` D y n = D (x `gsubtract` y) (m `gsubtract` n) + +instance (LeftSemiNearRing r, Module r m) => LeftSemiNearRing (D r m) +instance (RightSemiNearRing r, Module r m) => RightSemiNearRing (D r m) +instance (SemiRing r, Module r m) => SemiRing (D r m) +instance (Ring r, Module r m, Group m) => Ring (D r m) + +instance (c `Reducer` r, c `Reducer` m) => Reducer c (D r m) where + unit c = D (unit c) (unit c) + c `cons` D x m = D (c `cons` x) (c `cons` m) + D x m `snoc` c = D (x `snoc` c) (m `snoc` c) + +{-- +infix 0 >< + +(><) :: Multiplicatve a => (a -> a) -> (AD a -> AD a) -> AD a -> AD a +(f >< f') a@(AD a0 a') = D (f a0) (a' * f' a) + +data AD r = AD r (Maybe (AD r)) + +instance (Monoid r) => Monoid (AD r) where + mempty = K mempty + AD x m + AD y n = D (x + y) (m + n) + +instance (c `Reducer` r) => Reducer c (AD r) where + unit c = c' where c' = AD (unit c) c' +--} ++ addfile ./doc/html/monoids/src/Data-Ring-Module.html hunk ./doc/html/monoids/src/Data-Ring-Module.html 1 + + + + +
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +----------------------------------------------------------------------------- +-- | +-- Module : Data.Ring.Module +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable (MPTCs) +-- +-- Left- and right- modules over rings, semirings, and Seminearrings. +-- To avoid a proliferation of classes. These only require that there +-- be an addition and multiplication operation for the 'Ring' +-- +----------------------------------------------------------------------------- + +module Data.Ring.Module + ( module Data.Ring + , LeftModule + , (*.) + , RightModule + , (.*) + , Module + ) where + +import Data.Ring +-- import qualified Data.Monoid.Combinators as Monoid + +-- | @ (x * y) *. m = x * (y *. m) @ +class (Monoid r, Multiplicative r, Monoid m) => LeftModule r m where + (*.) :: r -> m -> m + +-- | @ (m .* x) * y = m .* (x * y) @ +class (Monoid r, Multiplicative r, Monoid m) => RightModule r m where + (.*) :: m -> r -> m + +-- | @ (x *. m) .* y = x *. (m .* y) @ +class (LeftModule r m, RightModule r m) => Module r m + +-- instance Monoid m => LeftModule Int m where i *. m = Monoid.replicate m i +-- instance Monoid m => RightModule Int m where m .* i = Monoid.replicate m i +-- instance Monoid m => Module Int m + +-- instance Monoid m => LeftModule Integer m where i *. m = Monoid.replicate m i +-- instance Monoid m => RightModule Integer m where m .* i = Monoid.replicate m i +-- instance Monoid m => Module Integer m ++ addfile ./doc/html/monoids/src/Data-Ring-Semi-Near.html hunk ./doc/html/monoids/src/Data-Ring-Semi-Near.html 1 + + + + +
{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Ring.Semi.Near +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : portable (instances use MPTCs) +-- +-- Defines left- and right- seminearrings. Every 'MonadPlus' wrapped around +-- a 'Monoid' qualifies due to the distributivity of (>>=) over 'mplus'. +-- +-- See <http://conway.rutgers.edu/~ccshan/wiki/blog/posts/WordNumbers1/> +-- +----------------------------------------------------------------------------- + +module Data.Ring.Semi.Near + ( module Data.Monoid.Multiplicative + , LeftSemiNearRing + , RightSemiNearRing + ) where + +import Control.Monad.Reader + +import qualified Control.Monad.RWS.Lazy as LRWS +import qualified Control.Monad.RWS.Strict as SRWS + +import qualified Control.Monad.State.Lazy as LState +import qualified Control.Monad.State.Strict as SState + +import qualified Control.Monad.Writer.Lazy as LWriter +import qualified Control.Monad.Writer.Strict as SWriter + +import Data.Monoid.Multiplicative +import Data.FingerTree +import Data.Monoid.FromString +import Data.Monoid.Self +import Data.Monoid.Generator + +import qualified Data.Sequence as Seq +import Data.Sequence (Seq) + +import Text.Parsec.Prim + +-- | @(a + b) * c = (a * c) + (b * c)@ +class (Multiplicative m, Monoid m) => RightSemiNearRing m + +-- 'Monoid' transformers +instance RightSemiNearRing m => RightSemiNearRing (Self m) +instance RightSemiNearRing m => RightSemiNearRing (FromString m) + +-- | @a * (b + c) = (a * b) + (a * c)@ +class (Multiplicative m, Monoid m) => LeftSemiNearRing m + +-- 'Monoid' transformers +instance LeftSemiNearRing m => LeftSemiNearRing (Self m) +instance LeftSemiNearRing m => LeftSemiNearRing (FromString m) + +-- non-'Monad' instances +instance (Measured v m, Monoid m) => LeftSemiNearRing (FingerTree v m) + +-- 'Monad' instances +-- Every 'MonadPlus' over a 'Monoid' with an appropriate 'Multiplicative' instance +-- for 'liftM2 mappend' is a 'LeftSemiNearRing' by 'MonadPlus' left-distributivity + +instance Monoid m => LeftSemiNearRing [m] + +instance Monoid m => LeftSemiNearRing (Maybe m) + +instance Monoid m => LeftSemiNearRing (Seq m) + +instance (Stream s m t, Monoid a) => LeftSemiNearRing (ParsecT s u m a) + +instance (MonadPlus m, Monoid n) => LeftSemiNearRing (SState.StateT s m n) + +instance (MonadPlus m, Monoid n) => LeftSemiNearRing (LState.StateT s m n) + +instance (MonadPlus m, Monoid n) => LeftSemiNearRing (ReaderT e m n) + +instance (MonadPlus m, Monoid w, Monoid n) => LeftSemiNearRing (SRWS.RWST r w s m n) + +instance (MonadPlus m, Monoid w, Monoid n) => LeftSemiNearRing (LRWS.RWST r w s m n) + +instance (MonadPlus m, Monoid w, Monoid n) => LeftSemiNearRing (SWriter.WriterT w m n) + +instance (MonadPlus m, Monoid w, Monoid n) => LeftSemiNearRing (LWriter.WriterT w m n) + ++ addfile ./doc/html/monoids/src/Data-Ring-Semi-Ord.html hunk ./doc/html/monoids/src/Data-Ring-Semi-Ord.html 1 + + + + +
{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} +---------------------------------------------------------------------- +-- | +-- Module : Data.Ring.Semi.Ord +-- Copyright : (c) Edward Kmett 2009, Conal Elliott 2008 +-- License : BSD3 +-- +-- Maintainer : ekmett@gmail.com +-- Stability : experimental +-- +-- Turn an instance of 'Ord' into a 'SemiRing' over 'max' and 'min' +------------------------------------------------------------------------ + +module Data.Ring.Semi.Ord + ( module Data.Ring.Semi + , Order(Order,getOrder) + , Priority(MinBound,Priority,MaxBound) + ) where + +import Test.QuickCheck +-- import Control.Applicative +import Control.Functor.Pointed +import Data.Ring.Semi +import Data.Monoid.Ord +import Data.Monoid.Reducer + +-- | A 'SemiRing' using a type's built-in Bounded instance. +newtype Order a = Order { getOrder :: a } deriving (Eq,Ord,Read,Show,Bounded,Arbitrary) + +instance (Bounded a, Ord a) => Monoid (Order a) where + mappend = max + mempty = minBound + +instance (Bounded a, Ord a) => Multiplicative (Order a) where + times = min + one = maxBound + +instance (Bounded a, Ord a) => RightSemiNearRing (Order a) +instance (Bounded a, Ord a) => LeftSemiNearRing (Order a) +instance (Bounded a, Ord a) => SemiRing (Order a) +instance (Bounded a, Ord a) => Reducer a (Order a) where + unit = Order + +instance Functor Order where + fmap f (Order a) = Order (f a) + +instance Pointed Order where + point = Order + +instance Copointed Order where + extract = getOrder + +-- | A 'SemiRing' which adds 'minBound' and 'maxBound' to a pre-existing type. +data Priority a = MinBound | Priority a | MaxBound deriving (Eq,Read,Show) + +instance Bounded (Priority a) where + minBound = MinBound + maxBound = MaxBound + +instance Ord a => Ord (Priority a) where + MinBound <= _ = True + Priority _ <= MinBound = False + Priority a <= Priority b = a <= b + Priority _ <= MaxBound = True + MaxBound <= MaxBound = True + MaxBound <= _ = False + + MinBound `min` _ = MinBound + _ `min` MinBound = MinBound + Priority a `min` Priority b = Priority (a `min` b) + u `min` MaxBound = u + MaxBound `min` v = v + + MinBound `max` v = v + u `max` MinBound = u + Priority a `max` Priority b = Priority (a `max` b) + _ `max` MaxBound = MaxBound + MaxBound `max` _ = MaxBound + +instance Arbitrary a => Arbitrary (Priority a) where + arbitrary = frequency [ (1 ,return MinBound) + , (10, fmap Priority arbitrary) + , (1 ,return MaxBound) ] + coarbitrary MinBound = variant 0 + coarbitrary (Priority a) = variant 1 . coarbitrary a + coarbitrary MaxBound = variant 2 + +instance Ord a => Monoid (Priority a) where + mappend = max + mempty = minBound + +instance Ord a => Multiplicative (Priority a) where + times = min + one = maxBound + +instance Ord a => LeftSemiNearRing (Priority a) +instance Ord a => RightSemiNearRing (Priority a) +instance Ord a => SemiRing (Priority a) + +instance Ord a => Reducer a (Priority a) where + unit = Priority + +instance Ord a => Reducer (MinPriority a) (Priority a) where + unit (MinPriority Nothing) = MaxBound + unit (MinPriority (Just x)) = Priority x + +instance Ord a => Reducer (MaxPriority a) (Priority a) where + unit (MaxPriority Nothing) = MinBound + unit (MaxPriority (Just x)) = Priority x + +instance Functor Priority where + fmap _ MaxBound = MaxBound + fmap f (Priority a) = Priority (f a) + fmap _ MinBound = MinBound + +instance Pointed Priority where + point = Priority ++ addfile ./doc/html/monoids/src/Data-Ring-Semi-Tropical.html hunk ./doc/html/monoids/src/Data-Ring-Semi-Tropical.html 1 + + + + +
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +----------------------------------------------------------------------------- +---- | +---- Module : Data.Ring.Semi.Tropical +---- Copyright : (c) Edward Kmett 2009 +---- License : BSD-style +---- Maintainer : libraries@haskell.org +---- Stability : experimental +---- Portability : portable +---- +----------------------------------------------------------------------------- + +module Data.Ring.Semi.Tropical + ( module Data.Monoid.Reducer + , module Data.Ring.Semi + -- * Tropical Semirings + , infinity + , Tropical(Tropical,getTropical) + ) where + +import Control.Functor.Pointed +import Data.Monoid.Reducer (Reducer, unit, Monoid, mappend, mempty) +import Data.Ring.Semi +import Data.Monoid.Ord hiding (infinity) + +infinity :: Tropical a +infinity = Tropical Nothing + +-- | The 'SemiRing' @('min','+')@ over @'a' extended with 'infinity'@. +-- When @a@ has a Num instance with an addition that respects order, then this is +-- transformed into a tropical semiring. It is assumed that 0 is the least element +-- of a. +-- +-- <http://hal.archives-ouvertes.fr/docs/00/11/37/79/PDF/Tropical.pdf> + +newtype Tropical a = Tropical { getTropical :: Maybe a } deriving (Eq,Show,Read) + +instance Ord a => Ord (Tropical a) where + Tropical Nothing `compare` Tropical Nothing = EQ + Tropical Nothing `compare` _ = GT + _ `compare` Tropical Nothing = LT + Tropical (Just a) `compare` Tropical (Just b) = a `compare` b + +instance Ord a => Monoid (Tropical a) where + mempty = infinity + mappend = min + +instance Ord a => Reducer a (Tropical a) where + unit = Tropical . Just + +instance Ord a => Reducer (Maybe a) (Tropical a) where + unit = Tropical + +instance Ord a => Reducer (MinPriority a) (Tropical a) where + unit = Tropical . getMinPriority + +instance Functor Tropical where + fmap f (Tropical a) = Tropical (fmap f a) + +instance Pointed Tropical where + point = Tropical . Just + +instance Num a => Multiplicative (Tropical a) where + one = point $ fromInteger 0 + Tropical Nothing `times` _ = infinity + Tropical (Just a) `times` Tropical (Just b) = point (a + b) + _ `times` Tropical Nothing = infinity + +instance (Ord a, Num a) => LeftSemiNearRing (Tropical a) +instance (Ord a, Num a) => RightSemiNearRing (Tropical a) +instance (Ord a, Num a) => SemiRing (Tropical a) ++ addfile ./doc/html/monoids/src/Data-Ring-Semi.html hunk ./doc/html/monoids/src/Data-Ring-Semi.html 1 + + + + +
----------------------------------------------------------------------------- +-- | +-- Module : Data.Ring.Semi +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : non-portable (MPTCs) +-- +-- +----------------------------------------------------------------------------- + +module Data.Ring.Semi + ( module Data.Ring.Semi.Near + , SemiRing + ) where + +import Data.Ring.Semi.Near + +-- | A 'SemiRing' is an instance of both 'Multiplicative' and 'Monoid' where +-- 'times' distributes over 'plus'. +class (RightSemiNearRing a, LeftSemiNearRing a) => SemiRing a ++ addfile ./doc/html/monoids/src/Data-Ring-Sugar.html hunk ./doc/html/monoids/src/Data-Ring-Sugar.html 1 + + + + +
----------------------------------------------------------------------------- +-- | +-- Module : Data.Ring.Sugar +-- Copyright : (c) Edward Kmett 2009 +-- License : BSD-style +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : portable +-- +-- Syntactic sugar for working with rings that conflicts with names from the "Prelude". +-- +-- > import Prelude hiding ((-), (+), (*), negate, subtract) +-- > import Data.Ring.Sugar +-- +----------------------------------------------------------------------------- + +module Data.Ring.Sugar + ( module Data.Monoid.Multiplicative.Sugar + , module Data.Ring.Semi.Near + ) where + +import Data.Monoid.Multiplicative.Sugar +import Data.Ring.Semi.Near ++ addfile ./doc/html/monoids/src/Data-Ring.html hunk ./doc/html/monoids/src/Data-Ring.html 1 + + + + +
{-# OPTIONS_GHC -fno-warn-orphans #-} +module Data.Ring + ( module Data.Group + , module Data.Ring.Semi + , Ring + ) where + +import Data.Group +import Data.Ring.Semi + +class (Group a, SemiRing a) => Ring a ++ addfile ./doc/html/monoids/src/hscolour.css hunk ./doc/html/monoids/src/hscolour.css 1 +.hs-keyglyph, .hs-layout {color: red;} +.hs-keyword {color: blue;} +.hs-comment, .hs-comment a {color: green;} +.hs-str, .hs-chr {color: teal;} +.hs-keyword, .hs-conid, .hs-varid, .hs-conop, .hs-varop, .hs-num, .hs-cpp, .hs-sel, .hs-definition {} }