| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Optics.VL
Description
This module provides compatibility layer for converting from van Laarhoven
encoding of Isos, Prisms, Lenses, IxLenses, AffineTraversals,
IxAffineTraversals, Traversals and IxTraversals to their optics
equivalents.
Synopsis
- type IsoVL s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t)
- type IsoVL' s a = IsoVL s s a a
- isoVL :: forall s t a b. IsoVL s t a b -> Iso s t a b
- type PrismVL s t a b = forall p f. (Choice p, Applicative f) => p a (f b) -> p s (f t)
- type PrismVL' s a = PrismVL s s a a
- prismVL :: forall s t a b. PrismVL s t a b -> Prism s t a b
- type LensVL s t a b = forall (f :: Type -> Type). Functor f => (a -> f b) -> s -> f t
- type LensVL' s a = LensVL s s a a
- lensVL :: LensVL s t a b -> Lens s t a b
- type IxLensVL i s t a b = forall (f :: Type -> Type). Functor f => (i -> a -> f b) -> s -> f t
- type IxLensVL' i s a = IxLensVL i s s a a
- ilensVL :: IxLensVL i s t a b -> IxLens i s t a b
- type AffineTraversalVL s t a b = forall (f :: Type -> Type). Functor f => (forall r. r -> f r) -> (a -> f b) -> s -> f t
- type AffineTraversalVL' s a = AffineTraversalVL s s a a
- atraversalVL :: AffineTraversalVL s t a b -> AffineTraversal s t a b
- type IxAffineTraversalVL i s t a b = forall (f :: Type -> Type). Functor f => (forall r. r -> f r) -> (i -> a -> f b) -> s -> f t
- type IxAffineTraversalVL' i s a = IxAffineTraversalVL i s s a a
- iatraversalVL :: IxAffineTraversalVL i s t a b -> IxAffineTraversal i s t a b
- type TraversalVL s t a b = forall (f :: Type -> Type). Applicative f => (a -> f b) -> s -> f t
- type TraversalVL' s a = TraversalVL s s a a
- traversalVL :: TraversalVL s t a b -> Traversal s t a b
- type IxTraversalVL i s t a b = forall (f :: Type -> Type). Applicative f => (i -> a -> f b) -> s -> f t
- type IxTraversalVL' i s a = IxTraversalVL i s s a a
- itraversalVL :: IxTraversalVL i s t a b -> IxTraversal i s t a b
Iso
type IsoVL s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t) Source #
Type synonym for a type-modifying van Laarhoven iso.
isoVL :: forall s t a b. IsoVL s t a b -> Iso s t a b Source #
Build an Iso from the van Laarhoven representation.
Prism
type PrismVL s t a b = forall p f. (Choice p, Applicative f) => p a (f b) -> p s (f t) Source #
Type synonym for a type-modifying van Laarhoven prism.
prismVL :: forall s t a b. PrismVL s t a b -> Prism s t a b Source #
Build a Prism from the van Laarhoven representation.
Lens
type LensVL s t a b = forall (f :: Type -> Type). Functor f => (a -> f b) -> s -> f t #
Type synonym for a type-modifying van Laarhoven lens.
IxLens
type IxLensVL i s t a b = forall (f :: Type -> Type). Functor f => (i -> a -> f b) -> s -> f t #
Type synonym for a type-modifying van Laarhoven indexed lens.
type IxLensVL' i s a = IxLensVL i s s a a #
Type synonym for a type-preserving van Laarhoven indexed lens.
ilensVL :: IxLensVL i s t a b -> IxLens i s t a b #
Build an indexed lens from the van Laarhoven representation.
AffineTraversal
type AffineTraversalVL s t a b = forall (f :: Type -> Type). Functor f => (forall r. r -> f r) -> (a -> f b) -> s -> f t #
Type synonym for a type-modifying van Laarhoven affine traversal.
Note: this isn't exactly van Laarhoven representation as there is
no Pointed class (which would be a superclass of Applicative
that contains pure but not <*>). You can interpret the first
argument as a dictionary of Pointed that supplies the point
function (i.e. the implementation of pure).
A TraversalVL has Applicative available and
hence can combine the effects arising from multiple elements using
<*>. In contrast, an AffineTraversalVL has no way to combine
effects from multiple elements, so it must act on at most one
element. (It can act on none at all thanks to the availability of
point.)
type AffineTraversalVL' s a = AffineTraversalVL s s a a #
Type synonym for a type-preserving van Laarhoven affine traversal.
atraversalVL :: AffineTraversalVL s t a b -> AffineTraversal s t a b #
Build an affine traversal from the van Laarhoven representation.
Example:
>>>:{azSnd = atraversalVL $ \point f ab@(a, b) -> if a >= 'a' && a <= 'z' then (a, ) <$> f b else point ab :}
>>>preview azSnd ('a', "Hi")Just "Hi"
>>>preview azSnd ('@', "Hi")Nothing
>>>over azSnd (++ "!!!") ('f', "Hi")('f',"Hi!!!")
>>>set azSnd "Bye" ('Y', "Hi")('Y',"Hi")
IxAffineTraversal
type IxAffineTraversalVL i s t a b = forall (f :: Type -> Type). Functor f => (forall r. r -> f r) -> (i -> a -> f b) -> s -> f t #
Type synonym for a type-modifying van Laarhoven indexed affine traversal.
Note: this isn't exactly van Laarhoven representation as there is no
Pointed class (which would be a superclass of Applicative that contains
pure but not <*>). You can interpret the first argument as a dictionary
of Pointed that supplies the point function (i.e. the implementation of
pure).
type IxAffineTraversalVL' i s a = IxAffineTraversalVL i s s a a #
Type synonym for a type-preserving van Laarhoven indexed affine traversal.
iatraversalVL :: IxAffineTraversalVL i s t a b -> IxAffineTraversal i s t a b #
Build an indexed affine traversal from the van Laarhoven representation.
Traversal
type TraversalVL s t a b = forall (f :: Type -> Type). Applicative f => (a -> f b) -> s -> f t #
Type synonym for a type-modifying van Laarhoven traversal.
type TraversalVL' s a = TraversalVL s s a a #
Type synonym for a type-preserving van Laarhoven traversal.
traversalVL :: TraversalVL s t a b -> Traversal s t a b #
Build a traversal from the van Laarhoven representation.
traversalVL.traverseOf≡idtraverseOf.traversalVL≡id
IxTraversal
type IxTraversalVL i s t a b = forall (f :: Type -> Type). Applicative f => (i -> a -> f b) -> s -> f t #
Type synonym for a type-modifying van Laarhoven indexed traversal.
type IxTraversalVL' i s a = IxTraversalVL i s s a a #
Type synonym for a type-preserving van Laarhoven indexed traversal.
itraversalVL :: IxTraversalVL i s t a b -> IxTraversal i s t a b #
Build an indexed traversal from the van Laarhoven representation.
itraversalVL.itraverseOf≡iditraverseOf.itraversalVL≡id