Safe Haskell | Safe |
---|---|
Language | Haskell98 |
This module contains the additional data types, instance definitions and functions to run parsers in an interleaved way. If all the interleaved parsers recognise a single connected piece of the input text this incorporates the permutation parsers. For some examples see the module Text.ParserCombinators.UU.Demo.MergeAndPermute.
Synopsis
- class Splittable f where
- data Gram f a = Gram [Alt f a] (Maybe a)
- data Alt f a
- mkG :: (Splittable f, Functor f) => f a -> Gram f a
- mkP :: (Monad f, Applicative f, Alternative f) => Gram f a -> f a
- (<<||>) :: Functor f => Gram f (b -> a) -> Gram f b -> Gram f a
- (<||>) :: Functor f => Gram f (a1 -> a2) -> Gram f a1 -> Gram f a2
- sepBy :: (Monad f, Applicative f, Alternative f) => Gram f a -> f b -> f a
- gmList :: Functor f => Gram f a -> Gram f [a]
- module Control.Applicative
- (<>) :: Semigroup a => a -> a -> a
- class Semigroup a => Monoid a where
- newtype First a = First {}
- newtype Last a = Last {}
- newtype Dual a = Dual {
- getDual :: a
- newtype Endo a = Endo {
- appEndo :: a -> a
- newtype All = All {}
- newtype Any = Any {}
- newtype Sum a = Sum {
- getSum :: a
- newtype Product a = Product {
- getProduct :: a
- getAlt :: Alt f a -> f a
Classes
class Splittable f where Source #
Types
Since we want to get access to the individual parsers which recognise a consecutive
piece of the input text we define a new data type, which lifts the underlying parsers
to the grammatical level, so they can be transformed, manipulated, and run in a piecewise way.
Gram
is defined in such a way that we can always access the first parsers to be ran from such a structure.
We require that all the Alt
s do not recognise the empty string.
These should be covered by the Maybe
in the Gram
constructor.
Instances
Functor f => Monad (Gram f) Source # | |
Functor f => Functor (Gram f) Source # | We define instances for the data type |
Functor f => Applicative (Gram f) Source # | The left hand side operand is gradually transformed so we get access to its first component |
Functor f => Alternative (Gram f) Source # | |
Show a => Show (Gram f a) Source # | |
Functor f => Semigroup (Gram f (r -> r)) Source # | |
Functor f => Monoid (Gram f (r -> r)) Source # | |
Functions
mkG :: (Splittable f, Functor f) => f a -> Gram f a Source #
The function mkGram
splits a simple parser into the possibly empty part and the non-empty part.
The non-empty part recognises a consecutive part of the input.
Here we use the functions getOneP
and getZeroP
which are provided in the uu-parsinglib package,
but they could easily be provided by other packages too.
mkP :: (Monad f, Applicative f, Alternative f) => Gram f a -> f a Source #
mkParser
converts a Gram
mar back into a parser, which can subsequenly be run.
sepBy :: (Monad f, Applicative f, Alternative f) => Gram f a -> f b -> f a Source #
gmList :: Functor f => Gram f a -> Gram f [a] Source #
Run a sufficient number of p
's in a merged fashion, but no more than necessary!!
Modules
module Control.Applicative
class Semigroup a => Monoid a where #
The class of monoids (types with an associative binary operation that has an identity). Instances should satisfy the following laws:
x
<>
mempty
= xmempty
<>
x = xx
(<>
(y<>
z) = (x<>
y)<>
zSemigroup
law)mconcat
=foldr
'(<>)'mempty
The method names refer to the monoid of lists under concatenation, but there are many other instances.
Some types can be viewed as a monoid in more than one way,
e.g. both addition and multiplication on numbers.
In such cases we often define newtype
s and make those instances
of Monoid
, e.g. Sum
and Product
.
NOTE: Semigroup
is a superclass of Monoid
since base-4.11.0.0.
Identity of mappend
An associative operation
NOTE: This method is redundant and has the default
implementation
since base-4.11.0.0.mappend
= '(<>)'
Fold a list using the monoid.
For most types, the default definition for mconcat
will be
used, but the function is included in the class definition so
that an optimized version can be provided for specific types.
Instances
Monoid Ordering | Since: base-2.1 |
Monoid () | Since: base-2.1 |
Monoid All | Since: base-2.1 |
Monoid Any | Since: base-2.1 |
Monoid [a] | Since: base-2.1 |
Semigroup a => Monoid (Maybe a) | Lift a semigroup into Since 4.11.0: constraint on inner Since: base-2.1 |
Monoid a => Monoid (IO a) | Since: base-4.9.0.0 |
(Ord a, Bounded a) => Monoid (Min a) | Since: base-4.9.0.0 |
(Ord a, Bounded a) => Monoid (Max a) | Since: base-4.9.0.0 |
Monoid m => Monoid (WrappedMonoid m) | Since: base-4.9.0.0 |
Defined in Data.Semigroup mempty :: WrappedMonoid m # mappend :: WrappedMonoid m -> WrappedMonoid m -> WrappedMonoid m # mconcat :: [WrappedMonoid m] -> WrappedMonoid m # | |
Semigroup a => Monoid (Option a) | Since: base-4.9.0.0 |
Monoid (First a) | Since: base-2.1 |
Monoid (Last a) | Since: base-2.1 |
Monoid a => Monoid (Dual a) | Since: base-2.1 |
Monoid (Endo a) | Since: base-2.1 |
Num a => Monoid (Sum a) | Since: base-2.1 |
Num a => Monoid (Product a) | Since: base-2.1 |
Monoid b => Monoid (a -> b) | Since: base-2.1 |
(Monoid a, Monoid b) => Monoid (a, b) | Since: base-2.1 |
Functor f => Monoid (Gram f (r -> r)) # | |
(Monoid a, Monoid b, Monoid c) => Monoid (a, b, c) | Since: base-2.1 |
Monoid a => Monoid (Const a b) | |
Alternative f => Monoid (Alt f a) | Since: base-4.8.0.0 |
(Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a, b, c, d) | Since: base-2.1 |
(Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) => Monoid (a, b, c, d, e) | Since: base-2.1 |
Maybe monoid returning the leftmost non-Nothing value.
is isomorphic to First
a
, but precedes it
historically.Alt
Maybe
a
>>>
getFirst (First (Just "hello") <> First Nothing <> First (Just "world"))
Just "hello"
Instances
Monad First | |
Functor First | |
Applicative First | |
Foldable First | Since: base-4.8.0.0 |
Defined in Data.Foldable fold :: Monoid m => First m -> m # foldMap :: Monoid m => (a -> m) -> First a -> m # foldr :: (a -> b -> b) -> b -> First a -> b # foldr' :: (a -> b -> b) -> b -> First a -> b # foldl :: (b -> a -> b) -> b -> First a -> b # foldl' :: (b -> a -> b) -> b -> First a -> b # foldr1 :: (a -> a -> a) -> First a -> a # foldl1 :: (a -> a -> a) -> First a -> a # elem :: Eq a => a -> First a -> Bool # maximum :: Ord a => First a -> a # minimum :: Ord a => First a -> a # | |
Traversable First | Since: base-4.8.0.0 |
Eq a => Eq (First a) | |
Ord a => Ord (First a) | |
Read a => Read (First a) | |
Show a => Show (First a) | |
Generic (First a) | |
Semigroup (First a) | Since: base-4.9.0.0 |
Monoid (First a) | Since: base-2.1 |
Generic1 First | |
type Rep (First a) | |
Defined in Data.Monoid | |
type Rep1 First | |
Defined in Data.Monoid |
Maybe monoid returning the rightmost non-Nothing value.
is isomorphic to Last
a
, and thus to
Dual
(First
a)Dual
(Alt
Maybe
a)
>>>
getLast (Last (Just "hello") <> Last Nothing <> Last (Just "world"))
Just "world"
Instances
Monad Last | |
Functor Last | |
Applicative Last | |
Foldable Last | Since: base-4.8.0.0 |
Defined in Data.Foldable fold :: Monoid m => Last m -> m # foldMap :: Monoid m => (a -> m) -> Last a -> m # foldr :: (a -> b -> b) -> b -> Last a -> b # foldr' :: (a -> b -> b) -> b -> Last a -> b # foldl :: (b -> a -> b) -> b -> Last a -> b # foldl' :: (b -> a -> b) -> b -> Last a -> b # foldr1 :: (a -> a -> a) -> Last a -> a # foldl1 :: (a -> a -> a) -> Last a -> a # elem :: Eq a => a -> Last a -> Bool # maximum :: Ord a => Last a -> a # | |
Traversable Last | Since: base-4.8.0.0 |
Eq a => Eq (Last a) | |
Ord a => Ord (Last a) | |
Read a => Read (Last a) | |
Show a => Show (Last a) | |
Generic (Last a) | |
Semigroup (Last a) | Since: base-4.9.0.0 |
Monoid (Last a) | Since: base-2.1 |
Generic1 Last | |
type Rep (Last a) | |
Defined in Data.Monoid | |
type Rep1 Last | |
Defined in Data.Monoid |
The dual of a Monoid
, obtained by swapping the arguments of mappend
.
>>>
getDual (mappend (Dual "Hello") (Dual "World"))
"WorldHello"
Instances
Monad Dual | Since: base-4.8.0.0 |
Functor Dual | Since: base-4.8.0.0 |
Applicative Dual | Since: base-4.8.0.0 |
Foldable Dual | Since: base-4.8.0.0 |
Defined in Data.Foldable fold :: Monoid m => Dual m -> m # foldMap :: Monoid m => (a -> m) -> Dual a -> m # foldr :: (a -> b -> b) -> b -> Dual a -> b # foldr' :: (a -> b -> b) -> b -> Dual a -> b # foldl :: (b -> a -> b) -> b -> Dual a -> b # foldl' :: (b -> a -> b) -> b -> Dual a -> b # foldr1 :: (a -> a -> a) -> Dual a -> a # foldl1 :: (a -> a -> a) -> Dual a -> a # elem :: Eq a => a -> Dual a -> Bool # maximum :: Ord a => Dual a -> a # | |
Traversable Dual | Since: base-4.8.0.0 |
Bounded a => Bounded (Dual a) | |
Eq a => Eq (Dual a) | |
Ord a => Ord (Dual a) | |
Read a => Read (Dual a) | |
Show a => Show (Dual a) | |
Generic (Dual a) | |
Semigroup a => Semigroup (Dual a) | Since: base-4.9.0.0 |
Monoid a => Monoid (Dual a) | Since: base-2.1 |
Generic1 Dual | |
type Rep (Dual a) | |
Defined in Data.Semigroup.Internal | |
type Rep1 Dual | |
Defined in Data.Semigroup.Internal |
The monoid of endomorphisms under composition.
>>>
let computation = Endo ("Hello, " ++) <> Endo (++ "!")
>>>
appEndo computation "Haskell"
"Hello, Haskell!"
Boolean monoid under conjunction (&&
).
>>>
getAll (All True <> mempty <> All False)
False
>>>
getAll (mconcat (map (\x -> All (even x)) [2,4,6,7,8]))
False
Boolean monoid under disjunction (||
).
>>>
getAny (Any True <> mempty <> Any False)
True
>>>
getAny (mconcat (map (\x -> Any (even x)) [2,4,6,7,8]))
True
Monoid under addition.
>>>
getSum (Sum 1 <> Sum 2 <> mempty)
3
Instances
Monad Sum | Since: base-4.8.0.0 |
Functor Sum | Since: base-4.8.0.0 |
Applicative Sum | Since: base-4.8.0.0 |
Foldable Sum | Since: base-4.8.0.0 |
Defined in Data.Foldable fold :: Monoid m => Sum m -> m # foldMap :: Monoid m => (a -> m) -> Sum a -> m # foldr :: (a -> b -> b) -> b -> Sum a -> b # foldr' :: (a -> b -> b) -> b -> Sum a -> b # foldl :: (b -> a -> b) -> b -> Sum a -> b # foldl' :: (b -> a -> b) -> b -> Sum a -> b # foldr1 :: (a -> a -> a) -> Sum a -> a # foldl1 :: (a -> a -> a) -> Sum a -> a # elem :: Eq a => a -> Sum a -> Bool # maximum :: Ord a => Sum a -> a # | |
Traversable Sum | Since: base-4.8.0.0 |
Bounded a => Bounded (Sum a) | |
Eq a => Eq (Sum a) | |
Num a => Num (Sum a) | |
Ord a => Ord (Sum a) | |
Read a => Read (Sum a) | |
Show a => Show (Sum a) | |
Generic (Sum a) | |
Num a => Semigroup (Sum a) | Since: base-4.9.0.0 |
Num a => Monoid (Sum a) | Since: base-2.1 |
Generic1 Sum | |
type Rep (Sum a) | |
Defined in Data.Semigroup.Internal | |
type Rep1 Sum | |
Defined in Data.Semigroup.Internal |
Monoid under multiplication.
>>>
getProduct (Product 3 <> Product 4 <> mempty)
12
Product | |
|
Instances
Monad Product | Since: base-4.8.0.0 |
Functor Product | Since: base-4.8.0.0 |
Applicative Product | Since: base-4.8.0.0 |
Foldable Product | Since: base-4.8.0.0 |
Defined in Data.Foldable fold :: Monoid m => Product m -> m # foldMap :: Monoid m => (a -> m) -> Product a -> m # foldr :: (a -> b -> b) -> b -> Product a -> b # foldr' :: (a -> b -> b) -> b -> Product a -> b # foldl :: (b -> a -> b) -> b -> Product a -> b # foldl' :: (b -> a -> b) -> b -> Product a -> b # foldr1 :: (a -> a -> a) -> Product a -> a # foldl1 :: (a -> a -> a) -> Product a -> a # elem :: Eq a => a -> Product a -> Bool # maximum :: Ord a => Product a -> a # minimum :: Ord a => Product a -> a # | |
Traversable Product | Since: base-4.8.0.0 |
Bounded a => Bounded (Product a) | |
Eq a => Eq (Product a) | |
Num a => Num (Product a) | |
Defined in Data.Semigroup.Internal | |
Ord a => Ord (Product a) | |
Defined in Data.Semigroup.Internal | |
Read a => Read (Product a) | |
Show a => Show (Product a) | |
Generic (Product a) | |
Num a => Semigroup (Product a) | Since: base-4.9.0.0 |
Num a => Monoid (Product a) | Since: base-2.1 |
Generic1 Product | |
type Rep (Product a) | |
Defined in Data.Semigroup.Internal | |
type Rep1 Product | |
Defined in Data.Semigroup.Internal |