| Copyright | (c) 2014 Patrick Bahr | 
|---|---|
| License | BSD3 | 
| Maintainer | Patrick Bahr <paba@diku.dk> | 
| Stability | experimental | 
| Portability | non-portable (GHC Extensions) | 
| Safe Haskell | None | 
| Language | Haskell98 | 
Data.Comp.Mapping
Description
This module provides functionality to construct mappings from positions in a functorial value.
- data Numbered a = Numbered Int a
 - unNumbered :: Numbered a -> a
 - number :: Traversable f => f a -> f (Numbered a)
 - class (Functor t, Foldable t) => Traversable t
 - class Functor m => Mapping m k | m -> k where
 - prodMap :: Mapping m k => v1 -> v2 -> m v1 -> m v2 -> m (v1, v2)
 - lookupNumMap :: a -> Int -> NumMap t a -> a
 - lookupNumMap' :: Int -> NumMap t a -> Maybe a
 - data NumMap k v
 
Documentation
This type is used for numbering components of a functorial value.
unNumbered :: Numbered a -> a Source #
number :: Traversable f => f a -> f (Numbered a) Source #
This function numbers the components of the given functorial value with consecutive integers starting at 0.
class (Functor t, Foldable t) => Traversable t #
Functors representing data structures that can be traversed from left to right.
A definition of traverse must satisfy the following laws:
- naturality
 t .for every applicative transformationtraversef =traverse(t . f)t- identity
 traverseIdentity = Identity- composition
 traverse(Compose .fmapg . f) = Compose .fmap(traverseg) .traversef
A definition of sequenceA must satisfy the following laws:
- naturality
 t .for every applicative transformationsequenceA=sequenceA.fmaptt- identity
 sequenceA.fmapIdentity = Identity- composition
 sequenceA.fmapCompose = Compose .fmapsequenceA.sequenceA
where an applicative transformation is a function
t :: (Applicative f, Applicative g) => f a -> g a
preserving the Applicative operations, i.e.
and the identity functor Identity and composition of functors Compose
 are defined as
  newtype Identity a = Identity a
  instance Functor Identity where
    fmap f (Identity x) = Identity (f x)
  instance Applicative Identity where
    pure x = Identity x
    Identity f <*> Identity x = Identity (f x)
  newtype Compose f g a = Compose (f (g a))
  instance (Functor f, Functor g) => Functor (Compose f g) where
    fmap f (Compose x) = Compose (fmap (fmap f) x)
  instance (Applicative f, Applicative g) => Applicative (Compose f g) where
    pure x = Compose (pure (pure x))
    Compose f <*> Compose x = Compose ((<*>) <$> f <*> x)(The naturality law is implied by parametricity.)
Instances are similar to Functor, e.g. given a data type
data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)
a suitable instance would be
instance Traversable Tree where traverse f Empty = pure Empty traverse f (Leaf x) = Leaf <$> f x traverse f (Node l k r) = Node <$> traverse f l <*> f k <*> traverse f r
This is suitable even for abstract types, as the laws for <*>
 imply a form of associativity.
The superclass instances should satisfy the following:
- In the 
Functorinstance,fmapshould be equivalent to traversal with the identity applicative functor (fmapDefault). - In the 
Foldableinstance,foldMapshould be equivalent to traversal with a constant applicative functor (foldMapDefault). 
Instances
class Functor m => Mapping m k | m -> k where Source #
Minimal complete definition
Methods
(&) :: m v -> m v -> m v infixr 0 Source #
left-biased union of two mappings.
(|->) :: k -> v -> m v infix 1 Source #
This operator constructs a singleton mapping.
This is the empty mapping.
prodMapWith :: (v1 -> v2 -> v) -> v1 -> v2 -> m v1 -> m v2 -> m v Source #
This function constructs the pointwise product of two maps each with a default value.
findWithDefault :: a -> k -> m a -> a Source #
Returns the value at the given key or returns the given default when the key is not an element of the map.
prodMap :: Mapping m k => v1 -> v2 -> m v1 -> m v2 -> m (v1, v2) Source #
This function constructs the pointwise product of two maps each with a default value.
lookupNumMap :: a -> Int -> NumMap t a -> a Source #