Copyright | (C) 2013-16 Edward Kmett |
---|---|
License | BSD-style (see the file LICENSE) |
Maintainer | Edward Kmett <ekmett@gmail.com> |
Stability | experimental |
Portability | non-portable |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
This lets the subset of users who vociferously disagree about the full scope and set of operators that should be exported from lens to not have to look at any operator with which they disagree.
import Control.Lens.Combinators
Synopsis
-
class
(
Functor
t,
Foldable
t) =>
Traversable
(t ::
Type
->
Type
)
where
- traverse :: Applicative f => (a -> f b) -> t a -> f (t b)
- class Contravariant (f :: Type -> Type ) where
-
class
Bifunctor
(p ::
Type
->
Type
->
Type
)
where
- bimap :: (a -> b) -> (c -> d) -> p a c -> p b d
-
newtype
Identity
a =
Identity
{
- runIdentity :: a
-
newtype
Const
a (b :: k) =
Const
{
- getConst :: a
- data (a :: k) :~: (b :: k) where
- itoList :: FoldableWithIndex i f => f a -> [(i, a)]
- ifoldlM :: ( FoldableWithIndex i f, Monad m) => (i -> b -> a -> m b) -> b -> f a -> m b
- ifoldrM :: ( FoldableWithIndex i f, Monad m) => (i -> a -> b -> m b) -> b -> f a -> m b
- ifind :: FoldableWithIndex i f => (i -> a -> Bool ) -> f a -> Maybe (i, a)
- iconcatMap :: FoldableWithIndex i f => (i -> a -> [b]) -> f a -> [b]
- iforM_ :: ( FoldableWithIndex i t, Monad m) => t a -> (i -> a -> m b) -> m ()
- imapM_ :: ( FoldableWithIndex i t, Monad m) => (i -> a -> m b) -> t a -> m ()
- ifor_ :: ( FoldableWithIndex i t, Applicative f) => t a -> (i -> a -> f b) -> f ()
- itraverse_ :: ( FoldableWithIndex i t, Applicative f) => (i -> a -> f b) -> t a -> f ()
- none :: Foldable f => (a -> Bool ) -> f a -> Bool
- inone :: FoldableWithIndex i f => (i -> a -> Bool ) -> f a -> Bool
- iall :: FoldableWithIndex i f => (i -> a -> Bool ) -> f a -> Bool
- iany :: FoldableWithIndex i f => (i -> a -> Bool ) -> f a -> Bool
- imapAccumL :: TraversableWithIndex i t => (i -> s -> a -> (s, b)) -> s -> t a -> (s, t b)
- imapAccumR :: TraversableWithIndex i t => (i -> s -> a -> (s, b)) -> s -> t a -> (s, t b)
- iforM :: ( TraversableWithIndex i t, Monad m) => t a -> (i -> a -> m b) -> m (t b)
- imapM :: ( TraversableWithIndex i t, Monad m) => (i -> a -> m b) -> t a -> m (t b)
- ifor :: ( TraversableWithIndex i t, Applicative f) => t a -> (i -> a -> f b) -> f (t b)
-
class
Functor
f =>
FunctorWithIndex
i (f ::
Type
->
Type
) | f -> i
where
- imap :: (i -> a -> b) -> f a -> f b
- class Foldable f => FoldableWithIndex i (f :: Type -> Type ) | f -> i where
-
class
(
FunctorWithIndex
i t,
FoldableWithIndex
i t,
Traversable
t) =>
TraversableWithIndex
i (t ::
Type
->
Type
) | t -> i
where
- itraverse :: Applicative f => (i -> a -> f b) -> t a -> f (t b)
- class Profunctor (p :: Type -> Type -> Type ) where
- class Profunctor p => Choice (p :: Type -> Type -> Type ) where
- sequenceBy :: Traversable t => ( forall x. x -> f x) -> ( forall x y. f (x -> y) -> f x -> f y) -> t (f a) -> f (t a)
- traverseBy :: Traversable t => ( forall x. x -> f x) -> ( forall x y. f (x -> y) -> f x -> f y) -> (a -> f b) -> t a -> f (t b)
- foldMapBy :: Foldable t => (r -> r -> r) -> r -> (a -> r) -> t a -> r
- foldBy :: Foldable t => (a -> a -> a) -> a -> t a -> a
- class ( Foldable1 t, Traversable t) => Traversable1 (t :: Type -> Type ) where
-
class
Reversing
t
where
- reversing :: t -> t
- data Level i a
-
newtype
Indexed
i a b =
Indexed
{
- runIndexed :: i -> a -> b
-
class
Conjoined
p =>
Indexable
i p
where
- indexed :: p a b -> i -> a -> b
- class ( Choice p, Corepresentable p, Comonad ( Corep p), Traversable ( Corep p), Strong p, Representable p, Monad ( Rep p), MonadFix ( Rep p), Distributive ( Rep p), Costrong p, ArrowLoop p, ArrowApply p, ArrowChoice p, Closed p) => Conjoined p where
- indexing :: Indexable Int p => ((a -> Indexing f b) -> s -> Indexing f t) -> p a (f b) -> s -> f t
- indexing64 :: Indexable Int64 p => ((a -> Indexing64 f b) -> s -> Indexing64 f t) -> p a (f b) -> s -> f t
- withIndex :: ( Indexable i p, Functor f) => p (i, s) (f (j, t)) -> Indexed i s (f t)
- asIndex :: ( Indexable i p, Contravariant f, Functor f) => p i (f i) -> Indexed i s (f s)
- data Rightmost a
- data Leftmost a
- data Sequenced a m
- data Traversed a f
- type Context' a = Context a a
- data Context a b t = Context (b -> t) a
- type Bazaar1' p a = Bazaar1 p a a
-
newtype
Bazaar1
p a b t =
Bazaar1
{
- runBazaar1 :: forall f. Apply f => p a (f b) -> f t
- type Bazaar' p a = Bazaar p a a
-
newtype
Bazaar
p a b t =
Bazaar
{
- runBazaar :: forall f. Applicative f => p a (f b) -> f t
- data Magma i t b a
- class ( Profunctor p, Bifunctor p) => Reviewable p
- retagged :: ( Profunctor p, Bifunctor p) => p a b -> p s b
- class ( Applicative f, Distributive f, Traversable f) => Settable f
- type Over' p f s a = Over p f s s a a
- type Over p f s t a b = p a (f b) -> s -> f t
- type IndexedLensLike' i f s a = IndexedLensLike i f s s a a
- type IndexedLensLike i f s t a b = forall p. Indexable i p => p a (f b) -> s -> f t
- type LensLike' f s a = LensLike f s s a a
- type LensLike f s t a b = (a -> f b) -> s -> f t
- type Optical' p q f s a = Optical p q f s s a a
- type Optical p q f s t a b = p a (f b) -> q s (f t)
- type Optic' p f s a = Optic p f s s a a
- type Optic p f s t a b = p a (f b) -> p s (f t)
- type Simple f s a = f s s a a
- type IndexPreservingFold1 s a = forall p f. ( Conjoined p, Contravariant f, Apply f) => p a (f a) -> p s (f s)
- type IndexedFold1 i s a = forall p f. ( Indexable i p, Contravariant f, Apply f) => p a (f a) -> s -> f s
- type Fold1 s a = forall f. ( Contravariant f, Apply f) => (a -> f a) -> s -> f s
- type IndexPreservingFold s a = forall p f. ( Conjoined p, Contravariant f, Applicative f) => p a (f a) -> p s (f s)
- type IndexedFold i s a = forall p f. ( Indexable i p, Contravariant f, Applicative f) => p a (f a) -> s -> f s
- type Fold s a = forall f. ( Contravariant f, Applicative f) => (a -> f a) -> s -> f s
- type IndexPreservingGetter s a = forall p f. ( Conjoined p, Contravariant f, Functor f) => p a (f a) -> p s (f s)
- type IndexedGetter i s a = forall p f. ( Indexable i p, Contravariant f, Functor f) => p a (f a) -> s -> f s
- type Getter s a = forall f. ( Contravariant f, Functor f) => (a -> f a) -> s -> f s
- type As a = Equality' a a
- type Equality' s a = Equality s s a a
- type Equality (s :: k1) (t :: k2) (a :: k1) (b :: k2) = forall k3 (p :: k1 -> k3 -> Type ) (f :: k2 -> k3). p a (f b) -> p s (f t)
- type Prism' s a = Prism s s a a
- type Prism s t a b = forall p f. ( Choice p, Applicative f) => p a (f b) -> p s (f t)
- type AReview t b = Optic' Tagged Identity t b
- type Review t b = forall p f. ( Choice p, Bifunctor p, Settable f) => Optic' p f t b
- type Iso' s a = Iso s s a a
- type Iso s t a b = forall p f. ( Profunctor p, Functor f) => p a (f b) -> p s (f t)
- type IndexPreservingSetter' s a = IndexPreservingSetter s s a a
- type IndexPreservingSetter s t a b = forall p f. ( Conjoined p, Settable f) => p a (f b) -> p s (f t)
- type IndexedSetter' i s a = IndexedSetter i s s a a
- type IndexedSetter i s t a b = forall f p. ( Indexable i p, Settable f) => p a (f b) -> s -> f t
- type Setter' s a = Setter s s a a
- type Setter s t a b = forall f. Settable f => (a -> f b) -> s -> f t
- type IndexPreservingTraversal1' s a = IndexPreservingTraversal1 s s a a
- type IndexPreservingTraversal1 s t a b = forall p f. ( Conjoined p, Apply f) => p a (f b) -> p s (f t)
- type IndexPreservingTraversal' s a = IndexPreservingTraversal s s a a
- type IndexPreservingTraversal s t a b = forall p f. ( Conjoined p, Applicative f) => p a (f b) -> p s (f t)
- type IndexedTraversal1' i s a = IndexedTraversal1 i s s a a
- type IndexedTraversal1 i s t a b = forall p f. ( Indexable i p, Apply f) => p a (f b) -> s -> f t
- type IndexedTraversal' i s a = IndexedTraversal i s s a a
- type IndexedTraversal i s t a b = forall p f. ( Indexable i p, Applicative f) => p a (f b) -> s -> f t
- type Traversal1' s a = Traversal1 s s a a
- type Traversal1 s t a b = forall f. Apply f => (a -> f b) -> s -> f t
- type Traversal' s a = Traversal s s a a
- type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t
- type IndexPreservingLens' s a = IndexPreservingLens s s a a
- type IndexPreservingLens s t a b = forall p f. ( Conjoined p, Functor f) => p a (f b) -> p s (f t)
- type IndexedLens' i s a = IndexedLens i s s a a
- type IndexedLens i s t a b = forall f p. ( Indexable i p, Functor f) => p a (f b) -> s -> f t
- type Lens' s a = Lens s s a a
- type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
- type Setting' p s a = Setting p s s a a
- type Setting p s t a b = p a ( Identity b) -> s -> Identity t
- type AnIndexedSetter' i s a = AnIndexedSetter i s s a a
- type AnIndexedSetter i s t a b = Indexed i a ( Identity b) -> s -> Identity t
- type ASetter' s a = ASetter s s a a
- type ASetter s t a b = (a -> Identity b) -> s -> Identity t
- mapped :: Functor f => Setter (f a) (f b) a b
- lifted :: Monad m => Setter (m a) (m b) a b
- contramapped :: Contravariant f => Setter (f b) (f a) a b
- argument :: Profunctor p => Setter (p b r) (p a r) a b
- setting :: ((a -> b) -> s -> t) -> IndexPreservingSetter s t a b
- sets :: ( Profunctor p, Profunctor q, Settable f) => (p a b -> q s t) -> Optical p q f s t a b
- cloneSetter :: ASetter s t a b -> Setter s t a b
- cloneIndexPreservingSetter :: ASetter s t a b -> IndexPreservingSetter s t a b
- cloneIndexedSetter :: AnIndexedSetter i s t a b -> IndexedSetter i s t a b
- over :: ASetter s t a b -> (a -> b) -> s -> t
- set :: ASetter s t a b -> b -> s -> t
- set' :: ASetter' s a -> a -> s -> s
- assign :: MonadState s m => ASetter s s a b -> b -> m ()
- modifying :: MonadState s m => ASetter s s a b -> (a -> b) -> m ()
- scribe :: ( MonadWriter t m, Monoid s) => ASetter s t a b -> b -> m ()
- passing :: MonadWriter w m => Setter w w u v -> m (a, u -> v) -> m a
- ipassing :: MonadWriter w m => IndexedSetter i w w u v -> m (a, i -> u -> v) -> m a
- censoring :: MonadWriter w m => Setter w w u v -> (u -> v) -> m a -> m a
- icensoring :: MonadWriter w m => IndexedSetter i w w u v -> (i -> u -> v) -> m a -> m a
- locally :: MonadReader s m => ASetter s s a b -> (a -> b) -> m r -> m r
- ilocally :: MonadReader s m => AnIndexedSetter i s s a b -> (i -> a -> b) -> m r -> m r
- iover :: AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t
- iset :: AnIndexedSetter i s t a b -> (i -> b) -> s -> t
- isets :: ((i -> a -> b) -> s -> t) -> IndexedSetter i s t a b
- imodifying :: MonadState s m => AnIndexedSetter i s s a b -> (i -> a -> b) -> m ()
- assignA :: Arrow p => ASetter s t a b -> p s b -> p s t
- mapOf :: ASetter s t a b -> (a -> b) -> s -> t
- imapOf :: AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t
- type AnIndexedLens' i s a = AnIndexedLens i s s a a
- type AnIndexedLens i s t a b = Optical ( Indexed i) (->) ( Pretext ( Indexed i) a b) s t a b
- type ALens' s a = ALens s s a a
- type ALens s t a b = LensLike ( Pretext (->) a b) s t a b
- lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
- withLens :: forall s t a b rep (r :: TYPE rep). ALens s t a b -> ((s -> a) -> (s -> b -> t) -> r) -> r
- iplens :: (s -> a) -> (s -> b -> t) -> IndexPreservingLens s t a b
- ilens :: (s -> (i, a)) -> (s -> b -> t) -> IndexedLens i s t a b
- inside :: Corepresentable p => ALens s t a b -> Lens (p e s) (p e t) (p e a) (p e b)
- choosing :: Functor f => LensLike f s t a b -> LensLike f s' t' a b -> LensLike f ( Either s s') ( Either t t') a b
- chosen :: IndexPreservingLens ( Either a a) ( Either b b) a b
- alongside :: LensLike ( AlongsideLeft f b') s t a b -> LensLike ( AlongsideRight f t) s' t' a' b' -> LensLike f (s, s') (t, t') (a, a') (b, b')
- locus :: IndexedComonadStore p => Lens (p a c s) (p b c s) a b
- cloneLens :: ALens s t a b -> Lens s t a b
- cloneIndexPreservingLens :: ALens s t a b -> IndexPreservingLens s t a b
- cloneIndexedLens :: AnIndexedLens i s t a b -> IndexedLens i s t a b
- overA :: Arrow ar => LensLike ( Context a b) s t a b -> ar a b -> ar s t
- storing :: ALens s t a b -> b -> s -> t
- devoid :: Over p f Void Void a b
- united :: Lens' a ()
- head1 :: Traversable1 t => Lens' (t a) a
- last1 :: Traversable1 t => Lens' (t a) a
- fusing :: Functor f => LensLike ( Yoneda f) s t a b -> LensLike f s t a b
- class Field19 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field18 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field17 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field16 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field15 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field14 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field13 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field12 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field11 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field10 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field9 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field8 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field7 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field6 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field5 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field4 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field3 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field2 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Field1 s t a b | s -> a, t -> b, s b -> t, t a -> s where
- _1' :: Field1 s t a b => Lens s t a b
- _2' :: Field2 s t a b => Lens s t a b
- _3' :: Field3 s t a b => Lens s t a b
- _4' :: Field4 s t a b => Lens s t a b
- _5' :: Field5 s t a b => Lens s t a b
- _6' :: Field6 s t a b => Lens s t a b
- _7' :: Field7 s t a b => Lens s t a b
- _8' :: Field8 s t a b => Lens s t a b
- _9' :: Field9 s t a b => Lens s t a b
- _10' :: Field10 s t a b => Lens s t a b
- _11' :: Field11 s t a b => Lens s t a b
- _12' :: Field12 s t a b => Lens s t a b
- _13' :: Field13 s t a b => Lens s t a b
- _14' :: Field14 s t a b => Lens s t a b
- _15' :: Field15 s t a b => Lens s t a b
- _16' :: Field16 s t a b => Lens s t a b
- _17' :: Field17 s t a b => Lens s t a b
- _18' :: Field18 s t a b => Lens s t a b
- _19' :: Field19 s t a b => Lens s t a b
- type Accessing p m s a = p a ( Const m a) -> s -> Const m s
- type IndexedGetting i m s a = Indexed i a ( Const m a) -> s -> Const m s
- type Getting r s a = (a -> Const r a) -> s -> Const r s
- to :: ( Profunctor p, Contravariant f) => (s -> a) -> Optic' p f s a
- ito :: ( Indexable i p, Contravariant f) => (s -> (i, a)) -> Over' p f s a
- like :: ( Profunctor p, Contravariant f, Functor f) => a -> Optic' p f s a
- ilike :: ( Indexable i p, Contravariant f, Functor f) => i -> a -> Over' p f s a
- view :: MonadReader s m => Getting a s a -> m a
- views :: MonadReader s m => LensLike' ( Const r) s a -> (a -> r) -> m r
- use :: MonadState s m => Getting a s a -> m a
- uses :: MonadState s m => LensLike' ( Const r) s a -> (a -> r) -> m r
- listening :: MonadWriter w m => Getting u w u -> m a -> m (a, u)
- ilistening :: MonadWriter w m => IndexedGetting i (i, u) w u -> m a -> m (a, (i, u))
- listenings :: MonadWriter w m => Getting v w u -> (u -> v) -> m a -> m (a, v)
- ilistenings :: MonadWriter w m => IndexedGetting i v w u -> (i -> u -> v) -> m a -> m (a, v)
- iview :: MonadReader s m => IndexedGetting i (i, a) s a -> m (i, a)
- iviews :: MonadReader s m => IndexedGetting i r s a -> (i -> a -> r) -> m r
- iuse :: MonadState s m => IndexedGetting i (i, a) s a -> m (i, a)
- iuses :: MonadState s m => IndexedGetting i r s a -> (i -> a -> r) -> m r
- getting :: ( Profunctor p, Profunctor q, Functor f, Contravariant f) => Optical p q f s t a b -> Optical' p q f s a
- unto :: ( Profunctor p, Bifunctor p, Functor f) => (b -> t) -> Optic p f s t a b
- un :: ( Profunctor p, Bifunctor p, Functor f) => Getting a s a -> Optic' p f a s
- re :: AReview t b -> Getter b t
- review :: MonadReader b m => AReview t b -> m t
- reviews :: MonadReader b m => AReview t b -> (t -> r) -> m r
- reuse :: MonadState b m => AReview t b -> m t
- reuses :: MonadState b m => AReview t b -> (t -> r) -> m r
- reviewing :: ( Bifunctor p, Functor f) => Optic Tagged Identity s t a b -> Optic' p f t b
- type APrism' s a = APrism s s a a
- type APrism s t a b = Market a b a ( Identity b) -> Market a b s ( Identity t)
- withPrism :: APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r
- clonePrism :: APrism s t a b -> Prism s t a b
- prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
- prism' :: (b -> s) -> (s -> Maybe a) -> Prism s s a b
- outside :: Representable p => APrism s t a b -> Lens (p t r) (p s r) (p b r) (p a r)
- without :: APrism s t a b -> APrism u v c d -> Prism ( Either s u) ( Either t v) ( Either a c) ( Either b d)
- aside :: APrism s t a b -> Prism (e, s) (e, t) (e, a) (e, b)
- below :: Traversable f => APrism' s a -> Prism' (f s) (f a)
- isn't :: APrism s t a b -> s -> Bool
- matching :: APrism s t a b -> s -> Either t a
- _Left :: Prism ( Either a c) ( Either b c) a b
- _Right :: Prism ( Either c a) ( Either c b) a b
- _Just :: Prism ( Maybe a) ( Maybe b) a b
- _Nothing :: Prism' ( Maybe a) ()
- _Void :: Prism s s a Void
- only :: Eq a => a -> Prism' a ()
- nearly :: a -> (a -> Bool ) -> Prism' a ()
- _Show :: ( Read a, Show a) => Prism' String a
- folding :: Foldable f => (s -> f a) -> Fold s a
- ifolding :: ( Foldable f, Indexable i p, Contravariant g, Applicative g) => (s -> f (i, a)) -> Over p g s t a b
- foldring :: ( Contravariant f, Applicative f) => ((a -> f a -> f a) -> f a -> s -> f a) -> LensLike f s t a b
- ifoldring :: ( Indexable i p, Contravariant f, Applicative f) => ((i -> a -> f a -> f a) -> f a -> s -> f a) -> Over p f s t a b
- folded :: Foldable f => IndexedFold Int (f a) a
- folded64 :: Foldable f => IndexedFold Int64 (f a) a
- repeated :: Apply f => LensLike' f a a
- replicated :: Int -> Fold a a
- cycled :: Apply f => LensLike f s t a b -> LensLike f s t a b
- unfolded :: (b -> Maybe (a, b)) -> Fold b a
- iterated :: Apply f => (a -> a) -> LensLike' f a a
- filtered :: ( Choice p, Applicative f) => (a -> Bool ) -> Optic' p f a a
- filteredBy :: ( Indexable i p, Applicative f) => Getting ( First i) a i -> p a (f a) -> a -> f a
- takingWhile :: ( Conjoined p, Applicative f) => (a -> Bool ) -> Over p ( TakingWhile p f a a) s t a a -> Over p f s t a a
- droppingWhile :: ( Conjoined p, Profunctor q, Applicative f) => (a -> Bool ) -> Optical p q ( Compose ( State Bool ) f) s t a a -> Optical p q f s t a a
- worded :: Applicative f => IndexedLensLike' Int f String String
- lined :: Applicative f => IndexedLensLike' Int f String String
- foldMapOf :: Getting r s a -> (a -> r) -> s -> r
- foldOf :: Getting a s a -> s -> a
- foldrOf :: Getting ( Endo r) s a -> (a -> r -> r) -> r -> s -> r
- foldlOf :: Getting ( Dual ( Endo r)) s a -> (r -> a -> r) -> r -> s -> r
- toListOf :: Getting ( Endo [a]) s a -> s -> [a]
- toNonEmptyOf :: Getting ( NonEmptyDList a) s a -> s -> NonEmpty a
- andOf :: Getting All s Bool -> s -> Bool
- orOf :: Getting Any s Bool -> s -> Bool
- anyOf :: Getting Any s a -> (a -> Bool ) -> s -> Bool
- allOf :: Getting All s a -> (a -> Bool ) -> s -> Bool
- noneOf :: Getting Any s a -> (a -> Bool ) -> s -> Bool
- productOf :: Num a => Getting ( Endo ( Endo a)) s a -> s -> a
- sumOf :: Num a => Getting ( Endo ( Endo a)) s a -> s -> a
- traverseOf_ :: Functor f => Getting ( Traversed r f) s a -> (a -> f r) -> s -> f ()
- forOf_ :: Functor f => Getting ( Traversed r f) s a -> s -> (a -> f r) -> f ()
- sequenceAOf_ :: Functor f => Getting ( Traversed a f) s (f a) -> s -> f ()
- traverse1Of_ :: Functor f => Getting ( TraversedF r f) s a -> (a -> f r) -> s -> f ()
- for1Of_ :: Functor f => Getting ( TraversedF r f) s a -> s -> (a -> f r) -> f ()
- sequence1Of_ :: Functor f => Getting ( TraversedF a f) s (f a) -> s -> f ()
- mapMOf_ :: Monad m => Getting ( Sequenced r m) s a -> (a -> m r) -> s -> m ()
- forMOf_ :: Monad m => Getting ( Sequenced r m) s a -> s -> (a -> m r) -> m ()
- sequenceOf_ :: Monad m => Getting ( Sequenced a m) s (m a) -> s -> m ()
- asumOf :: Alternative f => Getting ( Endo (f a)) s (f a) -> s -> f a
- msumOf :: MonadPlus m => Getting ( Endo (m a)) s (m a) -> s -> m a
- elemOf :: Eq a => Getting Any s a -> a -> s -> Bool
- notElemOf :: Eq a => Getting All s a -> a -> s -> Bool
- concatMapOf :: Getting [r] s a -> (a -> [r]) -> s -> [r]
- concatOf :: Getting [r] s [r] -> s -> [r]
- lengthOf :: Getting ( Endo ( Endo Int )) s a -> s -> Int
- firstOf :: Getting ( Leftmost a) s a -> s -> Maybe a
- first1Of :: Getting ( First a) s a -> s -> a
- lastOf :: Getting ( Rightmost a) s a -> s -> Maybe a
- last1Of :: Getting ( Last a) s a -> s -> a
- nullOf :: Getting All s a -> s -> Bool
- notNullOf :: Getting Any s a -> s -> Bool
- maximumOf :: Ord a => Getting ( Endo ( Endo ( Maybe a))) s a -> s -> Maybe a
- maximum1Of :: Ord a => Getting ( Max a) s a -> s -> a
- minimumOf :: Ord a => Getting ( Endo ( Endo ( Maybe a))) s a -> s -> Maybe a
- minimum1Of :: Ord a => Getting ( Min a) s a -> s -> a
- maximumByOf :: Getting ( Endo ( Endo ( Maybe a))) s a -> (a -> a -> Ordering ) -> s -> Maybe a
- minimumByOf :: Getting ( Endo ( Endo ( Maybe a))) s a -> (a -> a -> Ordering ) -> s -> Maybe a
- findOf :: Getting ( Endo ( Maybe a)) s a -> (a -> Bool ) -> s -> Maybe a
- findMOf :: Monad m => Getting ( Endo (m ( Maybe a))) s a -> (a -> m Bool ) -> s -> m ( Maybe a)
- lookupOf :: Eq k => Getting ( Endo ( Maybe v)) s (k, v) -> k -> s -> Maybe v
- foldr1Of :: HasCallStack => Getting ( Endo ( Maybe a)) s a -> (a -> a -> a) -> s -> a
- foldl1Of :: HasCallStack => Getting ( Dual ( Endo ( Maybe a))) s a -> (a -> a -> a) -> s -> a
- foldrOf' :: Getting ( Dual ( Endo ( Endo r))) s a -> (a -> r -> r) -> r -> s -> r
- foldlOf' :: Getting ( Endo ( Endo r)) s a -> (r -> a -> r) -> r -> s -> r
- foldr1Of' :: HasCallStack => Getting ( Dual ( Endo ( Endo ( Maybe a)))) s a -> (a -> a -> a) -> s -> a
- foldl1Of' :: HasCallStack => Getting ( Endo ( Endo ( Maybe a))) s a -> (a -> a -> a) -> s -> a
- foldrMOf :: Monad m => Getting ( Dual ( Endo (r -> m r))) s a -> (a -> r -> m r) -> r -> s -> m r
- foldlMOf :: Monad m => Getting ( Endo (r -> m r)) s a -> (r -> a -> m r) -> r -> s -> m r
- has :: Getting Any s a -> s -> Bool
- hasn't :: Getting All s a -> s -> Bool
- pre :: Getting ( First a) s a -> IndexPreservingGetter s ( Maybe a)
- ipre :: IndexedGetting i ( First (i, a)) s a -> IndexPreservingGetter s ( Maybe (i, a))
- preview :: MonadReader s m => Getting ( First a) s a -> m ( Maybe a)
- ipreview :: MonadReader s m => IndexedGetting i ( First (i, a)) s a -> m ( Maybe (i, a))
- previews :: MonadReader s m => Getting ( First r) s a -> (a -> r) -> m ( Maybe r)
- ipreviews :: MonadReader s m => IndexedGetting i ( First r) s a -> (i -> a -> r) -> m ( Maybe r)
- preuse :: MonadState s m => Getting ( First a) s a -> m ( Maybe a)
- ipreuse :: MonadState s m => IndexedGetting i ( First (i, a)) s a -> m ( Maybe (i, a))
- preuses :: MonadState s m => Getting ( First r) s a -> (a -> r) -> m ( Maybe r)
- ipreuses :: MonadState s m => IndexedGetting i ( First r) s a -> (i -> a -> r) -> m ( Maybe r)
- backwards :: ( Profunctor p, Profunctor q) => Optical p q ( Backwards f) s t a b -> Optical p q f s t a b
- ifoldMapOf :: IndexedGetting i m s a -> (i -> a -> m) -> s -> m
- ifoldrOf :: IndexedGetting i ( Endo r) s a -> (i -> a -> r -> r) -> r -> s -> r
- ifoldlOf :: IndexedGetting i ( Dual ( Endo r)) s a -> (i -> r -> a -> r) -> r -> s -> r
- ianyOf :: IndexedGetting i Any s a -> (i -> a -> Bool ) -> s -> Bool
- iallOf :: IndexedGetting i All s a -> (i -> a -> Bool ) -> s -> Bool
- inoneOf :: IndexedGetting i Any s a -> (i -> a -> Bool ) -> s -> Bool
- itraverseOf_ :: Functor f => IndexedGetting i ( Traversed r f) s a -> (i -> a -> f r) -> s -> f ()
- iforOf_ :: Functor f => IndexedGetting i ( Traversed r f) s a -> s -> (i -> a -> f r) -> f ()
- imapMOf_ :: Monad m => IndexedGetting i ( Sequenced r m) s a -> (i -> a -> m r) -> s -> m ()
- iforMOf_ :: Monad m => IndexedGetting i ( Sequenced r m) s a -> s -> (i -> a -> m r) -> m ()
- iconcatMapOf :: IndexedGetting i [r] s a -> (i -> a -> [r]) -> s -> [r]
- ifindOf :: IndexedGetting i ( Endo ( Maybe a)) s a -> (i -> a -> Bool ) -> s -> Maybe a
- ifindMOf :: Monad m => IndexedGetting i ( Endo (m ( Maybe a))) s a -> (i -> a -> m Bool ) -> s -> m ( Maybe a)
- ifoldrOf' :: IndexedGetting i ( Dual ( Endo (r -> r))) s a -> (i -> a -> r -> r) -> r -> s -> r
- ifoldlOf' :: IndexedGetting i ( Endo (r -> r)) s a -> (i -> r -> a -> r) -> r -> s -> r
- ifoldrMOf :: Monad m => IndexedGetting i ( Dual ( Endo (r -> m r))) s a -> (i -> a -> r -> m r) -> r -> s -> m r
- ifoldlMOf :: Monad m => IndexedGetting i ( Endo (r -> m r)) s a -> (i -> r -> a -> m r) -> r -> s -> m r
- itoListOf :: IndexedGetting i ( Endo [(i, a)]) s a -> s -> [(i, a)]
- elemIndexOf :: Eq a => IndexedGetting i ( First i) s a -> a -> s -> Maybe i
- elemIndicesOf :: Eq a => IndexedGetting i ( Endo [i]) s a -> a -> s -> [i]
- findIndexOf :: IndexedGetting i ( First i) s a -> (a -> Bool ) -> s -> Maybe i
- findIndicesOf :: IndexedGetting i ( Endo [i]) s a -> (a -> Bool ) -> s -> [i]
- ifiltered :: ( Indexable i p, Applicative f) => (i -> a -> Bool ) -> Optical' p ( Indexed i) f a a
- itakingWhile :: ( Indexable i p, Profunctor q, Contravariant f, Applicative f) => (i -> a -> Bool ) -> Optical' ( Indexed i) q ( Const ( Endo (f s))) s a -> Optical' p q f s a
- idroppingWhile :: ( Indexable i p, Profunctor q, Applicative f) => (i -> a -> Bool ) -> Optical ( Indexed i) q ( Compose ( State Bool ) f) s t a a -> Optical p q f s t a a
- foldByOf :: Fold s a -> (a -> a -> a) -> a -> s -> a
- foldMapByOf :: Fold s a -> (r -> r -> r) -> r -> (a -> r) -> s -> r
-
class
Ord
k =>
TraverseMax
k m | m -> k
where
- traverseMax :: IndexedTraversal' k (m v) v
-
class
Ord
k =>
TraverseMin
k m | m -> k
where
- traverseMin :: IndexedTraversal' k (m v) v
- type Traversing1' p f s a = Traversing1 p f s s a a
- type Traversing' p f s a = Traversing p f s s a a
- type Traversing1 p f s t a b = Over p ( BazaarT1 p f a b) s t a b
- type Traversing p f s t a b = Over p ( BazaarT p f a b) s t a b
- type AnIndexedTraversal1' i s a = AnIndexedTraversal1 i s s a a
- type AnIndexedTraversal' i s a = AnIndexedTraversal i s s a a
- type AnIndexedTraversal1 i s t a b = Over ( Indexed i) ( Bazaar1 ( Indexed i) a b) s t a b
- type AnIndexedTraversal i s t a b = Over ( Indexed i) ( Bazaar ( Indexed i) a b) s t a b
- type ATraversal1' s a = ATraversal1 s s a a
- type ATraversal1 s t a b = LensLike ( Bazaar1 (->) a b) s t a b
- type ATraversal' s a = ATraversal s s a a
- type ATraversal s t a b = LensLike ( Bazaar (->) a b) s t a b
- traverseOf :: LensLike f s t a b -> (a -> f b) -> s -> f t
- forOf :: LensLike f s t a b -> s -> (a -> f b) -> f t
- sequenceAOf :: LensLike f s t (f b) b -> s -> f t
- mapMOf :: LensLike ( WrappedMonad m) s t a b -> (a -> m b) -> s -> m t
- forMOf :: LensLike ( WrappedMonad m) s t a b -> s -> (a -> m b) -> m t
- sequenceOf :: LensLike ( WrappedMonad m) s t (m b) b -> s -> m t
- transposeOf :: LensLike ZipList s t [a] a -> s -> [t]
- mapAccumROf :: LensLike ( Backwards ( State acc)) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
- mapAccumLOf :: LensLike ( State acc) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
- scanr1Of :: LensLike ( Backwards ( State ( Maybe a))) s t a a -> (a -> a -> a) -> s -> t
- scanl1Of :: LensLike ( State ( Maybe a)) s t a a -> (a -> a -> a) -> s -> t
- loci :: Traversal ( Bazaar (->) a c s) ( Bazaar (->) b c s) a b
- iloci :: IndexedTraversal i ( Bazaar ( Indexed i) a c s) ( Bazaar ( Indexed i) b c s) a b
- partsOf :: Functor f => Traversing (->) f s t a a -> LensLike f s t [a] [a]
- ipartsOf :: forall i p f s t a. ( Indexable [i] p, Functor f) => Traversing ( Indexed i) f s t a a -> Over p f s t [a] [a]
- partsOf' :: ATraversal s t a a -> Lens s t [a] [a]
- ipartsOf' :: forall i p f s t a. ( Indexable [i] p, Functor f) => Over ( Indexed i) ( Bazaar' ( Indexed i) a) s t a a -> Over p f s t [a] [a]
- unsafePartsOf :: Functor f => Traversing (->) f s t a b -> LensLike f s t [a] [b]
- iunsafePartsOf :: forall i p f s t a b. ( Indexable [i] p, Functor f) => Traversing ( Indexed i) f s t a b -> Over p f s t [a] [b]
- unsafePartsOf' :: ATraversal s t a b -> Lens s t [a] [b]
- iunsafePartsOf' :: forall i s t a b. Over ( Indexed i) ( Bazaar ( Indexed i) a b) s t a b -> IndexedLens [i] s t [a] [b]
- singular :: ( HasCallStack , Conjoined p, Functor f) => Traversing p f s t a a -> Over p f s t a a
- unsafeSingular :: ( HasCallStack , Conjoined p, Functor f) => Traversing p f s t a b -> Over p f s t a b
- holesOf :: Conjoined p => Over p ( Bazaar p a a) s t a a -> s -> [ Pretext p a a t]
- holes1Of :: Conjoined p => Over p ( Bazaar1 p a a) s t a a -> s -> NonEmpty ( Pretext p a a t)
- both :: Bitraversable r => Traversal (r a a) (r b b) a b
- both1 :: Bitraversable1 r => Traversal1 (r a a) (r b b) a b
- beside :: ( Representable q, Applicative ( Rep q), Applicative f, Bitraversable r) => Optical p q f s t a b -> Optical p q f s' t' a b -> Optical p q f (r s s') (r t t') a b
- taking :: ( Conjoined p, Applicative f) => Int -> Traversing p f s t a a -> Over p f s t a a
- dropping :: ( Conjoined p, Applicative f) => Int -> Over p ( Indexing f) s t a a -> Over p f s t a a
- cloneTraversal :: ATraversal s t a b -> Traversal s t a b
- cloneIndexPreservingTraversal :: ATraversal s t a b -> IndexPreservingTraversal s t a b
- cloneIndexedTraversal :: AnIndexedTraversal i s t a b -> IndexedTraversal i s t a b
- cloneTraversal1 :: ATraversal1 s t a b -> Traversal1 s t a b
- cloneIndexPreservingTraversal1 :: ATraversal1 s t a b -> IndexPreservingTraversal1 s t a b
- cloneIndexedTraversal1 :: AnIndexedTraversal1 i s t a b -> IndexedTraversal1 i s t a b
- itraverseOf :: ( Indexed i a (f b) -> s -> f t) -> (i -> a -> f b) -> s -> f t
- iforOf :: ( Indexed i a (f b) -> s -> f t) -> s -> (i -> a -> f b) -> f t
- imapMOf :: Over ( Indexed i) ( WrappedMonad m) s t a b -> (i -> a -> m b) -> s -> m t
- iforMOf :: ( Indexed i a ( WrappedMonad m b) -> s -> WrappedMonad m t) -> s -> (i -> a -> m b) -> m t
- imapAccumROf :: Over ( Indexed i) ( Backwards ( State acc)) s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
- imapAccumLOf :: Over ( Indexed i) ( State acc) s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
- traversed :: Traversable f => IndexedTraversal Int (f a) (f b) a b
- traversed1 :: Traversable1 f => IndexedTraversal1 Int (f a) (f b) a b
- traversed64 :: Traversable f => IndexedTraversal Int64 (f a) (f b) a b
- ignored :: Applicative f => pafb -> s -> f s
- elementOf :: Applicative f => LensLike ( Indexing f) s t a a -> Int -> IndexedLensLike Int f s t a a
- element :: Traversable t => Int -> IndexedTraversal' Int (t a) a
- elementsOf :: Applicative f => LensLike ( Indexing f) s t a a -> ( Int -> Bool ) -> IndexedLensLike Int f s t a a
- elements :: Traversable t => ( Int -> Bool ) -> IndexedTraversal' Int (t a) a
- failover :: Alternative m => LensLike ( (,) Any ) s t a b -> (a -> b) -> s -> m t
- ifailover :: Alternative m => Over ( Indexed i) ( (,) Any ) s t a b -> (i -> a -> b) -> s -> m t
- failing :: ( Conjoined p, Applicative f) => Traversing p f s t a b -> Over p f s t a b -> Over p f s t a b
- deepOf :: ( Conjoined p, Applicative f) => LensLike f s t s t -> Traversing p f s t a b -> Over p f s t a b
- confusing :: Applicative f => LensLike ( Curried ( Yoneda f) ( Yoneda f)) s t a b -> LensLike f s t a b
- traverseByOf :: Traversal s t a b -> ( forall x. x -> f x) -> ( forall x y. f (x -> y) -> f x -> f y) -> (a -> f b) -> s -> f t
- sequenceByOf :: Traversal s t (f b) b -> ( forall x. x -> f x) -> ( forall x y. f (x -> y) -> f x -> f y) -> s -> f t
- levels :: Applicative f => Traversing (->) f s t a b -> IndexedLensLike Int f s t ( Level () a) ( Level () b)
- ilevels :: Applicative f => Traversing ( Indexed i) f s t a b -> IndexedLensLike Int f s t ( Level i a) ( Level j b)
- type ReifiedPrism' s a = ReifiedPrism s s a a
- newtype ReifiedPrism s t a b = Prism { }
- type ReifiedIso' s a = ReifiedIso s s a a
- newtype ReifiedIso s t a b = Iso { }
- type ReifiedIndexedSetter' i s a = ReifiedIndexedSetter i s s a a
-
newtype
ReifiedIndexedSetter
i s t a b =
IndexedSetter
{
- runIndexedSetter :: IndexedSetter i s t a b
- type ReifiedSetter' s a = ReifiedSetter s s a a
- newtype ReifiedSetter s t a b = Setter { }
-
newtype
ReifiedIndexedFold
i s a =
IndexedFold
{
- runIndexedFold :: IndexedFold i s a
- newtype ReifiedFold s a = Fold { }
-
newtype
ReifiedIndexedGetter
i s a =
IndexedGetter
{
- runIndexedGetter :: IndexedGetter i s a
- newtype ReifiedGetter s a = Getter { }
- type ReifiedTraversal' s a = ReifiedTraversal s s a a
-
newtype
ReifiedTraversal
s t a b =
Traversal
{
- runTraversal :: Traversal s t a b
- type ReifiedIndexedTraversal' i s a = ReifiedIndexedTraversal i s s a a
-
newtype
ReifiedIndexedTraversal
i s t a b =
IndexedTraversal
{
- runIndexedTraversal :: IndexedTraversal i s t a b
- type ReifiedIndexedLens' i s a = ReifiedIndexedLens i s s a a
-
newtype
ReifiedIndexedLens
i s t a b =
IndexedLens
{
- runIndexedLens :: IndexedLens i s t a b
- type ReifiedLens' s a = ReifiedLens s s a a
- newtype ReifiedLens s t a b = Lens { }
- selfIndex :: Indexable a p => p a fb -> a -> fb
- reindexed :: Indexable j p => (i -> j) -> ( Indexed i a b -> r) -> p a b -> r
- icompose :: Indexable p c => (i -> j -> p) -> ( Indexed i s t -> r) -> ( Indexed j a b -> s -> t) -> c a b -> r
- indices :: ( Indexable i p, Applicative f) => (i -> Bool ) -> Optical' p ( Indexed i) f a a
- index :: ( Indexable i p, Eq i, Applicative f) => i -> Optical' p ( Indexed i) f a a
- imapped :: FunctorWithIndex i f => IndexedSetter i (f a) (f b) a b
- ifolded :: FoldableWithIndex i f => IndexedFold i (f a) a
- itraversed :: TraversableWithIndex i t => IndexedTraversal i (t a) (t b) a b
- ifoldMapBy :: FoldableWithIndex i t => (r -> r -> r) -> r -> (i -> a -> r) -> t a -> r
- ifoldMapByOf :: IndexedFold i t a -> (r -> r -> r) -> r -> (i -> a -> r) -> t -> r
- itraverseBy :: TraversableWithIndex i t => ( forall x. x -> f x) -> ( forall x y. f (x -> y) -> f x -> f y) -> (i -> a -> f b) -> t a -> f (t b)
- itraverseByOf :: IndexedTraversal i s t a b -> ( forall x. x -> f x) -> ( forall x y. f (x -> y) -> f x -> f y) -> (i -> a -> f b) -> s -> f t
- type AnEquality' s a = AnEquality s s a a
- type AnEquality s t a b = Identical a ( Proxy b) a ( Proxy b) -> Identical a ( Proxy b) s ( Proxy t)
- data Identical a b s t where
- runEq :: AnEquality s t a b -> Identical s t a b
- substEq :: forall s t a b rep (r :: TYPE rep). AnEquality s t a b -> ((s ~ a, t ~ b) => r) -> r
- mapEq :: forall k1 k2 (s :: k1) (t :: k2) (a :: k1) (b :: k2) (f :: k1 -> Type ). AnEquality s t a b -> f s -> f a
- fromEq :: AnEquality s t a b -> Equality b a t s
- simply :: forall p f s a rep (r :: TYPE rep). ( Optic' p f s a -> r) -> Optic' p f s a -> r
- simple :: Equality' a a
- cloneEquality :: AnEquality s t a b -> Equality s t a b
- equality :: (s :~: a) -> (b :~: t) -> Equality s t a b
- equality' :: (a :~: b) -> Equality' a b
- overEquality :: AnEquality s t a b -> p a b -> p s t
- underEquality :: AnEquality s t a b -> p t s -> p b a
- fromLeibniz :: ( Identical a b a b -> Identical a b s t) -> Equality s t a b
- fromLeibniz' :: ((s :~: s) -> s :~: a) -> Equality' s a
- withEquality :: forall s t a b rep (r :: TYPE rep). AnEquality s t a b -> ((s :~: a) -> (b :~: t) -> r) -> r
- type AnIso' s a = AnIso s s a a
- type AnIso s t a b = Exchange a b a ( Identity b) -> Exchange a b s ( Identity t)
- pattern List :: IsList l => [ Item l] -> l
- pattern Reversed :: Reversing t => t -> t
- pattern Swapped :: forall p c d. Swap p => p d c -> p c d
- pattern Lazy :: Strict t s => t -> s
- pattern Strict :: Strict s t => t -> s
- iso :: (s -> a) -> (b -> t) -> Iso s t a b
- from :: AnIso s t a b -> Iso b a t s
- withIso :: forall s t a b rep (r :: TYPE rep). AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r
- cloneIso :: AnIso s t a b -> Iso s t a b
- au :: Functor f => AnIso s t a b -> ((b -> t) -> f s) -> f a
- auf :: ( Functor f, Functor g) => AnIso s t a b -> (f t -> g s) -> f b -> g a
- xplat :: Optic ( Costar ((->) s)) g s t a b -> ((s -> a) -> g b) -> g t
- xplatf :: Optic ( Costar f) g s t a b -> (f a -> g b) -> f s -> g t
- under :: AnIso s t a b -> (t -> s) -> b -> a
- enum :: Enum a => Iso' Int a
- mapping :: ( Functor f, Functor g) => AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
- non :: Eq a => a -> Iso' ( Maybe a) a
- non' :: APrism' a () -> Iso' ( Maybe a) a
- anon :: a -> (a -> Bool ) -> Iso' ( Maybe a) a
- curried :: Iso ((a, b) -> c) ((d, e) -> f) (a -> b -> c) (d -> e -> f)
- uncurried :: Iso (a -> b -> c) (d -> e -> f) ((a, b) -> c) ((d, e) -> f)
- flipped :: Iso (a -> b -> c) (a' -> b' -> c') (b -> a -> c) (b' -> a' -> c')
- swapped :: Swap p => Iso (p a b) (p c d) (p b a) (p d c)
- strict :: Strict lazy strict => Iso' lazy strict
- lazy :: Strict lazy strict => Iso' strict lazy
- reversed :: Reversing a => Iso' a a
- involuted :: (a -> a) -> Iso' a a
- magma :: LensLike ( Mafic a b) s t a b -> Iso s u ( Magma Int t b a) ( Magma j u c c)
- imagma :: Over ( Indexed i) ( Molten i a b) s t a b -> Iso s t' ( Magma i t b a) ( Magma j t' c c)
- contramapping :: Contravariant f => AnIso s t a b -> Iso (f a) (f b) (f s) (f t)
- dimapping :: ( Profunctor p, Profunctor q) => AnIso s t a b -> AnIso s' t' a' b' -> Iso (p a s') (q b t') (p s a') (q t b')
- lmapping :: ( Profunctor p, Profunctor q) => AnIso s t a b -> Iso (p a x) (q b y) (p s x) (q t y)
- rmapping :: ( Profunctor p, Profunctor q) => AnIso s t a b -> Iso (p x s) (q y t) (p x a) (q y b)
- bimapping :: ( Bifunctor f, Bifunctor g) => AnIso s t a b -> AnIso s' t' a' b' -> Iso (f s s') (g t t') (f a a') (g b b')
- firsting :: ( Bifunctor f, Bifunctor g) => AnIso s t a b -> Iso (f s x) (g t y) (f a x) (g b y)
- seconding :: ( Bifunctor f, Bifunctor g) => AnIso s t a b -> Iso (f x s) (g y t) (f x a) (g y b)
- coerced :: forall s t a b. ( Coercible s a, Coercible t b) => Iso s t a b
- class AsEmpty a where
- pattern Empty :: AsEmpty s => s
- class Snoc s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Cons s t a b | s -> a, t -> b, s b -> t, t a -> s where
- cons :: Cons s s a a => a -> s -> s
- uncons :: Cons s s a a => s -> Maybe (a, s)
- _head :: Cons s s a a => Traversal' s a
- _tail :: Cons s s a a => Traversal' s s
- _init :: Snoc s s a a => Traversal' s s
- _last :: Snoc s s a a => Traversal' s a
- snoc :: Snoc s s a a => s -> a -> s
- unsnoc :: Snoc s s a a => s -> Maybe (s, a)
- class ( Rewrapped s t, Rewrapped t s) => Rewrapping s t
- class Wrapped s => Rewrapped (s :: *) (t :: *)
- class Wrapped s where
- pattern Unwrapped :: Rewrapped t t => t -> Unwrapped t
- pattern Wrapped :: Rewrapped s s => Unwrapped s -> s
- _GWrapped' :: ( Generic s, D1 d ( C1 c ( S1 s' ( Rec0 a))) ~ Rep s, Unwrapped s ~ GUnwrapped ( Rep s)) => Iso' s ( Unwrapped s)
- _Unwrapped' :: Wrapped s => Iso' ( Unwrapped s) s
- _Wrapped :: Rewrapping s t => Iso s t ( Unwrapped s) ( Unwrapped t)
- _Unwrapped :: Rewrapping s t => Iso ( Unwrapped t) ( Unwrapped s) t s
- op :: Wrapped s => ( Unwrapped s -> s) -> s -> Unwrapped s
- _Wrapping' :: Wrapped s => ( Unwrapped s -> s) -> Iso' s ( Unwrapped s)
- _Unwrapping' :: Wrapped s => ( Unwrapped s -> s) -> Iso' ( Unwrapped s) s
- _Wrapping :: Rewrapping s t => ( Unwrapped s -> s) -> Iso s t ( Unwrapped s) ( Unwrapped t)
- _Unwrapping :: Rewrapping s t => ( Unwrapped s -> s) -> Iso ( Unwrapped t) ( Unwrapped s) t s
- ala :: ( Functor f, Rewrapping s t) => ( Unwrapped s -> s) -> (( Unwrapped t -> t) -> f s) -> f ( Unwrapped s)
- alaf :: ( Functor f, Functor g, Rewrapping s t) => ( Unwrapped s -> s) -> (f t -> g s) -> f ( Unwrapped t) -> g ( Unwrapped s)
- class ( Magnified m ~ Magnified n, MonadReader b m, MonadReader a n) => Magnify m n b a | m -> b, n -> a, m a -> n, n b -> m where
- class ( MonadState s m, MonadState t n) => Zoom m n s t | m -> s, n -> t, m t -> n, n s -> m where
- type family Magnified (m :: * -> *) :: * -> * -> *
- type family Zoomed (m :: * -> *) :: * -> * -> *
- class GPlated1 f g
- class GPlated a g
-
class
Plated
a
where
- plate :: Traversal' a a
- deep :: ( Conjoined p, Applicative f, Plated s) => Traversing p f s s a b -> Over p f s s a b
- children :: Plated a => a -> [a]
- rewrite :: Plated a => (a -> Maybe a) -> a -> a
- rewriteOf :: ASetter a b a b -> (b -> Maybe a) -> a -> b
- rewriteOn :: Plated a => ASetter s t a a -> (a -> Maybe a) -> s -> t
- rewriteOnOf :: ASetter s t a b -> ASetter a b a b -> (b -> Maybe a) -> s -> t
- rewriteM :: ( Monad m, Plated a) => (a -> m ( Maybe a)) -> a -> m a
- rewriteMOf :: Monad m => LensLike ( WrappedMonad m) a b a b -> (b -> m ( Maybe a)) -> a -> m b
- rewriteMOn :: ( Monad m, Plated a) => LensLike ( WrappedMonad m) s t a a -> (a -> m ( Maybe a)) -> s -> m t
- rewriteMOnOf :: Monad m => LensLike ( WrappedMonad m) s t a b -> LensLike ( WrappedMonad m) a b a b -> (b -> m ( Maybe a)) -> s -> m t
- universe :: Plated a => a -> [a]
- universeOf :: Getting [a] a a -> a -> [a]
- universeOn :: Plated a => Getting [a] s a -> s -> [a]
- universeOnOf :: Getting [a] s a -> Getting [a] a a -> s -> [a]
- cosmos :: Plated a => Fold a a
- cosmosOf :: ( Applicative f, Contravariant f) => LensLike' f a a -> LensLike' f a a
- cosmosOn :: ( Applicative f, Contravariant f, Plated a) => LensLike' f s a -> LensLike' f s a
- cosmosOnOf :: ( Applicative f, Contravariant f) => LensLike' f s a -> LensLike' f a a -> LensLike' f s a
- transform :: Plated a => (a -> a) -> a -> a
- transformOn :: Plated a => ASetter s t a a -> (a -> a) -> s -> t
- transformOf :: ASetter a b a b -> (b -> b) -> a -> b
- transformOnOf :: ASetter s t a b -> ASetter a b a b -> (b -> b) -> s -> t
- transformM :: ( Monad m, Plated a) => (a -> m a) -> a -> m a
- transformMOn :: ( Monad m, Plated a) => LensLike ( WrappedMonad m) s t a a -> (a -> m a) -> s -> m t
- transformMOf :: Monad m => LensLike ( WrappedMonad m) a b a b -> (b -> m b) -> a -> m b
- transformMOnOf :: Monad m => LensLike ( WrappedMonad m) s t a b -> LensLike ( WrappedMonad m) a b a b -> (b -> m b) -> s -> m t
- contexts :: Plated a => a -> [ Context a a a]
- contextsOf :: ATraversal' a a -> a -> [ Context a a a]
- contextsOn :: Plated a => ATraversal s t a a -> s -> [ Context a a t]
- contextsOnOf :: ATraversal s t a a -> ATraversal' a a -> s -> [ Context a a t]
- holes :: Plated a => a -> [ Pretext (->) a a a]
- holesOn :: Conjoined p => Over p ( Bazaar p a a) s t a a -> s -> [ Pretext p a a t]
- holesOnOf :: Conjoined p => LensLike ( Bazaar p r r) s t a b -> Over p ( Bazaar p r r) a b r r -> s -> [ Pretext p r r t]
- paraOf :: Getting ( Endo [a]) a a -> (a -> [r] -> r) -> a -> r
- para :: Plated a => (a -> [r] -> r) -> a -> r
- composOpFold :: Plated a => b -> (b -> b -> b) -> (a -> b) -> a -> b
- parts :: Plated a => Lens' a [a]
- gplate :: ( Generic a, GPlated a ( Rep a)) => Traversal' a a
- gplate1 :: ( Generic1 f, GPlated1 f ( Rep1 f)) => Traversal' (f a) (f a)
- class Each s t a b | s -> a, t -> b, s b -> t, t a -> s where
- class Ixed m => At m where
-
class
Ixed
m
where
- ix :: Index m -> Traversal' m ( IxValue m)
- type family IxValue (m :: *) :: *
- class Contains m where
- type family Index (s :: *) :: *
- icontains :: Contains m => Index m -> IndexedLens' ( Index m) m Bool
- iix :: Ixed m => Index m -> IndexedTraversal' ( Index m) m ( IxValue m)
- ixAt :: At m => Index m -> Traversal' m ( IxValue m)
- sans :: At m => Index m -> m -> m
- iat :: At m => Index m -> IndexedLens' ( Index m) m ( Maybe ( IxValue m))
- makePrisms :: Name -> DecsQ
- makeClassyPrisms :: Name -> DecsQ
- type ClassyNamer = Name -> Maybe ( Name , Name )
-
data
DefName
- = TopName Name
- | MethodName Name Name
- type FieldNamer = Name -> [ Name ] -> Name -> [ DefName ]
- data LensRules
- simpleLenses :: Lens' LensRules Bool
- generateSignatures :: Lens' LensRules Bool
- generateUpdateableOptics :: Lens' LensRules Bool
- generateLazyPatterns :: Lens' LensRules Bool
- createClass :: Lens' LensRules Bool
- lensField :: Lens' LensRules FieldNamer
- lensClass :: Lens' LensRules ClassyNamer
- lensRules :: LensRules
- underscoreNoPrefixNamer :: FieldNamer
- lensRulesFor :: [( String , String )] -> LensRules
- lookingupNamer :: [( String , String )] -> FieldNamer
- mappingNamer :: ( String -> [ String ]) -> FieldNamer
- classyRules :: LensRules
- classyRules_ :: LensRules
- makeLenses :: Name -> DecsQ
- makeClassy :: Name -> DecsQ
- makeClassy_ :: Name -> DecsQ
- makeLensesFor :: [( String , String )] -> Name -> DecsQ
- makeClassyFor :: String -> String -> [( String , String )] -> Name -> DecsQ
- makeLensesWith :: LensRules -> Name -> DecsQ
- declareLenses :: DecsQ -> DecsQ
- declareLensesFor :: [( String , String )] -> DecsQ -> DecsQ
- declareClassy :: DecsQ -> DecsQ
- declareClassyFor :: [( String , ( String , String ))] -> [( String , String )] -> DecsQ -> DecsQ
- declarePrisms :: DecsQ -> DecsQ
- declareWrapped :: DecsQ -> DecsQ
- declareFields :: DecsQ -> DecsQ
- declareLensesWith :: LensRules -> DecsQ -> DecsQ
- makeWrapped :: Name -> DecsQ
- underscoreFields :: LensRules
- underscoreNamer :: FieldNamer
- camelCaseFields :: LensRules
- camelCaseNamer :: FieldNamer
- classUnderscoreNoPrefixFields :: LensRules
- classUnderscoreNoPrefixNamer :: FieldNamer
- abbreviatedFields :: LensRules
- abbreviatedNamer :: FieldNamer
- makeFields :: Name -> DecsQ
- makeFieldsNoPrefix :: Name -> DecsQ
- defaultFieldRules :: LensRules
Documentation
class ( Functor t, Foldable t) => Traversable (t :: Type -> Type ) where Source #
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 transformationtraverse
f =traverse
(t . f)t
- Identity
-
traverse
Identity
=Identity
- Composition
-
traverse
(Compose
.fmap
g . f) =Compose
.fmap
(traverse
g) .traverse
f
A definition of
sequenceA
must satisfy the following laws:
- Naturality
-
t .
for every applicative transformationsequenceA
=sequenceA
.fmap
tt
- Identity
-
sequenceA
.fmap
Identity
=Identity
- Composition
-
sequenceA
.fmap
Compose
=Compose
.fmap
sequenceA
.sequenceA
where an applicative transformation is a function
t :: (Applicative f, Applicative g) => f a -> g a
preserving the
Applicative
operations, i.e.
t (pure
x) =pure
x t (f<*>
x) = t f<*>
t x
and the identity functor
Identity
and composition functors
Compose
are from
Data.Functor.Identity
and
Data.Functor.Compose
.
A result of the naturality law is a purity law for
traverse
traverse
pure
=pure
(The naturality law is implied by parametricity and thus so is the purity law [1, p15].)
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
Functor
instance,fmap
should be equivalent to traversal with the identity applicative functor (fmapDefault
). -
In the
Foldable
instance,foldMap
should be equivalent to traversal with a constant applicative functor (foldMapDefault
).
References: [1] The Essence of the Iterator Pattern, Jeremy Gibbons and Bruno C. d. S. Oliveira
traverse :: Applicative f => (a -> f b) -> t a -> f (t b) Source #
Map each element of a structure to an action, evaluate these actions
from left to right, and collect the results. For a version that ignores
the results see
traverse_
.
Instances
Traversable [] |
Since: base-2.1 |
Traversable Maybe |
Since: base-2.1 |
Traversable Par1 |
Since: base-4.9.0.0 |
Traversable Solo | |
Traversable Complex |
Since: base-4.9.0.0 |
Defined in Data.Complex |
|
Traversable Min |
Since: base-4.9.0.0 |
Traversable Max |
Since: base-4.9.0.0 |
Traversable First |
Since: base-4.9.0.0 |
Traversable Last |
Since: base-4.9.0.0 |
Traversable Option |
Since: base-4.9.0.0 |
Defined in Data.Semigroup |
|
Traversable ZipList |
Since: base-4.9.0.0 |
Defined in Data.Traversable |
|
Traversable Identity |
Since: base-4.9.0.0 |
Defined in Data.Traversable |
|
Traversable First |
Since: base-4.8.0.0 |
Traversable Last |
Since: base-4.8.0.0 |
Traversable Dual |
Since: base-4.8.0.0 |
Traversable Sum |
Since: base-4.8.0.0 |
Traversable Product |
Since: base-4.8.0.0 |
Defined in Data.Traversable |
|
Traversable Down |
Since: base-4.12.0.0 |
Traversable NonEmpty |
Since: base-4.9.0.0 |
Defined in Data.Traversable |
|
Traversable IntMap |
Traverses in order of increasing key. |
Defined in Data.IntMap.Internal |
|
Traversable Tree | |
Traversable Seq | |
Traversable FingerTree | |
Defined in Data.Sequence.Internal traverse :: Applicative f => (a -> f b) -> FingerTree a -> f ( FingerTree b) Source # sequenceA :: Applicative f => FingerTree (f a) -> f ( FingerTree a) Source # mapM :: Monad m => (a -> m b) -> FingerTree a -> m ( FingerTree b) Source # sequence :: Monad m => FingerTree (m a) -> m ( FingerTree a) Source # |
|
Traversable Digit | |
Defined in Data.Sequence.Internal |
|
Traversable Node | |
Traversable Elem | |
Traversable ViewL | |
Defined in Data.Sequence.Internal |
|
Traversable ViewR | |
Defined in Data.Sequence.Internal |
|
Traversable SmallArray | |
Defined in Data.Primitive.SmallArray traverse :: Applicative f => (a -> f b) -> SmallArray a -> f ( SmallArray b) Source # sequenceA :: Applicative f => SmallArray (f a) -> f ( SmallArray a) Source # mapM :: Monad m => (a -> m b) -> SmallArray a -> m ( SmallArray b) Source # sequence :: Monad m => SmallArray (m a) -> m ( SmallArray a) Source # |
|
Traversable Array | |
Defined in Data.Primitive.Array |
|
Traversable Maybe | |
Traversable Vector | |
Traversable Deque Source # | |
Defined in Control.Lens.Internal.Deque |
|
Traversable ( Either a) |
Since: base-4.7.0.0 |
Defined in Data.Traversable traverse :: Applicative f => (a0 -> f b) -> Either a a0 -> f ( Either a b) Source # sequenceA :: Applicative f => Either a (f a0) -> f ( Either a a0) Source # mapM :: Monad m => (a0 -> m b) -> Either a a0 -> m ( Either a b) Source # sequence :: Monad m => Either a (m a0) -> m ( Either a a0) Source # |
|
Traversable ( V1 :: Type -> Type ) |
Since: base-4.9.0.0 |
Traversable ( U1 :: Type -> Type ) |
Since: base-4.9.0.0 |
Traversable ( UAddr :: Type -> Type ) |
Since: base-4.9.0.0 |
Traversable ( UChar :: Type -> Type ) |
Since: base-4.9.0.0 |
Traversable ( UDouble :: Type -> Type ) |
Since: base-4.9.0.0 |
Defined in Data.Traversable |
|
Traversable ( UFloat :: Type -> Type ) |
Since: base-4.9.0.0 |
Defined in Data.Traversable |
|
Traversable ( UInt :: Type -> Type ) |
Since: base-4.9.0.0 |
Traversable ( UWord :: Type -> Type ) |
Since: base-4.9.0.0 |
Traversable ( (,) a) |
Since: base-4.7.0.0 |
Ix i => Traversable ( Array i) |
Since: base-2.1 |
Defined in Data.Traversable |
|
Traversable ( Arg a) |
Since: base-4.9.0.0 |
Defined in Data.Semigroup |
|
Traversable ( Proxy :: Type -> Type ) |
Since: base-4.7.0.0 |
Traversable ( Map k) |
Traverses in order of increasing key. |
Traversable f => Traversable ( MaybeT f) | |
Defined in Control.Monad.Trans.Maybe |
|
( Monad m, Traversable m) => Traversable ( CatchT m) | |
Defined in Control.Monad.Catch.Pure |
|
Traversable f => Traversable ( Cofree f) | |
Defined in Control.Comonad.Cofree |
|
Traversable w => Traversable ( CoiterT w) | |
Defined in Control.Comonad.Trans.Coiter traverse :: Applicative f => (a -> f b) -> CoiterT w a -> f ( CoiterT w b) Source # sequenceA :: Applicative f => CoiterT w (f a) -> f ( CoiterT w a) Source # mapM :: Monad m => (a -> m b) -> CoiterT w a -> m ( CoiterT w b) Source # sequence :: Monad m => CoiterT w (m a) -> m ( CoiterT w a) Source # |
|
Traversable f => Traversable ( F f) | |
Traversable f => Traversable ( Free f) | |
Defined in Control.Monad.Free |
|
( Monad m, Traversable m) => Traversable ( IterT m) | |
Defined in Control.Monad.Trans.Iter |
|
Traversable f => Traversable ( Yoneda f) | |
Defined in Data.Functor.Yoneda |
|
Traversable f => Traversable ( ListT f) | |
Defined in Control.Monad.Trans.List |
|
Traversable ( Pair e) | |
Defined in Data.Strict.Tuple |
|
Traversable ( These a) | |
Defined in Data.Strict.These |
|
Traversable ( Either e) | |
Defined in Data.Strict.Either |
|
Traversable ( These a) | |
Defined in Data.These |
|
Traversable f => Traversable ( Lift f) | |
Defined in Control.Applicative.Lift |
|
Traversable ( HashMap k) | |
Defined in Data.HashMap.Internal traverse :: Applicative f => (a -> f b) -> HashMap k a -> f ( HashMap k b) Source # sequenceA :: Applicative f => HashMap k (f a) -> f ( HashMap k a) Source # mapM :: Monad m => (a -> m b) -> HashMap k a -> m ( HashMap k b) Source # sequence :: Monad m => HashMap k (m a) -> m ( HashMap k a) Source # |
|
Traversable ( Level i) Source # | |
Defined in Control.Lens.Internal.Level |
|
Traversable f => Traversable ( Rec1 f) |
Since: base-4.9.0.0 |
Defined in Data.Traversable |
|
Traversable ( Const m :: Type -> Type ) |
Since: base-4.7.0.0 |
Defined in Data.Traversable |
|
Traversable f => Traversable ( Ap f) |
Since: base-4.12.0.0 |
Traversable f => Traversable ( Alt f) |
Since: base-4.12.0.0 |
Defined in Data.Traversable |
|
Bitraversable p => Traversable ( Join p) | |
Defined in Data.Bifunctor.Join |
|
Bitraversable p => Traversable ( Fix p) | |
Traversable w => Traversable ( EnvT e w) | |
Defined in Control.Comonad.Trans.Env |
|
Traversable f => Traversable ( IdentityT f) | |
Defined in Control.Monad.Trans.Identity traverse :: Applicative f0 => (a -> f0 b) -> IdentityT f a -> f0 ( IdentityT f b) Source # sequenceA :: Applicative f0 => IdentityT f (f0 a) -> f0 ( IdentityT f a) Source # mapM :: Monad m => (a -> m b) -> IdentityT f a -> m ( IdentityT f b) Source # sequence :: Monad m => IdentityT f (m a) -> m ( IdentityT f a) Source # |
|
Traversable f => Traversable ( ExceptT e f) | |
Defined in Control.Monad.Trans.Except traverse :: Applicative f0 => (a -> f0 b) -> ExceptT e f a -> f0 ( ExceptT e f b) Source # sequenceA :: Applicative f0 => ExceptT e f (f0 a) -> f0 ( ExceptT e f a) Source # mapM :: Monad m => (a -> m b) -> ExceptT e f a -> m ( ExceptT e f b) Source # sequence :: Monad m => ExceptT e f (m a) -> m ( ExceptT e f a) Source # |
|
Traversable f => Traversable ( FreeF f a) | |
Defined in Control.Monad.Trans.Free traverse :: Applicative f0 => (a0 -> f0 b) -> FreeF f a a0 -> f0 ( FreeF f a b) Source # sequenceA :: Applicative f0 => FreeF f a (f0 a0) -> f0 ( FreeF f a a0) Source # mapM :: Monad m => (a0 -> m b) -> FreeF f a a0 -> m ( FreeF f a b) Source # sequence :: Monad m => FreeF f a (m a0) -> m ( FreeF f a a0) Source # |
|
( Monad m, Traversable m, Traversable f) => Traversable ( FreeT f m) | |
Defined in Control.Monad.Trans.Free traverse :: Applicative f0 => (a -> f0 b) -> FreeT f m a -> f0 ( FreeT f m b) Source # sequenceA :: Applicative f0 => FreeT f m (f0 a) -> f0 ( FreeT f m a) Source # mapM :: Monad m0 => (a -> m0 b) -> FreeT f m a -> m0 ( FreeT f m b) Source # sequence :: Monad m0 => FreeT f m (m0 a) -> m0 ( FreeT f m a) Source # |
|
Traversable f => Traversable ( CofreeF f a) | |
Defined in Control.Comonad.Trans.Cofree traverse :: Applicative f0 => (a0 -> f0 b) -> CofreeF f a a0 -> f0 ( CofreeF f a b) Source # sequenceA :: Applicative f0 => CofreeF f a (f0 a0) -> f0 ( CofreeF f a a0) Source # mapM :: Monad m => (a0 -> m b) -> CofreeF f a a0 -> m ( CofreeF f a b) Source # sequence :: Monad m => CofreeF f a (m a0) -> m ( CofreeF f a a0) Source # |
|
( Traversable f, Traversable w) => Traversable ( CofreeT f w) | |
Defined in Control.Comonad.Trans.Cofree traverse :: Applicative f0 => (a -> f0 b) -> CofreeT f w a -> f0 ( CofreeT f w b) Source # sequenceA :: Applicative f0 => CofreeT f w (f0 a) -> f0 ( CofreeT f w a) Source # mapM :: Monad m => (a -> m b) -> CofreeT f w a -> m ( CofreeT f w b) Source # sequence :: Monad m => CofreeT f w (m a) -> m ( CofreeT f w a) Source # |
|
Traversable f => Traversable ( ErrorT e f) | |
Defined in Control.Monad.Trans.Error traverse :: Applicative f0 => (a -> f0 b) -> ErrorT e f a -> f0 ( ErrorT e f b) Source # sequenceA :: Applicative f0 => ErrorT e f (f0 a) -> f0 ( ErrorT e f a) Source # mapM :: Monad m => (a -> m b) -> ErrorT e f a -> m ( ErrorT e f b) Source # sequence :: Monad m => ErrorT e f (m a) -> m ( ErrorT e f a) Source # |
|
Traversable f => Traversable ( WriterT w f) | |
Defined in Control.Monad.Trans.Writer.Lazy traverse :: Applicative f0 => (a -> f0 b) -> WriterT w f a -> f0 ( WriterT w f b) Source # sequenceA :: Applicative f0 => WriterT w f (f0 a) -> f0 ( WriterT w f a) Source # mapM :: Monad m => (a -> m b) -> WriterT w f a -> m ( WriterT w f b) Source # sequence :: Monad m => WriterT w f (m a) -> m ( WriterT w f a) Source # |
|
Traversable f => Traversable ( WriterT w f) | |
Defined in Control.Monad.Trans.Writer.Strict traverse :: Applicative f0 => (a -> f0 b) -> WriterT w f a -> f0 ( WriterT w f b) Source # sequenceA :: Applicative f0 => WriterT w f (f0 a) -> f0 ( WriterT w f a) Source # mapM :: Monad m => (a -> m b) -> WriterT w f a -> m ( WriterT w f b) Source # sequence :: Monad m => WriterT w f (m a) -> m ( WriterT w f a) Source # |
|
Traversable ( Constant a :: Type -> Type ) | |
Defined in Data.Functor.Constant traverse :: Applicative f => (a0 -> f b) -> Constant a a0 -> f ( Constant a b) Source # sequenceA :: Applicative f => Constant a (f a0) -> f ( Constant a a0) Source # mapM :: Monad m => (a0 -> m b) -> Constant a a0 -> m ( Constant a b) Source # sequence :: Monad m => Constant a (m a0) -> m ( Constant a a0) Source # |
|
Traversable ( Tagged s) | |
Defined in Data.Tagged |
|
Traversable f => Traversable ( Reverse f) |
Traverse from right to left. |
Defined in Data.Functor.Reverse traverse :: Applicative f0 => (a -> f0 b) -> Reverse f a -> f0 ( Reverse f b) Source # sequenceA :: Applicative f0 => Reverse f (f0 a) -> f0 ( Reverse f a) Source # mapM :: Monad m => (a -> m b) -> Reverse f a -> m ( Reverse f b) Source # sequence :: Monad m => Reverse f (m a) -> m ( Reverse f a) Source # |
|
Traversable f => Traversable ( Backwards f) |
Derived instance. |
Defined in Control.Applicative.Backwards traverse :: Applicative f0 => (a -> f0 b) -> Backwards f a -> f0 ( Backwards f b) Source # sequenceA :: Applicative f0 => Backwards f (f0 a) -> f0 ( Backwards f a) Source # mapM :: Monad m => (a -> m b) -> Backwards f a -> m ( Backwards f b) Source # sequence :: Monad m => Backwards f (m a) -> m ( Backwards f a) Source # |
|
Traversable f => Traversable ( AlongsideRight f a) Source # | |
Defined in Control.Lens.Internal.Getter traverse :: Applicative f0 => (a0 -> f0 b) -> AlongsideRight f a a0 -> f0 ( AlongsideRight f a b) Source # sequenceA :: Applicative f0 => AlongsideRight f a (f0 a0) -> f0 ( AlongsideRight f a a0) Source # mapM :: Monad m => (a0 -> m b) -> AlongsideRight f a a0 -> m ( AlongsideRight f a b) Source # sequence :: Monad m => AlongsideRight f a (m a0) -> m ( AlongsideRight f a a0) Source # |
|
Traversable f => Traversable ( AlongsideLeft f b) Source # | |
Defined in Control.Lens.Internal.Getter traverse :: Applicative f0 => (a -> f0 b0) -> AlongsideLeft f b a -> f0 ( AlongsideLeft f b b0) Source # sequenceA :: Applicative f0 => AlongsideLeft f b (f0 a) -> f0 ( AlongsideLeft f b a) Source # mapM :: Monad m => (a -> m b0) -> AlongsideLeft f b a -> m ( AlongsideLeft f b b0) Source # sequence :: Monad m => AlongsideLeft f b (m a) -> m ( AlongsideLeft f b a) Source # |
|
Traversable (Baz t b) | |
Defined in Data.Profunctor.Traversing |
|
Traversable ( K1 i c :: Type -> Type ) |
Since: base-4.9.0.0 |
Defined in Data.Traversable |
|
( Traversable f, Traversable g) => Traversable (f :+: g) |
Since: base-4.9.0.0 |
Defined in Data.Traversable traverse :: Applicative f0 => (a -> f0 b) -> (f :+: g) a -> f0 ((f :+: g) b) Source # sequenceA :: Applicative f0 => (f :+: g) (f0 a) -> f0 ((f :+: g) a) Source # mapM :: Monad m => (a -> m b) -> (f :+: g) a -> m ((f :+: g) b) Source # sequence :: Monad m => (f :+: g) (m a) -> m ((f :+: g) a) Source # |
|
( Traversable f, Traversable g) => Traversable (f :*: g) |
Since: base-4.9.0.0 |
Defined in Data.Traversable traverse :: Applicative f0 => (a -> f0 b) -> (f :*: g) a -> f0 ((f :*: g) b) Source # sequenceA :: Applicative f0 => (f :*: g) (f0 a) -> f0 ((f :*: g) a) Source # mapM :: Monad m => (a -> m b) -> (f :*: g) a -> m ((f :*: g) b) Source # sequence :: Monad m => (f :*: g) (m a) -> m ((f :*: g) a) Source # |
|
( Traversable f, Traversable g) => Traversable ( Product f g) |
Since: base-4.9.0.0 |
Defined in Data.Functor.Product traverse :: Applicative f0 => (a -> f0 b) -> Product f g a -> f0 ( Product f g b) Source # sequenceA :: Applicative f0 => Product f g (f0 a) -> f0 ( Product f g a) Source # mapM :: Monad m => (a -> m b) -> Product f g a -> m ( Product f g b) Source # sequence :: Monad m => Product f g (m a) -> m ( Product f g a) Source # |
|
( Traversable f, Traversable g) => Traversable ( Sum f g) |
Since: base-4.9.0.0 |
Defined in Data.Functor.Sum |
|
Traversable ( Forget r a :: Type -> Type ) | |
Defined in Data.Profunctor.Types traverse :: Applicative f => (a0 -> f b) -> Forget r a a0 -> f ( Forget r a b) Source # sequenceA :: Applicative f => Forget r a (f a0) -> f ( Forget r a a0) Source # mapM :: Monad m => (a0 -> m b) -> Forget r a a0 -> m ( Forget r a b) Source # sequence :: Monad m => Forget r a (m a0) -> m ( Forget r a a0) Source # |
|
Traversable ( Magma i t b) Source # | |
Defined in Control.Lens.Internal.Magma traverse :: Applicative f => (a -> f b0) -> Magma i t b a -> f ( Magma i t b b0) Source # sequenceA :: Applicative f => Magma i t b (f a) -> f ( Magma i t b a) Source # mapM :: Monad m => (a -> m b0) -> Magma i t b a -> m ( Magma i t b b0) Source # sequence :: Monad m => Magma i t b (m a) -> m ( Magma i t b a) Source # |
|
Traversable f => Traversable ( M1 i c f) |
Since: base-4.9.0.0 |
Defined in Data.Traversable |
|
( Traversable f, Traversable g) => Traversable (f :.: g) |
Since: base-4.9.0.0 |
Defined in Data.Traversable traverse :: Applicative f0 => (a -> f0 b) -> (f :.: g) a -> f0 ((f :.: g) b) Source # sequenceA :: Applicative f0 => (f :.: g) (f0 a) -> f0 ((f :.: g) a) Source # mapM :: Monad m => (a -> m b) -> (f :.: g) a -> m ((f :.: g) b) Source # sequence :: Monad m => (f :.: g) (m a) -> m ((f :.: g) a) Source # |
|
( Traversable f, Traversable g) => Traversable ( Compose f g) |
Since: base-4.9.0.0 |
Defined in Data.Functor.Compose traverse :: Applicative f0 => (a -> f0 b) -> Compose f g a -> f0 ( Compose f g b) Source # sequenceA :: Applicative f0 => Compose f g (f0 a) -> f0 ( Compose f g a) Source # mapM :: Monad m => (a -> m b) -> Compose f g a -> m ( Compose f g b) Source # sequence :: Monad m => Compose f g (m a) -> m ( Compose f g a) Source # |
|
Bitraversable p => Traversable ( WrappedBifunctor p a) | |
Defined in Data.Bifunctor.Wrapped traverse :: Applicative f => (a0 -> f b) -> WrappedBifunctor p a a0 -> f ( WrappedBifunctor p a b) Source # sequenceA :: Applicative f => WrappedBifunctor p a (f a0) -> f ( WrappedBifunctor p a a0) Source # mapM :: Monad m => (a0 -> m b) -> WrappedBifunctor p a a0 -> m ( WrappedBifunctor p a b) Source # sequence :: Monad m => WrappedBifunctor p a (m a0) -> m ( WrappedBifunctor p a a0) Source # |
|
Traversable g => Traversable ( Joker g a) | |
Defined in Data.Bifunctor.Joker traverse :: Applicative f => (a0 -> f b) -> Joker g a a0 -> f ( Joker g a b) Source # sequenceA :: Applicative f => Joker g a (f a0) -> f ( Joker g a a0) Source # mapM :: Monad m => (a0 -> m b) -> Joker g a a0 -> m ( Joker g a b) Source # sequence :: Monad m => Joker g a (m a0) -> m ( Joker g a a0) Source # |
|
Bitraversable p => Traversable ( Flip p a) | |
Defined in Data.Bifunctor.Flip traverse :: Applicative f => (a0 -> f b) -> Flip p a a0 -> f ( Flip p a b) Source # sequenceA :: Applicative f => Flip p a (f a0) -> f ( Flip p a a0) Source # mapM :: Monad m => (a0 -> m b) -> Flip p a a0 -> m ( Flip p a b) Source # sequence :: Monad m => Flip p a (m a0) -> m ( Flip p a a0) Source # |
|
Traversable ( Clown f a :: Type -> Type ) | |
Defined in Data.Bifunctor.Clown traverse :: Applicative f0 => (a0 -> f0 b) -> Clown f a a0 -> f0 ( Clown f a b) Source # sequenceA :: Applicative f0 => Clown f a (f0 a0) -> f0 ( Clown f a a0) Source # mapM :: Monad m => (a0 -> m b) -> Clown f a a0 -> m ( Clown f a b) Source # sequence :: Monad m => Clown f a (m a0) -> m ( Clown f a a0) Source # |
|
( Traversable (f a), Traversable (g a)) => Traversable ( Sum f g a) | |
Defined in Data.Bifunctor.Sum traverse :: Applicative f0 => (a0 -> f0 b) -> Sum f g a a0 -> f0 ( Sum f g a b) Source # sequenceA :: Applicative f0 => Sum f g a (f0 a0) -> f0 ( Sum f g a a0) Source # mapM :: Monad m => (a0 -> m b) -> Sum f g a a0 -> m ( Sum f g a b) Source # sequence :: Monad m => Sum f g a (m a0) -> m ( Sum f g a a0) Source # |
|
( Traversable (f a), Traversable (g a)) => Traversable ( Product f g a) | |
Defined in Data.Bifunctor.Product traverse :: Applicative f0 => (a0 -> f0 b) -> Product f g a a0 -> f0 ( Product f g a b) Source # sequenceA :: Applicative f0 => Product f g a (f0 a0) -> f0 ( Product f g a a0) Source # mapM :: Monad m => (a0 -> m b) -> Product f g a a0 -> m ( Product f g a b) Source # sequence :: Monad m => Product f g a (m a0) -> m ( Product f g a a0) Source # |
|
( Traversable f, Bitraversable p) => Traversable ( Tannen f p a) | |
Defined in Data.Bifunctor.Tannen traverse :: Applicative f0 => (a0 -> f0 b) -> Tannen f p a a0 -> f0 ( Tannen f p a b) Source # sequenceA :: Applicative f0 => Tannen f p a (f0 a0) -> f0 ( Tannen f p a a0) Source # mapM :: Monad m => (a0 -> m b) -> Tannen f p a a0 -> m ( Tannen f p a b) Source # sequence :: Monad m => Tannen f p a (m a0) -> m ( Tannen f p a a0) Source # |
|
( Bitraversable p, Traversable g) => Traversable ( Biff p f g a) | |
Defined in Data.Bifunctor.Biff traverse :: Applicative f0 => (a0 -> f0 b) -> Biff p f g a a0 -> f0 ( Biff p f g a b) Source # sequenceA :: Applicative f0 => Biff p f g a (f0 a0) -> f0 ( Biff p f g a a0) Source # mapM :: Monad m => (a0 -> m b) -> Biff p f g a a0 -> m ( Biff p f g a b) Source # sequence :: Monad m => Biff p f g a (m a0) -> m ( Biff p f g a a0) Source # |
class Contravariant (f :: Type -> Type ) where Source #
The class of contravariant functors.
Whereas in Haskell, one can think of a
Functor
as containing or producing
values, a contravariant functor is a functor that can be thought of as
consuming
values.
As an example, consider the type of predicate functions
a -> Bool
. One
such predicate might be
negative x = x < 0
, which
classifies integers as to whether they are negative. However, given this
predicate, we can re-use it in other situations, providing we have a way to
map values
to
integers. For instance, we can use the
negative
predicate
on a person's bank balance to work out if they are currently overdrawn:
newtype Predicate a = Predicate { getPredicate :: a -> Bool } instance Contravariant Predicate where contramap f (Predicate p) = Predicate (p . f) | `- First, map the input... `----- then apply the predicate. overdrawn :: Predicate Person overdrawn = contramap personBankBalance negative
Any instance should be subject to the following laws:
Note, that the second law follows from the free theorem of the type of
contramap
and the first law, so you need only check that the former
condition holds.
Instances
class Bifunctor (p :: Type -> Type -> Type ) where Source #
A bifunctor is a type constructor that takes
two type arguments and is a functor in
both
arguments. That
is, unlike with
Functor
, a type constructor such as
Either
does not need to be partially applied for a
Bifunctor
instance, and the methods in this class permit mapping
functions over the
Left
value or the
Right
value,
or both at the same time.
Formally, the class
Bifunctor
represents a bifunctor
from
Hask
->
Hask
.
Intuitively it is a bifunctor where both the first and second arguments are covariant.
You can define a
Bifunctor
by either defining
bimap
or by
defining both
first
and
second
.
If you supply
bimap
, you should ensure that:
bimap
id
id
≡id
If you supply
first
and
second
, ensure:
first
id
≡id
second
id
≡id
If you supply both, you should also ensure:
bimap
f g ≡first
f.
second
g
These ensure by parametricity:
bimap
(f.
g) (h.
i) ≡bimap
f h.
bimap
g ifirst
(f.
g) ≡first
f.
first
gsecond
(f.
g) ≡second
f.
second
g
Since: base-4.8.0.0
Instances
Identity functor and monad. (a non-strict monad)
Since: base-4.8.0.0
Identity | |
|
Instances
newtype Const a (b :: k) Source #
The
Const
functor.
Instances
Generic1 ( Const a :: k -> Type ) |
Since: base-4.9.0.0 |
FunctorWithIndex Void ( Const e :: Type -> Type ) | |
FoldableWithIndex Void ( Const e :: Type -> Type ) | |
Defined in WithIndex ifoldMap :: Monoid m => ( Void -> a -> m) -> Const e a -> m Source # ifoldMap' :: Monoid m => ( Void -> a -> m) -> Const e a -> m Source # ifoldr :: ( Void -> a -> b -> b) -> b -> Const e a -> b Source # ifoldl :: ( Void -> b -> a -> b) -> b -> Const e a -> b Source # ifoldr' :: ( Void -> a -> b -> b) -> b -> Const e a -> b Source # ifoldl' :: ( Void -> b -> a -> b) -> b -> Const e a -> b Source # |
|
TraversableWithIndex Void ( Const e :: Type -> Type ) | |
Unbox a => Vector Vector ( Const a b) | |
Defined in Data.Vector.Unboxed.Base basicUnsafeFreeze :: PrimMonad m => Mutable Vector ( PrimState m) ( Const a b) -> m ( Vector ( Const a b)) Source # basicUnsafeThaw :: PrimMonad m => Vector ( Const a b) -> m ( Mutable Vector ( PrimState m) ( Const a b)) Source # basicLength :: Vector ( Const a b) -> Int Source # basicUnsafeSlice :: Int -> Int -> Vector ( Const a b) -> Vector ( Const a b) Source # basicUnsafeIndexM :: Monad m => Vector ( Const a b) -> Int -> m ( Const a b) Source # basicUnsafeCopy :: PrimMonad m => Mutable Vector ( PrimState m) ( Const a b) -> Vector ( Const a b) -> m () Source # elemseq :: Vector ( Const a b) -> Const a b -> b0 -> b0 Source # |
|
Unbox a => MVector MVector ( Const a b) | |
Defined in Data.Vector.Unboxed.Base basicLength :: MVector s ( Const a b) -> Int Source # basicUnsafeSlice :: Int -> Int -> MVector s ( Const a b) -> MVector s ( Const a b) Source # basicOverlaps :: MVector s ( Const a b) -> MVector s ( Const a b) -> Bool Source # basicUnsafeNew :: PrimMonad m => Int -> m ( MVector ( PrimState m) ( Const a b)) Source # basicInitialize :: PrimMonad m => MVector ( PrimState m) ( Const a b) -> m () Source # basicUnsafeReplicate :: PrimMonad m => Int -> Const a b -> m ( MVector ( PrimState m) ( Const a b)) Source # basicUnsafeRead :: PrimMonad m => MVector ( PrimState m) ( Const a b) -> Int -> m ( Const a b) Source # basicUnsafeWrite :: PrimMonad m => MVector ( PrimState m) ( Const a b) -> Int -> Const a b -> m () Source # basicClear :: PrimMonad m => MVector ( PrimState m) ( Const a b) -> m () Source # basicSet :: PrimMonad m => MVector ( PrimState m) ( Const a b) -> Const a b -> m () Source # basicUnsafeCopy :: PrimMonad m => MVector ( PrimState m) ( Const a b) -> MVector ( PrimState m) ( Const a b) -> m () Source # basicUnsafeMove :: PrimMonad m => MVector ( PrimState m) ( Const a b) -> MVector ( PrimState m) ( Const a b) -> m () Source # basicUnsafeGrow :: PrimMonad m => MVector ( PrimState m) ( Const a b) -> Int -> m ( MVector ( PrimState m) ( Const a b)) Source # |
|
Bifunctor ( Const :: Type -> Type -> Type ) |
Since: base-4.8.0.0 |
Bitraversable ( Const :: Type -> Type -> Type ) |
Since: base-4.10.0.0 |
Defined in Data.Bitraversable bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> Const a b -> f ( Const c d) Source # |
|
Bifoldable ( Const :: Type -> Type -> Type ) |
Since: base-4.10.0.0 |
Eq2 ( Const :: Type -> Type -> Type ) |
Since: base-4.9.0.0 |
Ord2 ( Const :: Type -> Type -> Type ) |
Since: base-4.9.0.0 |
Defined in Data.Functor.Classes |
|
Read2 ( Const :: Type -> Type -> Type ) |
Since: base-4.9.0.0 |
Defined in Data.Functor.Classes liftReadsPrec2 :: ( Int -> ReadS a) -> ReadS [a] -> ( Int -> ReadS b) -> ReadS [b] -> Int -> ReadS ( Const a b) Source # liftReadList2 :: ( Int -> ReadS a) -> ReadS [a] -> ( Int -> ReadS b) -> ReadS [b] -> ReadS [ Const a b] Source # liftReadPrec2 :: ReadPrec a -> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec ( Const a b) Source # liftReadListPrec2 :: ReadPrec a -> ReadPrec [a] -> ReadPrec b -> ReadPrec [b] -> ReadPrec [ Const a b] Source # |
|
Show2 ( Const :: Type -> Type -> Type ) |
Since: base-4.9.0.0 |
Defined in Data.Functor.Classes |
|
Biapplicative ( Const :: Type -> Type -> Type ) | |
NFData2 ( Const :: Type -> Type -> Type ) |
Since: deepseq-1.4.3.0 |
Defined in Control.DeepSeq |
|
Hashable2 ( Const :: Type -> Type -> Type ) | |
Bitraversable1 ( Const :: Type -> Type -> Type ) | |
Defined in Data.Semigroup.Traversable.Class |
|
Biapply ( Const :: Type -> Type -> Type ) | |
Bifoldable1 ( Const :: Type -> Type -> Type ) | |
Semigroupoid ( Const :: Type -> Type -> Type ) | |
Functor ( Const m :: Type -> Type ) |
Since: base-2.1 |
Monoid m => Applicative ( Const m :: Type -> Type ) |
Since: base-2.0.1 |
Defined in Data.Functor.Const |
|
Foldable ( Const m :: Type -> Type ) |
Since: base-4.7.0.0 |
Defined in Data.Functor.Const fold :: Monoid m0 => Const m m0 -> m0 Source # foldMap :: Monoid m0 => (a -> m0) -> Const m a -> m0 Source # foldMap' :: Monoid m0 => (a -> m0) -> Const m a -> m0 Source # foldr :: (a -> b -> b) -> b -> Const m a -> b Source # foldr' :: (a -> b -> b) -> b -> Const m a -> b Source # foldl :: (b -> a -> b) -> b -> Const m a -> b Source # foldl' :: (b -> a -> b) -> b -> Const m a -> b Source # foldr1 :: (a -> a -> a) -> Const m a -> a Source # foldl1 :: (a -> a -> a) -> Const m a -> a Source # toList :: Const m a -> [a] Source # null :: Const m a -> Bool Source # length :: Const m a -> Int Source # elem :: Eq a => a -> Const m a -> Bool Source # maximum :: Ord a => Const m a -> a Source # minimum :: Ord a => Const m a -> a Source # |
|
Traversable ( Const m :: Type -> Type ) |
Since: base-4.7.0.0 |
Defined in Data.Traversable |
|
Contravariant ( Const a :: Type -> Type ) | |
Eq a => Eq1 ( Const a :: Type -> Type ) |
Since: base-4.9.0.0 |
Ord a => Ord1 ( Const a :: Type -> Type ) |
Since: base-4.9.0.0 |
Defined in Data.Functor.Classes |
|
Read a => Read1 ( Const a :: Type -> Type ) |
Since: base-4.9.0.0 |
Defined in Data.Functor.Classes liftReadsPrec :: ( Int -> ReadS a0) -> ReadS [a0] -> Int -> ReadS ( Const a a0) Source # liftReadList :: ( Int -> ReadS a0) -> ReadS [a0] -> ReadS [ Const a a0] Source # liftReadPrec :: ReadPrec a0 -> ReadPrec [a0] -> ReadPrec ( Const a a0) Source # liftReadListPrec :: ReadPrec a0 -> ReadPrec [a0] -> ReadPrec [ Const a a0] Source # |
|
Show a => Show1 ( Const a :: Type -> Type ) |
Since: base-4.9.0.0 |
NFData a => NFData1 ( Const a :: Type -> Type ) |
Since: deepseq-1.4.3.0 |
Defined in Control.DeepSeq |
|
Hashable a => Hashable1 ( Const a :: Type -> Type ) | |
Defined in Data.Hashable.Class |
|
Semigroup m => Apply ( Const m :: Type -> Type ) |
A
|
ComonadCofree ( Const b :: Type -> Type ) ( (,) b) | |
Defined in Control.Comonad.Cofree.Class |
|
Sieve ( Forget r :: Type -> Type -> Type ) ( Const r :: Type -> Type ) | |
Bounded a => Bounded ( Const a b) |
Since: base-4.9.0.0 |
Enum a => Enum ( Const a b) |
Since: base-4.9.0.0 |
Defined in Data.Functor.Const succ :: Const a b -> Const a b Source # pred :: Const a b -> Const a b Source # toEnum :: Int -> Const a b Source # fromEnum :: Const a b -> Int Source # enumFrom :: Const a b -> [ Const a b] Source # enumFromThen :: Const a b -> Const a b -> [ Const a b] Source # enumFromTo :: Const a b -> Const a b -> [ Const a b] Source # enumFromThenTo :: Const a b -> Const a b -> Const a b -> [ Const a b] Source # |
|
Eq a => Eq ( Const a b) |
Since: base-4.9.0.0 |
Floating a => Floating ( Const a b) |
Since: base-4.9.0.0 |
Defined in Data.Functor.Const exp :: Const a b -> Const a b Source # log :: Const a b -> Const a b Source # sqrt :: Const a b -> Const a b Source # (**) :: Const a b -> Const a b -> Const a b Source # logBase :: Const a b -> Const a b -> Const a b Source # sin :: Const a b -> Const a b Source # cos :: Const a b -> Const a b Source # tan :: Const a b -> Const a b Source # asin :: Const a b -> Const a b Source # acos :: Const a b -> Const a b Source # atan :: Const a b -> Const a b Source # sinh :: Const a b -> Const a b Source # cosh :: Const a b -> Const a b Source # tanh :: Const a b -> Const a b Source # asinh :: Const a b -> Const a b Source # acosh :: Const a b -> Const a b Source # atanh :: Const a b -> Const a b Source # log1p :: Const a b -> Const a b Source # expm1 :: Const a b -> Const a b Source # |
|
Fractional a => Fractional ( Const a b) |
Since: base-4.9.0.0 |
Integral a => Integral ( Const a b) |
Since: base-4.9.0.0 |
Defined in Data.Functor.Const quot :: Const a b -> Const a b -> Const a b Source # rem :: Const a b -> Const a b -> Const a b Source # div :: Const a b -> Const a b -> Const a b Source # mod :: Const a b -> Const a b -> Const a b Source # quotRem :: Const a b -> Const a b -> ( Const a b, Const a b) Source # divMod :: Const a b -> Const a b -> ( Const a b, Const a b) Source # |
|
( Typeable k, Data a, Typeable b) => Data ( Const a b) |
Since: base-4.10.0.0 |
Defined in Data.Data gfoldl :: ( forall d b0. Data d => c (d -> b0) -> d -> c b0) -> ( forall g. g -> c g) -> Const a b -> c ( Const a b) Source # gunfold :: ( forall b0 r. Data b0 => c (b0 -> r) -> c r) -> ( forall r. r -> c r) -> Constr -> c ( Const a b) Source # toConstr :: Const a b -> Constr Source # dataTypeOf :: Const a b -> DataType Source # dataCast1 :: Typeable t => ( forall d. Data d => c (t d)) -> Maybe (c ( Const a b)) Source # dataCast2 :: Typeable t => ( forall d e. ( Data d, Data e) => c (t d e)) -> Maybe (c ( Const a b)) Source # gmapT :: ( forall b0. Data b0 => b0 -> b0) -> Const a b -> Const a b Source # gmapQl :: (r -> r' -> r) -> r -> ( forall d. Data d => d -> r') -> Const a b -> r Source # gmapQr :: forall r r'. (r' -> r -> r) -> r -> ( forall d. Data d => d -> r') -> Const a b -> r Source # gmapQ :: ( forall d. Data d => d -> u) -> Const a b -> [u] Source # gmapQi :: Int -> ( forall d. Data d => d -> u) -> Const a b -> u Source # gmapM :: Monad m => ( forall d. Data d => d -> m d) -> Const a b -> m ( Const a b) Source # gmapMp :: MonadPlus m => ( forall d. Data d => d -> m d) -> Const a b -> m ( Const a b) Source # gmapMo :: MonadPlus m => ( forall d. Data d => d -> m d) -> Const a b -> m ( Const a b) Source # |
|
Num a => Num ( Const a b) |
Since: base-4.9.0.0 |
Defined in Data.Functor.Const (+) :: Const a b -> Const a b -> Const a b Source # (-) :: Const a b -> Const a b -> Const a b Source # (*) :: Const a b -> Const a b -> Const a b Source # negate :: Const a b -> Const a b Source # abs :: Const a b -> Const a b Source # signum :: Const a b -> Const a b Source # fromInteger :: Integer -> Const a b Source # |
|
Ord a => Ord ( Const a b) |
Since: base-4.9.0.0 |
Defined in Data.Functor.Const |
|
Read a => Read ( Const a b) |
This instance would be equivalent to the derived instances of the
Since: base-4.8.0.0 |
Real a => Real ( Const a b) |
Since: base-4.9.0.0 |
Defined in Data.Functor.Const toRational :: Const a b -> Rational Source # |
|
RealFloat a => RealFloat ( Const a b) |
Since: base-4.9.0.0 |
Defined in Data.Functor.Const floatRadix :: Const a b -> Integer Source # floatDigits :: Const a b -> Int Source # floatRange :: Const a b -> ( Int , Int ) Source # decodeFloat :: Const a b -> ( Integer , Int ) Source # encodeFloat :: Integer -> Int -> Const a b Source # exponent :: Const a b -> Int Source # significand :: Const a b -> Const a b Source # scaleFloat :: Int -> Const a b -> Const a b Source # isNaN :: Const a b -> Bool Source # isInfinite :: Const a b -> Bool Source # isDenormalized :: Const a b -> Bool Source # isNegativeZero :: Const a b -> Bool Source # |
|
RealFrac a => RealFrac ( Const a b) |
Since: base-4.9.0.0 |
Defined in Data.Functor.Const |
|
Show a => Show ( Const a b) |
This instance would be equivalent to the derived instances of the
Since: base-4.8.0.0 |
Ix a => Ix ( Const a b) |
Since: base-4.9.0.0 |
Defined in Data.Functor.Const range :: ( Const a b, Const a b) -> [ Const a b] Source # index :: ( Const a b, Const a b) -> Const a b -> Int Source # unsafeIndex :: ( Const a b, Const a b) -> Const a b -> Int Source # inRange :: ( Const a b, Const a b) -> Const a b -> Bool Source # |
|
Generic ( Const a b) |
Since: base-4.9.0.0 |
Semigroup a => Semigroup ( Const a b) |
Since: base-4.9.0.0 |
Monoid a => Monoid ( Const a b) |
Since: base-4.9.0.0 |
Storable a => Storable ( Const a b) |
Since: base-4.9.0.0 |
Defined in Data.Functor.Const sizeOf :: Const a b -> Int Source # alignment :: Const a b -> Int Source # peekElemOff :: Ptr ( Const a b) -> Int -> IO ( Const a b) Source # pokeElemOff :: Ptr ( Const a b) -> Int -> Const a b -> IO () Source # peekByteOff :: Ptr b0 -> Int -> IO ( Const a b) Source # pokeByteOff :: Ptr b0 -> Int -> Const a b -> IO () Source # |
|
Bits a => Bits ( Const a b) |
Since: base-4.9.0.0 |
Defined in Data.Functor.Const (.&.) :: Const a b -> Const a b -> Const a b Source # (.|.) :: Const a b -> Const a b -> Const a b Source # xor :: Const a b -> Const a b -> Const a b Source # complement :: Const a b -> Const a b Source # shift :: Const a b -> Int -> Const a b Source # rotate :: Const a b -> Int -> Const a b Source # zeroBits :: Const a b Source # bit :: Int -> Const a b Source # setBit :: Const a b -> Int -> Const a b Source # clearBit :: Const a b -> Int -> Const a b Source # complementBit :: Const a b -> Int -> Const a b Source # testBit :: Const a b -> Int -> Bool Source # bitSizeMaybe :: Const a b -> Maybe Int Source # bitSize :: Const a b -> Int Source # isSigned :: Const a b -> Bool Source # shiftL :: Const a b -> Int -> Const a b Source # unsafeShiftL :: Const a b -> Int -> Const a b Source # shiftR :: Const a b -> Int -> Const a b Source # unsafeShiftR :: Const a b -> Int -> Const a b Source # rotateL :: Const a b -> Int -> Const a b Source # |
|
FiniteBits a => FiniteBits ( Const a b) |
Since: base-4.9.0.0 |
Defined in Data.Functor.Const finiteBitSize :: Const a b -> Int Source # countLeadingZeros :: Const a b -> Int Source # countTrailingZeros :: Const a b -> Int Source # |
|
NFData a => NFData ( Const a b) |
Since: deepseq-1.4.0.0 |
Defined in Control.DeepSeq |
|
Hashable a => Hashable ( Const a b) | |
Prim a => Prim ( Const a b) |
Since: primitive-0.6.5.0 |
Defined in Data.Primitive.Types sizeOf# :: Const a b -> Int# Source # alignment# :: Const a b -> Int# Source # indexByteArray# :: ByteArray# -> Int# -> Const a b Source # readByteArray# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, Const a b #) Source # writeByteArray# :: MutableByteArray# s -> Int# -> Const a b -> State# s -> State# s Source # setByteArray# :: MutableByteArray# s -> Int# -> Int# -> Const a b -> State# s -> State# s Source # indexOffAddr# :: Addr# -> Int# -> Const a b Source # readOffAddr# :: Addr# -> Int# -> State# s -> (# State# s, Const a b #) Source # writeOffAddr# :: Addr# -> Int# -> Const a b -> State# s -> State# s Source # setOffAddr# :: Addr# -> Int# -> Int# -> Const a b -> State# s -> State# s Source # |
|
Unbox a => Unbox ( Const a b) | |
Defined in Data.Vector.Unboxed.Base |
|
Wrapped ( Const a x) Source # | |
t ~ Const a' x' => Rewrapped ( Const a x) t Source # | |
Defined in Control.Lens.Wrapped |
|
type Rep1 ( Const a :: k -> Type ) | |
Defined in Data.Functor.Const |
|
newtype MVector s ( Const a b) | |
Defined in Data.Vector.Unboxed.Base |
|
type Rep ( Const a b) | |
Defined in Data.Functor.Const |
|
newtype Vector ( Const a b) | |
Defined in Data.Vector.Unboxed.Base |
|
type Unwrapped ( Const a x) Source # | |
Defined in Control.Lens.Wrapped |
data (a :: k) :~: (b :: k) where infix 4 Source #
Propositional equality. If
a :~: b
is inhabited by some terminating
value, then the type
a
is the same as the type
b
. To use this equality
in practice, pattern-match on the
a :~: b
to get out the
Refl
constructor;
in the body of the pattern-match, the compiler knows that
a ~ b
.
Since: base-4.7.0.0
Instances
Category ( (:~:) :: k -> k -> Type ) |
Since: base-4.7.0.0 |
Semigroupoid ( (:~:) :: k -> k -> Type ) | |
TestCoercion ( (:~:) a :: k -> Type ) |
Since: base-4.7.0.0 |
Defined in Data.Type.Coercion |
|
TestEquality ( (:~:) a :: k -> Type ) |
Since: base-4.7.0.0 |
Defined in Data.Type.Equality |
|
NFData2 ( (:~:) :: Type -> Type -> Type ) |
Since: deepseq-1.4.3.0 |
Defined in Control.DeepSeq |
|
NFData1 ( (:~:) a) |
Since: deepseq-1.4.3.0 |
Defined in Control.DeepSeq |
|
a ~ b => Bounded (a :~: b) |
Since: base-4.7.0.0 |
a ~ b => Enum (a :~: b) |
Since: base-4.7.0.0 |
Defined in Data.Type.Equality succ :: (a :~: b) -> a :~: b Source # pred :: (a :~: b) -> a :~: b Source # toEnum :: Int -> a :~: b Source # fromEnum :: (a :~: b) -> Int Source # enumFrom :: (a :~: b) -> [a :~: b] Source # enumFromThen :: (a :~: b) -> (a :~: b) -> [a :~: b] Source # enumFromTo :: (a :~: b) -> (a :~: b) -> [a :~: b] Source # enumFromThenTo :: (a :~: b) -> (a :~: b) -> (a :~: b) -> [a :~: b] Source # |
|
Eq (a :~: b) |
Since: base-4.7.0.0 |
(a ~ b, Data a) => Data (a :~: b) |
Since: base-4.7.0.0 |
Defined in Data.Data gfoldl :: ( forall d b0. Data d => c (d -> b0) -> d -> c b0) -> ( forall g. g -> c g) -> (a :~: b) -> c (a :~: b) Source # gunfold :: ( forall b0 r. Data b0 => c (b0 -> r) -> c r) -> ( forall r. r -> c r) -> Constr -> c (a :~: b) Source # toConstr :: (a :~: b) -> Constr Source # dataTypeOf :: (a :~: b) -> DataType Source # dataCast1 :: Typeable t => ( forall d. Data d => c (t d)) -> Maybe (c (a :~: b)) Source # dataCast2 :: Typeable t => ( forall d e. ( Data d, Data e) => c (t d e)) -> Maybe (c (a :~: b)) Source # gmapT :: ( forall b0. Data b0 => b0 -> b0) -> (a :~: b) -> a :~: b Source # gmapQl :: (r -> r' -> r) -> r -> ( forall d. Data d => d -> r') -> (a :~: b) -> r Source # gmapQr :: forall r r'. (r' -> r -> r) -> r -> ( forall d. Data d => d -> r') -> (a :~: b) -> r Source # gmapQ :: ( forall d. Data d => d -> u) -> (a :~: b) -> [u] Source # gmapQi :: Int -> ( forall d. Data d => d -> u) -> (a :~: b) -> u Source # gmapM :: Monad m => ( forall d. Data d => d -> m d) -> (a :~: b) -> m (a :~: b) Source # gmapMp :: MonadPlus m => ( forall d. Data d => d -> m d) -> (a :~: b) -> m (a :~: b) Source # gmapMo :: MonadPlus m => ( forall d. Data d => d -> m d) -> (a :~: b) -> m (a :~: b) Source # |
|
Ord (a :~: b) |
Since: base-4.7.0.0 |
Defined in Data.Type.Equality |
|
a ~ b => Read (a :~: b) |
Since: base-4.7.0.0 |
Show (a :~: b) |
Since: base-4.7.0.0 |
NFData (a :~: b) |
Since: deepseq-1.4.3.0 |
Defined in Control.DeepSeq |
itoList :: FoldableWithIndex i f => f a -> [(i, a)] Source #
ifoldlM :: ( FoldableWithIndex i f, Monad m) => (i -> b -> a -> m b) -> b -> f a -> m b Source #
ifoldrM :: ( FoldableWithIndex i f, Monad m) => (i -> a -> b -> m b) -> b -> f a -> m b Source #
iconcatMap :: FoldableWithIndex i f => (i -> a -> [b]) -> f a -> [b] Source #
Concatenate the results of a function of the elements of an indexed container with access to the index.
When you don't need access to the index then
concatMap
is more flexible in what it accepts.
concatMap
≡iconcatMap
.
const
iconcatMap
≡ifoldMap
iforM_ :: ( FoldableWithIndex i t, Monad m) => t a -> (i -> a -> m b) -> m () Source #
imapM_ :: ( FoldableWithIndex i t, Monad m) => (i -> a -> m b) -> t a -> m () Source #
Run monadic actions for each target of an
IndexedFold
or
IndexedTraversal
with access to the index,
discarding the results.
When you don't need access to the index then
mapMOf_
is more flexible in what it accepts.
mapM_
≡imapM
.
const
ifor_ :: ( FoldableWithIndex i t, Applicative f) => t a -> (i -> a -> f b) -> f () Source #
Traverse elements with access to the index
i
, discarding the results (with the arguments flipped).
ifor_
≡flip
itraverse_
When you don't need access to the index then
for_
is more flexible in what it accepts.
for_
a ≡ifor_
a.
const
itraverse_ :: ( FoldableWithIndex i t, Applicative f) => (i -> a -> f b) -> t a -> f () Source #
imapAccumL :: TraversableWithIndex i t => (i -> s -> a -> (s, b)) -> s -> t a -> (s, t b) Source #
Generalizes
mapAccumL
to add access to the index.
imapAccumL
accumulates state from left to right.
mapAccumL
≡imapAccumL
.
const
imapAccumR :: TraversableWithIndex i t => (i -> s -> a -> (s, b)) -> s -> t a -> (s, t b) Source #
Generalizes
mapAccumR
to add access to the index.
imapAccumR
accumulates state from right to left.
mapAccumR
≡imapAccumR
.
const
iforM :: ( TraversableWithIndex i t, Monad m) => t a -> (i -> a -> m b) -> m (t b) Source #
imapM :: ( TraversableWithIndex i t, Monad m) => (i -> a -> m b) -> t a -> m (t b) Source #
Map each element of a structure to a monadic action, evaluate these actions from left to right, and collect the results, with access the index.
When you don't need access to the index
mapM
is more liberal in what it can accept.
mapM
≡imapM
.
const
ifor :: ( TraversableWithIndex i t, Applicative f) => t a -> (i -> a -> f b) -> f (t b) Source #
class Functor f => FunctorWithIndex i (f :: Type -> Type ) | f -> i where Source #
A
Functor
with an additional index.
Instances must satisfy a modified form of the
Functor
laws:
imap
f.
imap
g ≡imap
(\i -> f i.
g i)imap
(\_ a -> a) ≡id
Nothing
Instances
class Foldable f => FoldableWithIndex i (f :: Type -> Type ) | f -> i where Source #
A container that supports folding with an additional index.
Nothing
ifoldMap :: Monoid m => (i -> a -> m) -> f a -> m Source #
Fold a container by mapping value to an arbitrary
Monoid
with access to the index
i
.
When you don't need access to the index then
foldMap
is more flexible in what it accepts.
foldMap
≡ifoldMap
.
const
ifoldMap' :: Monoid m => (i -> a -> m) -> f a -> m Source #
A variant of
ifoldMap
that is strict in the accumulator.
When you don't need access to the index then
foldMap'
is more flexible in what it accepts.
foldMap'
≡ifoldMap'
.
const
ifoldr :: (i -> a -> b -> b) -> b -> f a -> b Source #
Right-associative fold of an indexed container with access to the index
i
.
When you don't need access to the index then
foldr
is more flexible in what it accepts.
foldr
≡ifoldr
.
const
ifoldl :: (i -> b -> a -> b) -> b -> f a -> b Source #
Left-associative fold of an indexed container with access to the index
i
.
When you don't need access to the index then
foldl
is more flexible in what it accepts.
foldl
≡ifoldl
.
const
Instances
FoldableWithIndex Int [] | |
Defined in WithIndex |
|
FoldableWithIndex Int ZipList | |
Defined in WithIndex ifoldMap :: Monoid m => ( Int -> a -> m) -> ZipList a -> m Source # ifoldMap' :: Monoid m => ( Int -> a -> m) -> ZipList a -> m Source # ifoldr :: ( Int -> a -> b -> b) -> b -> ZipList a -> b Source # ifoldl :: ( Int -> b -> a -> b) -> b -> ZipList a -> b Source # ifoldr' :: ( Int -> a -> b -> b) -> b -> ZipList a -> b Source # ifoldl' :: ( Int -> b -> a -> b) -> b -> ZipList a -> b Source # |
|
FoldableWithIndex Int NonEmpty | |
Defined in WithIndex ifoldMap :: Monoid m => ( Int -> a -> m) -> NonEmpty a -> m Source # ifoldMap' :: Monoid m => ( Int -> a -> m) -> NonEmpty a -> m Source # ifoldr :: ( Int -> a -> b -> b) -> b -> NonEmpty a -> b Source # ifoldl :: ( Int -> b -> a -> b) -> b -> NonEmpty a -> b Source # ifoldr' :: ( Int -> a -> b -> b) -> b -> NonEmpty a -> b Source # ifoldl' :: ( Int -> b -> a -> b) -> b -> NonEmpty a -> b Source # |
|
FoldableWithIndex Int IntMap | |
Defined in WithIndex ifoldMap :: Monoid m => ( Int -> a -> m) -> IntMap a -> m Source # ifoldMap' :: Monoid m => ( Int -> a -> m) -> IntMap a -> m Source # ifoldr :: ( Int -> a -> b -> b) -> b -> IntMap a -> b Source # ifoldl :: ( Int -> b -> a -> b) -> b -> IntMap a -> b Source # ifoldr' :: ( Int -> a -> b -> b) -> b -> IntMap a -> b Source # ifoldl' :: ( Int -> b -> a -> b) -> b -> IntMap a -> b Source # |
|
FoldableWithIndex Int Seq | |
Defined in WithIndex ifoldMap :: Monoid m => ( Int -> a -> m) -> Seq a -> m Source # ifoldMap' :: Monoid m => ( Int -> a -> m) -> Seq a -> m Source # ifoldr :: ( Int -> a -> b -> b) -> b -> Seq a -> b Source # ifoldl :: ( Int -> b -> a -> b) -> b -> Seq a -> b Source # ifoldr' :: ( Int -> a -> b -> b) -> b -> Seq a -> b Source # ifoldl' :: ( Int -> b -> a -> b) -> b -> Seq a -> b Source # |
|
FoldableWithIndex Int Deque Source # | |
Defined in Control.Lens.Internal.Deque ifoldMap :: Monoid m => ( Int -> a -> m) -> Deque a -> m Source # ifoldMap' :: Monoid m => ( Int -> a -> m) -> Deque a -> m Source # ifoldr :: ( Int -> a -> b -> b) -> b -> Deque a -> b Source # ifoldl :: ( Int -> b -> a -> b) -> b -> Deque a -> b Source # ifoldr' :: ( Int -> a -> b -> b) -> b -> Deque a -> b Source # ifoldl' :: ( Int -> b -> a -> b) -> b -> Deque a -> b Source # |
|
FoldableWithIndex () Maybe | |
Defined in WithIndex ifoldMap :: Monoid m => (() -> a -> m) -> Maybe a -> m Source # ifoldMap' :: Monoid m => (() -> a -> m) -> Maybe a -> m Source # ifoldr :: (() -> a -> b -> b) -> b -> Maybe a -> b Source # ifoldl :: (() -> b -> a -> b) -> b -> Maybe a -> b Source # ifoldr' :: (() -> a -> b -> b) -> b -> Maybe a -> b Source # ifoldl' :: (() -> b -> a -> b) -> b -> Maybe a -> b Source # |
|
FoldableWithIndex () Par1 | |
Defined in WithIndex ifoldMap :: Monoid m => (() -> a -> m) -> Par1 a -> m Source # ifoldMap' :: Monoid m => (() -> a -> m) -> Par1 a -> m Source # ifoldr :: (() -> a -> b -> b) -> b -> Par1 a -> b Source # ifoldl :: (() -> b -> a -> b) -> b -> Par1 a -> b Source # |
|
FoldableWithIndex () Identity | |
Defined in WithIndex ifoldMap :: Monoid m => (() -> a -> m) -> Identity a -> m Source # ifoldMap' :: Monoid m => (() -> a -> m) -> Identity a -> m Source # ifoldr :: (() -> a -> b -> b) -> b -> Identity a -> b Source # ifoldl :: (() -> b -> a -> b) -> b -> Identity a -> b Source # ifoldr' :: (() -> a -> b -> b) -> b -> Identity a -> b Source # ifoldl' :: (() -> b -> a -> b) -> b -> Identity a -> b Source # |
|
FoldableWithIndex i ( Level i) Source # | |
Defined in Control.Lens.Internal.Level ifoldMap :: Monoid m => (i -> a -> m) -> Level i a -> m Source # ifoldMap' :: Monoid m => (i -> a -> m) -> Level i a -> m Source # ifoldr :: (i -> a -> b -> b) -> b -> Level i a -> b Source # ifoldl :: (i -> b -> a -> b) -> b -> Level i a -> b Source # ifoldr' :: (i -> a -> b -> b) -> b -> Level i a -> b Source # ifoldl' :: (i -> b -> a -> b) -> b -> Level i a -> b Source # |
|
FoldableWithIndex k ( Map k) | |
Defined in WithIndex ifoldMap :: Monoid m => (k -> a -> m) -> Map k a -> m Source # ifoldMap' :: Monoid m => (k -> a -> m) -> Map k a -> m Source # ifoldr :: (k -> a -> b -> b) -> b -> Map k a -> b Source # ifoldl :: (k -> b -> a -> b) -> b -> Map k a -> b Source # |
|
FoldableWithIndex k ( (,) k) | |
Defined in WithIndex |
|
Ix i => FoldableWithIndex i ( Array i) | |
Defined in WithIndex ifoldMap :: Monoid m => (i -> a -> m) -> Array i a -> m Source # ifoldMap' :: Monoid m => (i -> a -> m) -> Array i a -> m Source # ifoldr :: (i -> a -> b -> b) -> b -> Array i a -> b Source # ifoldl :: (i -> b -> a -> b) -> b -> Array i a -> b Source # ifoldr' :: (i -> a -> b -> b) -> b -> Array i a -> b Source # ifoldl' :: (i -> b -> a -> b) -> b -> Array i a -> b Source # |
|
FoldableWithIndex Void ( V1 :: Type -> Type ) | |
Defined in WithIndex ifoldMap :: Monoid m => ( Void -> a -> m) -> V1 a -> m Source # ifoldMap' :: Monoid m => ( Void -> a -> m) -> V1 a -> m Source # ifoldr :: ( Void -> a -> b -> b) -> b -> V1 a -> b Source # ifoldl :: ( Void -> b -> a -> b) -> b -> V1 a -> b Source # ifoldr' :: ( Void -> a -> b -> b) -> b -> V1 a -> b Source # ifoldl' :: ( Void -> b -> a -> b) -> b -> V1 a -> b Source # |
|
FoldableWithIndex Void ( U1 :: Type -> Type ) | |
Defined in WithIndex ifoldMap :: Monoid m => ( Void -> a -> m) -> U1 a -> m Source # ifoldMap' :: Monoid m => ( Void -> a -> m) -> U1 a -> m Source # ifoldr :: ( Void -> a -> b -> b) -> b -> U1 a -> b Source # ifoldl :: ( Void -> b -> a -> b) -> b -> U1 a -> b Source # ifoldr' :: ( Void -> a -> b -> b) -> b -> U1 a -> b Source # ifoldl' :: ( Void -> b -> a -> b) -> b -> U1 a -> b Source # |
|
FoldableWithIndex Void ( Proxy :: Type -> Type ) | |
Defined in WithIndex ifoldMap :: Monoid m => ( Void -> a -> m) -> Proxy a -> m Source # ifoldMap' :: Monoid m => ( Void -> a -> m) -> Proxy a -> m Source # ifoldr :: ( Void -> a -> b -> b) -> b -> Proxy a -> b Source # ifoldl :: ( Void -> b -> a -> b) -> b -> Proxy a -> b Source # ifoldr' :: ( Void -> a -> b -> b) -> b -> Proxy a -> b Source # ifoldl' :: ( Void -> b -> a -> b) -> b -> Proxy a -> b Source # |
|
FoldableWithIndex i f => FoldableWithIndex i ( Reverse f) | |
Defined in WithIndex ifoldMap :: Monoid m => (i -> a -> m) -> Reverse f a -> m Source # ifoldMap' :: Monoid m => (i -> a -> m) -> Reverse f a -> m Source # ifoldr :: (i -> a -> b -> b) -> b -> Reverse f a -> b Source # ifoldl :: (i -> b -> a -> b) -> b -> Reverse f a -> b Source # ifoldr' :: (i -> a -> b -> b) -> b -> Reverse f a -> b Source # ifoldl' :: (i -> b -> a -> b) -> b -> Reverse f a -> b Source # |
|
FoldableWithIndex i f => FoldableWithIndex i ( Rec1 f) | |
Defined in WithIndex ifoldMap :: Monoid m => (i -> a -> m) -> Rec1 f a -> m Source # ifoldMap' :: Monoid m => (i -> a -> m) -> Rec1 f a -> m Source # ifoldr :: (i -> a -> b -> b) -> b -> Rec1 f a -> b Source # ifoldl :: (i -> b -> a -> b) -> b -> Rec1 f a -> b Source # ifoldr' :: (i -> a -> b -> b) -> b -> Rec1 f a -> b Source # ifoldl' :: (i -> b -> a -> b) -> b -> Rec1 f a -> b Source # |
|
FoldableWithIndex i m => FoldableWithIndex i ( IdentityT m) | |
Defined in WithIndex ifoldMap :: Monoid m0 => (i -> a -> m0) -> IdentityT m a -> m0 Source # ifoldMap' :: Monoid m0 => (i -> a -> m0) -> IdentityT m a -> m0 Source # ifoldr :: (i -> a -> b -> b) -> b -> IdentityT m a -> b Source # ifoldl :: (i -> b -> a -> b) -> b -> IdentityT m a -> b Source # ifoldr' :: (i -> a -> b -> b) -> b -> IdentityT m a -> b Source # ifoldl' :: (i -> b -> a -> b) -> b -> IdentityT m a -> b Source # |
|
FoldableWithIndex i f => FoldableWithIndex i ( Backwards f) | |
Defined in WithIndex ifoldMap :: Monoid m => (i -> a -> m) -> Backwards f a -> m Source # ifoldMap' :: Monoid m => (i -> a -> m) -> Backwards f a -> m Source # ifoldr :: (i -> a -> b -> b) -> b -> Backwards f a -> b Source # ifoldl :: (i -> b -> a -> b) -> b -> Backwards f a -> b Source # ifoldr' :: (i -> a -> b -> b) -> b -> Backwards f a -> b Source # ifoldl' :: (i -> b -> a -> b) -> b -> Backwards f a -> b Source # |
|
FoldableWithIndex Void ( Const e :: Type -> Type ) | |
Defined in WithIndex ifoldMap :: Monoid m => ( Void -> a -> m) -> Const e a -> m Source # ifoldMap' :: Monoid m => ( Void -> a -> m) -> Const e a -> m Source # ifoldr :: ( Void -> a -> b -> b) -> b -> Const e a -> b Source # ifoldl :: ( Void -> b -> a -> b) -> b -> Const e a -> b Source # ifoldr' :: ( Void -> a -> b -> b) -> b -> Const e a -> b Source # ifoldl' :: ( Void -> b -> a -> b) -> b -> Const e a -> b Source # |
|
FoldableWithIndex Void ( Constant e :: Type -> Type ) | |
Defined in WithIndex ifoldMap :: Monoid m => ( Void -> a -> m) -> Constant e a -> m Source # ifoldMap' :: Monoid m => ( Void -> a -> m) -> Constant e a -> m Source # ifoldr :: ( Void -> a -> b -> b) -> b -> Constant e a -> b Source # ifoldl :: ( Void -> b -> a -> b) -> b -> Constant e a -> b Source # ifoldr' :: ( Void -> a -> b -> b) -> b -> Constant e a -> b Source # ifoldl' :: ( Void -> b -> a -> b) -> b -> Constant e a -> b Source # |
|
FoldableWithIndex i ( Magma i t b) Source # | |
Defined in Control.Lens.Internal.Magma ifoldMap :: Monoid m => (i -> a -> m) -> Magma i t b a -> m Source # ifoldMap' :: Monoid m => (i -> a -> m) -> Magma i t b a -> m Source # ifoldr :: (i -> a -> b0 -> b0) -> b0 -> Magma i t b a -> b0 Source # ifoldl :: (i -> b0 -> a -> b0) -> b0 -> Magma i t b a -> b0 Source # ifoldr' :: (i -> a -> b0 -> b0) -> b0 -> Magma i t b a -> b0 Source # ifoldl' :: (i -> b0 -> a -> b0) -> b0 -> Magma i t b a -> b0 Source # |
|
FoldableWithIndex Void ( K1 i c :: Type -> Type ) | |
Defined in WithIndex ifoldMap :: Monoid m => ( Void -> a -> m) -> K1 i c a -> m Source # ifoldMap' :: Monoid m => ( Void -> a -> m) -> K1 i c a -> m Source # ifoldr :: ( Void -> a -> b -> b) -> b -> K1 i c a -> b Source # ifoldl :: ( Void -> b -> a -> b) -> b -> K1 i c a -> b Source # ifoldr' :: ( Void -> a -> b -> b) -> b -> K1 i c a -> b Source # ifoldl' :: ( Void -> b -> a -> b) -> b -> K1 i c a -> b Source # |
|
FoldableWithIndex [ Int ] Tree | |
Defined in WithIndex ifoldMap :: Monoid m => ([ Int ] -> a -> m) -> Tree a -> m Source # ifoldMap' :: Monoid m => ([ Int ] -> a -> m) -> Tree a -> m Source # ifoldr :: ([ Int ] -> a -> b -> b) -> b -> Tree a -> b Source # ifoldl :: ([ Int ] -> b -> a -> b) -> b -> Tree a -> b Source # ifoldr' :: ([ Int ] -> a -> b -> b) -> b -> Tree a -> b Source # ifoldl' :: ([ Int ] -> b -> a -> b) -> b -> Tree a -> b Source # |
|
FoldableWithIndex i f => FoldableWithIndex [i] ( Free f) | |
Defined in Control.Monad.Free ifoldMap :: Monoid m => ([i] -> a -> m) -> Free f a -> m Source # ifoldMap' :: Monoid m => ([i] -> a -> m) -> Free f a -> m Source # ifoldr :: ([i] -> a -> b -> b) -> b -> Free f a -> b Source # ifoldl :: ([i] -> b -> a -> b) -> b -> Free f a -> b Source # ifoldr' :: ([i] -> a -> b -> b) -> b -> Free f a -> b Source # ifoldl' :: ([i] -> b -> a -> b) -> b -> Free f a -> b Source # |
|
FoldableWithIndex i f => FoldableWithIndex [i] ( Cofree f) | |
Defined in Control.Comonad.Cofree ifoldMap :: Monoid m => ([i] -> a -> m) -> Cofree f a -> m Source # ifoldMap' :: Monoid m => ([i] -> a -> m) -> Cofree f a -> m Source # ifoldr :: ([i] -> a -> b -> b) -> b -> Cofree f a -> b Source # ifoldl :: ([i] -> b -> a -> b) -> b -> Cofree f a -> b Source # ifoldr' :: ([i] -> a -> b -> b) -> b -> Cofree f a -> b Source # ifoldl' :: ([i] -> b -> a -> b) -> b -> Cofree f a -> b Source # |
|
( FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex ( Either i j) ( Sum f g) | |
Defined in WithIndex ifoldMap :: Monoid m => ( Either i j -> a -> m) -> Sum f g a -> m Source # ifoldMap' :: Monoid m => ( Either i j -> a -> m) -> Sum f g a -> m Source # ifoldr :: ( Either i j -> a -> b -> b) -> b -> Sum f g a -> b Source # ifoldl :: ( Either i j -> b -> a -> b) -> b -> Sum f g a -> b Source # ifoldr' :: ( Either i j -> a -> b -> b) -> b -> Sum f g a -> b Source # ifoldl' :: ( Either i j -> b -> a -> b) -> b -> Sum f g a -> b Source # |
|
( FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex ( Either i j) ( Product f g) | |
Defined in WithIndex ifoldMap :: Monoid m => ( Either i j -> a -> m) -> Product f g a -> m Source # ifoldMap' :: Monoid m => ( Either i j -> a -> m) -> Product f g a -> m Source # ifoldr :: ( Either i j -> a -> b -> b) -> b -> Product f g a -> b Source # ifoldl :: ( Either i j -> b -> a -> b) -> b -> Product f g a -> b Source # ifoldr' :: ( Either i j -> a -> b -> b) -> b -> Product f g a -> b Source # ifoldl' :: ( Either i j -> b -> a -> b) -> b -> Product f g a -> b Source # |
|
( FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex ( Either i j) (f :+: g) | |
Defined in WithIndex ifoldMap :: Monoid m => ( Either i j -> a -> m) -> (f :+: g) a -> m Source # ifoldMap' :: Monoid m => ( Either i j -> a -> m) -> (f :+: g) a -> m Source # ifoldr :: ( Either i j -> a -> b -> b) -> b -> (f :+: g) a -> b Source # ifoldl :: ( Either i j -> b -> a -> b) -> b -> (f :+: g) a -> b Source # ifoldr' :: ( Either i j -> a -> b -> b) -> b -> (f :+: g) a -> b Source # ifoldl' :: ( Either i j -> b -> a -> b) -> b -> (f :+: g) a -> b Source # |
|
( FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex ( Either i j) (f :*: g) | |
Defined in WithIndex ifoldMap :: Monoid m => ( Either i j -> a -> m) -> (f :*: g) a -> m Source # ifoldMap' :: Monoid m => ( Either i j -> a -> m) -> (f :*: g) a -> m Source # ifoldr :: ( Either i j -> a -> b -> b) -> b -> (f :*: g) a -> b Source # ifoldl :: ( Either i j -> b -> a -> b) -> b -> (f :*: g) a -> b Source # ifoldr' :: ( Either i j -> a -> b -> b) -> b -> (f :*: g) a -> b Source # ifoldl' :: ( Either i j -> b -> a -> b) -> b -> (f :*: g) a -> b Source # |
|
( FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (i, j) ( Compose f g) | |
Defined in WithIndex ifoldMap :: Monoid m => ((i, j) -> a -> m) -> Compose f g a -> m Source # ifoldMap' :: Monoid m => ((i, j) -> a -> m) -> Compose f g a -> m Source # ifoldr :: ((i, j) -> a -> b -> b) -> b -> Compose f g a -> b Source # ifoldl :: ((i, j) -> b -> a -> b) -> b -> Compose f g a -> b Source # ifoldr' :: ((i, j) -> a -> b -> b) -> b -> Compose f g a -> b Source # ifoldl' :: ((i, j) -> b -> a -> b) -> b -> Compose f g a -> b Source # |
|
( FoldableWithIndex i f, FoldableWithIndex j g) => FoldableWithIndex (i, j) (f :.: g) | |
Defined in WithIndex ifoldMap :: Monoid m => ((i, j) -> a -> m) -> (f :.: g) a -> m Source # ifoldMap' :: Monoid m => ((i, j) -> a -> m) -> (f :.: g) a -> m Source # ifoldr :: ((i, j) -> a -> b -> b) -> b -> (f :.: g) a -> b Source # ifoldl :: ((i, j) -> b -> a -> b) -> b -> (f :.: g) a -> b Source # ifoldr' :: ((i, j) -> a -> b -> b) -> b -> (f :.: g) a -> b Source # ifoldl' :: ((i, j) -> b -> a -> b) -> b -> (f :.: g) a -> b Source # |
class ( FunctorWithIndex i t, FoldableWithIndex i t, Traversable t) => TraversableWithIndex i (t :: Type -> Type ) | t -> i where Source #
A
Traversable
with an additional index.
An instance must satisfy a (modified) form of the
Traversable
laws:
itraverse
(const
Identity
) ≡Identity
fmap
(itraverse
f).
itraverse
g ≡getCompose
.
itraverse
(\i ->Compose
.
fmap
(f i).
g i)
Nothing
itraverse :: Applicative f => (i -> a -> f b) -> t a -> f (t b) Source #
Traverse an indexed container.
itraverse
≡itraverseOf
itraversed
Instances
class Profunctor (p :: Type -> Type -> Type ) where Source #
Formally, the class
Profunctor
represents a profunctor
from
Hask
->
Hask
.
Intuitively it is a bifunctor where the first argument is contravariant and the second argument is covariant.
You can define a
Profunctor
by either defining
dimap
or by defining both
lmap
and
rmap
.
If you supply
dimap
, you should ensure that:
dimap
id
id
≡id
If you supply
lmap
and
rmap
, ensure:
lmap
id
≡id
rmap
id
≡id
If you supply both, you should also ensure:
dimap
f g ≡lmap
f.
rmap
g
These ensure by parametricity:
dimap
(f.
g) (h.
i) ≡dimap
g h.
dimap
f ilmap
(f.
g) ≡lmap
g.
lmap
frmap
(f.
g) ≡rmap
f.
rmap
g
dimap :: (a -> b) -> (c -> d) -> p b c -> p a d Source #
Instances
Profunctor ReifiedFold Source # | |
Defined in Control.Lens.Reified dimap :: (a -> b) -> (c -> d) -> ReifiedFold b c -> ReifiedFold a d Source # lmap :: (a -> b) -> ReifiedFold b c -> ReifiedFold a c Source # rmap :: (b -> c) -> ReifiedFold a b -> ReifiedFold a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> ReifiedFold a b -> ReifiedFold a c Source # (.#) :: forall a b c q. Coercible b a => ReifiedFold b c -> q a b -> ReifiedFold a c Source # |
|
Profunctor ReifiedGetter Source # | |
Defined in Control.Lens.Reified dimap :: (a -> b) -> (c -> d) -> ReifiedGetter b c -> ReifiedGetter a d Source # lmap :: (a -> b) -> ReifiedGetter b c -> ReifiedGetter a c Source # rmap :: (b -> c) -> ReifiedGetter a b -> ReifiedGetter a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> ReifiedGetter a b -> ReifiedGetter a c Source # (.#) :: forall a b c q. Coercible b a => ReifiedGetter b c -> q a b -> ReifiedGetter a c Source # |
|
Monad m => Profunctor ( Kleisli m) | |
Defined in Data.Profunctor.Unsafe dimap :: (a -> b) -> (c -> d) -> Kleisli m b c -> Kleisli m a d Source # lmap :: (a -> b) -> Kleisli m b c -> Kleisli m a c Source # rmap :: (b -> c) -> Kleisli m a b -> Kleisli m a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> Kleisli m a b -> Kleisli m a c Source # (.#) :: forall a b c q. Coercible b a => Kleisli m b c -> q a b -> Kleisli m a c Source # |
|
Profunctor p => Profunctor ( CofreeMapping p) | |
Defined in Data.Profunctor.Mapping dimap :: (a -> b) -> (c -> d) -> CofreeMapping p b c -> CofreeMapping p a d Source # lmap :: (a -> b) -> CofreeMapping p b c -> CofreeMapping p a c Source # rmap :: (b -> c) -> CofreeMapping p a b -> CofreeMapping p a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> CofreeMapping p a b -> CofreeMapping p a c Source # (.#) :: forall a b c q. Coercible b a => CofreeMapping p b c -> q a b -> CofreeMapping p a c Source # |
|
Profunctor ( FreeMapping p) | |
Defined in Data.Profunctor.Mapping dimap :: (a -> b) -> (c -> d) -> FreeMapping p b c -> FreeMapping p a d Source # lmap :: (a -> b) -> FreeMapping p b c -> FreeMapping p a c Source # rmap :: (b -> c) -> FreeMapping p a b -> FreeMapping p a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> FreeMapping p a b -> FreeMapping p a c Source # (.#) :: forall a b c q. Coercible b a => FreeMapping p b c -> q a b -> FreeMapping p a c Source # |
|
Profunctor p => Profunctor ( CofreeTraversing p) | |
Defined in Data.Profunctor.Traversing dimap :: (a -> b) -> (c -> d) -> CofreeTraversing p b c -> CofreeTraversing p a d Source # lmap :: (a -> b) -> CofreeTraversing p b c -> CofreeTraversing p a c Source # rmap :: (b -> c) -> CofreeTraversing p a b -> CofreeTraversing p a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> CofreeTraversing p a b -> CofreeTraversing p a c Source # (.#) :: forall a b c q. Coercible b a => CofreeTraversing p b c -> q a b -> CofreeTraversing p a c Source # |
|
Profunctor ( FreeTraversing p) | |
Defined in Data.Profunctor.Traversing dimap :: (a -> b) -> (c -> d) -> FreeTraversing p b c -> FreeTraversing p a d Source # lmap :: (a -> b) -> FreeTraversing p b c -> FreeTraversing p a c Source # rmap :: (b -> c) -> FreeTraversing p a b -> FreeTraversing p a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> FreeTraversing p a b -> FreeTraversing p a c Source # (.#) :: forall a b c q. Coercible b a => FreeTraversing p b c -> q a b -> FreeTraversing p a c Source # |
|
Profunctor p => Profunctor ( TambaraSum p) | |
Defined in Data.Profunctor.Choice dimap :: (a -> b) -> (c -> d) -> TambaraSum p b c -> TambaraSum p a d Source # lmap :: (a -> b) -> TambaraSum p b c -> TambaraSum p a c Source # rmap :: (b -> c) -> TambaraSum p a b -> TambaraSum p a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> TambaraSum p a b -> TambaraSum p a c Source # (.#) :: forall a b c q. Coercible b a => TambaraSum p b c -> q a b -> TambaraSum p a c Source # |
|
Profunctor ( PastroSum p) | |
Defined in Data.Profunctor.Choice dimap :: (a -> b) -> (c -> d) -> PastroSum p b c -> PastroSum p a d Source # lmap :: (a -> b) -> PastroSum p b c -> PastroSum p a c Source # rmap :: (b -> c) -> PastroSum p a b -> PastroSum p a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> PastroSum p a b -> PastroSum p a c Source # (.#) :: forall a b c q. Coercible b a => PastroSum p b c -> q a b -> PastroSum p a c Source # |
|
Profunctor ( CotambaraSum p) | |
Defined in Data.Profunctor.Choice dimap :: (a -> b) -> (c -> d) -> CotambaraSum p b c -> CotambaraSum p a d Source # lmap :: (a -> b) -> CotambaraSum p b c -> CotambaraSum p a c Source # rmap :: (b -> c) -> CotambaraSum p a b -> CotambaraSum p a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> CotambaraSum p a b -> CotambaraSum p a c Source # (.#) :: forall a b c q. Coercible b a => CotambaraSum p b c -> q a b -> CotambaraSum p a c Source # |
|
Profunctor ( CopastroSum p) | |
Defined in Data.Profunctor.Choice dimap :: (a -> b) -> (c -> d) -> CopastroSum p b c -> CopastroSum p a d Source # lmap :: (a -> b) -> CopastroSum p b c -> CopastroSum p a c Source # rmap :: (b -> c) -> CopastroSum p a b -> CopastroSum p a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> CopastroSum p a b -> CopastroSum p a c Source # (.#) :: forall a b c q. Coercible b a => CopastroSum p b c -> q a b -> CopastroSum p a c Source # |
|
Profunctor p => Profunctor ( Closure p) | |
Defined in Data.Profunctor.Closed dimap :: (a -> b) -> (c -> d) -> Closure p b c -> Closure p a d Source # lmap :: (a -> b) -> Closure p b c -> Closure p a c Source # rmap :: (b -> c) -> Closure p a b -> Closure p a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> Closure p a b -> Closure p a c Source # (.#) :: forall a b c q. Coercible b a => Closure p b c -> q a b -> Closure p a c Source # |
|
Profunctor ( Environment p) | |
Defined in Data.Profunctor.Closed dimap :: (a -> b) -> (c -> d) -> Environment p b c -> Environment p a d Source # lmap :: (a -> b) -> Environment p b c -> Environment p a c Source # rmap :: (b -> c) -> Environment p a b -> Environment p a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> Environment p a b -> Environment p a c Source # (.#) :: forall a b c q. Coercible b a => Environment p b c -> q a b -> Environment p a c Source # |
|
Profunctor p => Profunctor ( Tambara p) | |
Defined in Data.Profunctor.Strong dimap :: (a -> b) -> (c -> d) -> Tambara p b c -> Tambara p a d Source # lmap :: (a -> b) -> Tambara p b c -> Tambara p a c Source # rmap :: (b -> c) -> Tambara p a b -> Tambara p a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> Tambara p a b -> Tambara p a c Source # (.#) :: forall a b c q. Coercible b a => Tambara p b c -> q a b -> Tambara p a c Source # |
|
Profunctor ( Pastro p) | |
Defined in Data.Profunctor.Strong dimap :: (a -> b) -> (c -> d) -> Pastro p b c -> Pastro p a d Source # lmap :: (a -> b) -> Pastro p b c -> Pastro p a c Source # rmap :: (b -> c) -> Pastro p a b -> Pastro p a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> Pastro p a b -> Pastro p a c Source # (.#) :: forall a b c q. Coercible b a => Pastro p b c -> q a b -> Pastro p a c Source # |
|
Profunctor ( Cotambara p) | |
Defined in Data.Profunctor.Strong dimap :: (a -> b) -> (c -> d) -> Cotambara p b c -> Cotambara p a d Source # lmap :: (a -> b) -> Cotambara p b c -> Cotambara p a c Source # rmap :: (b -> c) -> Cotambara p a b -> Cotambara p a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> Cotambara p a b -> Cotambara p a c Source # (.#) :: forall a b c q. Coercible b a => Cotambara p b c -> q a b -> Cotambara p a c Source # |
|
Profunctor ( Copastro p) | |
Defined in Data.Profunctor.Strong dimap :: (a -> b) -> (c -> d) -> Copastro p b c -> Copastro p a d Source # lmap :: (a -> b) -> Copastro p b c -> Copastro p a c Source # rmap :: (b -> c) -> Copastro p a b -> Copastro p a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> Copastro p a b -> Copastro p a c Source # (.#) :: forall a b c q. Coercible b a => Copastro p b c -> q a b -> Copastro p a c Source # |
|
Profunctor ( Tagged :: Type -> Type -> Type ) | |
Defined in Data.Profunctor.Unsafe dimap :: (a -> b) -> (c -> d) -> Tagged b c -> Tagged a d Source # lmap :: (a -> b) -> Tagged b c -> Tagged a c Source # rmap :: (b -> c) -> Tagged a b -> Tagged a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> Tagged a b -> Tagged a c Source # (.#) :: forall a b c q. Coercible b a => Tagged b c -> q a b -> Tagged a c Source # |
|
Profunctor ( Indexed i) Source # | |
Defined in Control.Lens.Internal.Indexed dimap :: (a -> b) -> (c -> d) -> Indexed i b c -> Indexed i a d Source # lmap :: (a -> b) -> Indexed i b c -> Indexed i a c Source # rmap :: (b -> c) -> Indexed i a b -> Indexed i a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> Indexed i a b -> Indexed i a c Source # (.#) :: forall a b c q. Coercible b a => Indexed i b c -> q a b -> Indexed i a c Source # |
|
Profunctor (Baz t) | |
Defined in Data.Profunctor.Traversing dimap :: (a -> b) -> (c -> d) -> Baz t b c -> Baz t a d Source # lmap :: (a -> b) -> Baz t b c -> Baz t a c Source # rmap :: (b -> c) -> Baz t a b -> Baz t a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> Baz t a b -> Baz t a c Source # (.#) :: forall a b c q. Coercible b a => Baz t b c -> q a b -> Baz t a c Source # |
|
Profunctor ( ReifiedIndexedFold i) Source # | |
Defined in Control.Lens.Reified dimap :: (a -> b) -> (c -> d) -> ReifiedIndexedFold i b c -> ReifiedIndexedFold i a d Source # lmap :: (a -> b) -> ReifiedIndexedFold i b c -> ReifiedIndexedFold i a c Source # rmap :: (b -> c) -> ReifiedIndexedFold i a b -> ReifiedIndexedFold i a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> ReifiedIndexedFold i a b -> ReifiedIndexedFold i a c Source # (.#) :: forall a b c q. Coercible b a => ReifiedIndexedFold i b c -> q a b -> ReifiedIndexedFold i a c Source # |
|
Profunctor ( ReifiedIndexedGetter i) Source # | |
Defined in Control.Lens.Reified dimap :: (a -> b) -> (c -> d) -> ReifiedIndexedGetter i b c -> ReifiedIndexedGetter i a d Source # lmap :: (a -> b) -> ReifiedIndexedGetter i b c -> ReifiedIndexedGetter i a c Source # rmap :: (b -> c) -> ReifiedIndexedGetter i a b -> ReifiedIndexedGetter i a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> ReifiedIndexedGetter i a b -> ReifiedIndexedGetter i a c Source # (.#) :: forall a b c q. Coercible b a => ReifiedIndexedGetter i b c -> q a b -> ReifiedIndexedGetter i a c Source # |
|
Profunctor (Bazaar a) | |
Defined in Data.Profunctor.Traversing dimap :: (a0 -> b) -> (c -> d) -> Bazaar a b c -> Bazaar a a0 d Source # lmap :: (a0 -> b) -> Bazaar a b c -> Bazaar a a0 c Source # rmap :: (b -> c) -> Bazaar a a0 b -> Bazaar a a0 c Source # (#.) :: forall a0 b c q. Coercible c b => q b c -> Bazaar a a0 b -> Bazaar a a0 c Source # (.#) :: forall a0 b c q. Coercible b a0 => Bazaar a b c -> q a0 b -> Bazaar a a0 c Source # |
|
Profunctor ((->) :: Type -> Type -> Type ) | |
Defined in Data.Profunctor.Unsafe dimap :: (a -> b) -> (c -> d) -> (b -> c) -> a -> d Source # lmap :: (a -> b) -> (b -> c) -> a -> c Source # rmap :: (b -> c) -> (a -> b) -> a -> c Source # (#.) :: forall a b c q. Coercible c b => q b c -> (a -> b) -> a -> c Source # (.#) :: forall a b c q. Coercible b a => (b -> c) -> q a b -> a -> c Source # |
|
Functor w => Profunctor ( Cokleisli w) | |
Defined in Data.Profunctor.Unsafe dimap :: (a -> b) -> (c -> d) -> Cokleisli w b c -> Cokleisli w a d Source # lmap :: (a -> b) -> Cokleisli w b c -> Cokleisli w a c Source # rmap :: (b -> c) -> Cokleisli w a b -> Cokleisli w a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> Cokleisli w a b -> Cokleisli w a c Source # (.#) :: forall a b c q. Coercible b a => Cokleisli w b c -> q a b -> Cokleisli w a c Source # |
|
Functor f => Profunctor ( Star f) | |
Defined in Data.Profunctor.Types dimap :: (a -> b) -> (c -> d) -> Star f b c -> Star f a d Source # lmap :: (a -> b) -> Star f b c -> Star f a c Source # rmap :: (b -> c) -> Star f a b -> Star f a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> Star f a b -> Star f a c Source # (.#) :: forall a b c q. Coercible b a => Star f b c -> q a b -> Star f a c Source # |
|
Functor f => Profunctor ( Costar f) | |
Defined in Data.Profunctor.Types dimap :: (a -> b) -> (c -> d) -> Costar f b c -> Costar f a d Source # lmap :: (a -> b) -> Costar f b c -> Costar f a c Source # rmap :: (b -> c) -> Costar f a b -> Costar f a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> Costar f a b -> Costar f a c Source # (.#) :: forall a b c q. Coercible b a => Costar f b c -> q a b -> Costar f a c Source # |
|
Profunctor ( Forget r :: Type -> Type -> Type ) | |
Defined in Data.Profunctor.Types dimap :: (a -> b) -> (c -> d) -> Forget r b c -> Forget r a d Source # lmap :: (a -> b) -> Forget r b c -> Forget r a c Source # rmap :: (b -> c) -> Forget r a b -> Forget r a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> Forget r a b -> Forget r a c Source # (.#) :: forall a b c q. Coercible b a => Forget r b c -> q a b -> Forget r a c Source # |
|
Profunctor ( Exchange a b) Source # | |
Defined in Control.Lens.Internal.Iso dimap :: (a0 -> b0) -> (c -> d) -> Exchange a b b0 c -> Exchange a b a0 d Source # lmap :: (a0 -> b0) -> Exchange a b b0 c -> Exchange a b a0 c Source # rmap :: (b0 -> c) -> Exchange a b a0 b0 -> Exchange a b a0 c Source # (#.) :: forall a0 b0 c q. Coercible c b0 => q b0 c -> Exchange a b a0 b0 -> Exchange a b a0 c Source # (.#) :: forall a0 b0 c q. Coercible b0 a0 => Exchange a b b0 c -> q a0 b0 -> Exchange a b a0 c Source # |
|
Profunctor ( Market a b) Source # | |
Defined in Control.Lens.Internal.Prism dimap :: (a0 -> b0) -> (c -> d) -> Market a b b0 c -> Market a b a0 d Source # lmap :: (a0 -> b0) -> Market a b b0 c -> Market a b a0 c Source # rmap :: (b0 -> c) -> Market a b a0 b0 -> Market a b a0 c Source # (#.) :: forall a0 b0 c q. Coercible c b0 => q b0 c -> Market a b a0 b0 -> Market a b a0 c Source # (.#) :: forall a0 b0 c q. Coercible b0 a0 => Market a b b0 c -> q a0 b0 -> Market a b a0 c Source # |
|
( Functor f, Profunctor p) => Profunctor ( WrappedPafb f p) Source # | |
Defined in Control.Lens.Internal.Profunctor dimap :: (a -> b) -> (c -> d) -> WrappedPafb f p b c -> WrappedPafb f p a d Source # lmap :: (a -> b) -> WrappedPafb f p b c -> WrappedPafb f p a c Source # rmap :: (b -> c) -> WrappedPafb f p a b -> WrappedPafb f p a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> WrappedPafb f p a b -> WrappedPafb f p a c Source # (.#) :: forall a b c q. Coercible b a => WrappedPafb f p b c -> q a b -> WrappedPafb f p a c Source # |
|
Functor f => Profunctor ( Joker f :: Type -> Type -> Type ) | |
Defined in Data.Profunctor.Unsafe dimap :: (a -> b) -> (c -> d) -> Joker f b c -> Joker f a d Source # lmap :: (a -> b) -> Joker f b c -> Joker f a c Source # rmap :: (b -> c) -> Joker f a b -> Joker f a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> Joker f a b -> Joker f a c Source # (.#) :: forall a b c q. Coercible b a => Joker f b c -> q a b -> Joker f a c Source # |
|
Contravariant f => Profunctor ( Clown f :: Type -> Type -> Type ) | |
Defined in Data.Profunctor.Unsafe dimap :: (a -> b) -> (c -> d) -> Clown f b c -> Clown f a d Source # lmap :: (a -> b) -> Clown f b c -> Clown f a c Source # rmap :: (b -> c) -> Clown f a b -> Clown f a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> Clown f a b -> Clown f a c Source # (.#) :: forall a b c q. Coercible b a => Clown f b c -> q a b -> Clown f a c Source # |
|
Arrow p => Profunctor ( WrappedArrow p) | |
Defined in Data.Profunctor.Types dimap :: (a -> b) -> (c -> d) -> WrappedArrow p b c -> WrappedArrow p a d Source # lmap :: (a -> b) -> WrappedArrow p b c -> WrappedArrow p a c Source # rmap :: (b -> c) -> WrappedArrow p a b -> WrappedArrow p a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> WrappedArrow p a b -> WrappedArrow p a c Source # (.#) :: forall a b c q. Coercible b a => WrappedArrow p b c -> q a b -> WrappedArrow p a c Source # |
|
( Profunctor p, Profunctor q) => Profunctor ( Sum p q) | |
Defined in Data.Profunctor.Unsafe dimap :: (a -> b) -> (c -> d) -> Sum p q b c -> Sum p q a d Source # lmap :: (a -> b) -> Sum p q b c -> Sum p q a c Source # rmap :: (b -> c) -> Sum p q a b -> Sum p q a c Source # (#.) :: forall a b c q0. Coercible c b => q0 b c -> Sum p q a b -> Sum p q a c Source # (.#) :: forall a b c q0. Coercible b a => Sum p q b c -> q0 a b -> Sum p q a c Source # |
|
( Profunctor p, Profunctor q) => Profunctor ( Product p q) | |
Defined in Data.Profunctor.Unsafe dimap :: (a -> b) -> (c -> d) -> Product p q b c -> Product p q a d Source # lmap :: (a -> b) -> Product p q b c -> Product p q a c Source # rmap :: (b -> c) -> Product p q a b -> Product p q a c Source # (#.) :: forall a b c q0. Coercible c b => q0 b c -> Product p q a b -> Product p q a c Source # (.#) :: forall a b c q0. Coercible b a => Product p q b c -> q0 a b -> Product p q a c Source # |
|
( Functor f, Profunctor p) => Profunctor ( Tannen f p) | |
Defined in Data.Profunctor.Unsafe dimap :: (a -> b) -> (c -> d) -> Tannen f p b c -> Tannen f p a d Source # lmap :: (a -> b) -> Tannen f p b c -> Tannen f p a c Source # rmap :: (b -> c) -> Tannen f p a b -> Tannen f p a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> Tannen f p a b -> Tannen f p a c Source # (.#) :: forall a b c q. Coercible b a => Tannen f p b c -> q a b -> Tannen f p a c Source # |
|
( Functor f, Profunctor p) => Profunctor ( Cayley f p) | |
Defined in Data.Profunctor.Cayley dimap :: (a -> b) -> (c -> d) -> Cayley f p b c -> Cayley f p a d Source # lmap :: (a -> b) -> Cayley f p b c -> Cayley f p a c Source # rmap :: (b -> c) -> Cayley f p a b -> Cayley f p a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> Cayley f p a b -> Cayley f p a c Source # (.#) :: forall a b c q. Coercible b a => Cayley f p b c -> q a b -> Cayley f p a c Source # |
|
( Profunctor p, Profunctor q) => Profunctor ( Procompose p q) | |
Defined in Data.Profunctor.Composition dimap :: (a -> b) -> (c -> d) -> Procompose p q b c -> Procompose p q a d Source # lmap :: (a -> b) -> Procompose p q b c -> Procompose p q a c Source # rmap :: (b -> c) -> Procompose p q a b -> Procompose p q a c Source # (#.) :: forall a b c q0. Coercible c b => q0 b c -> Procompose p q a b -> Procompose p q a c Source # (.#) :: forall a b c q0. Coercible b a => Procompose p q b c -> q0 a b -> Procompose p q a c Source # |
|
( Profunctor p, Profunctor q) => Profunctor ( Rift p q) | |
Defined in Data.Profunctor.Composition dimap :: (a -> b) -> (c -> d) -> Rift p q b c -> Rift p q a d Source # lmap :: (a -> b) -> Rift p q b c -> Rift p q a c Source # rmap :: (b -> c) -> Rift p q a b -> Rift p q a c Source # (#.) :: forall a b c q0. Coercible c b => q0 b c -> Rift p q a b -> Rift p q a c Source # (.#) :: forall a b c q0. Coercible b a => Rift p q b c -> q0 a b -> Rift p q a c Source # |
|
( Profunctor p, Functor f, Functor g) => Profunctor ( Biff p f g) | |
Defined in Data.Profunctor.Unsafe dimap :: (a -> b) -> (c -> d) -> Biff p f g b c -> Biff p f g a d Source # lmap :: (a -> b) -> Biff p f g b c -> Biff p f g a c Source # rmap :: (b -> c) -> Biff p f g a b -> Biff p f g a c Source # (#.) :: forall a b c q. Coercible c b => q b c -> Biff p f g a b -> Biff p f g a c Source # (.#) :: forall a b c q. Coercible b a => Biff p f g b c -> q a b -> Biff p f g a c Source # |
class Profunctor p => Choice (p :: Type -> Type -> Type ) where Source #
The generalization of
Costar
of
Functor
that is strong with respect
to
Either
.
Note: This is also a notion of strength, except with regards to another monoidal structure that we can choose to equip Hask with: the cocartesian coproduct.
left' :: p a b -> p ( Either a c) ( Either b c) Source #
Laws:
left'
≡dimap
swapE swapE.
right'
where swapE ::Either
a b ->Either
b a swapE =either
Right
Left
rmap
Left
≡lmap
Left
.
left'
lmap
(right
f).
left'
≡rmap
(right
f).
left'
left'
.
left'
≡dimap
assocE unassocE.
left'
where assocE ::Either
(Either
a b) c ->Either
a (Either
b c) assocE (Left
(Left
a)) =Left
a assocE (Left
(Right
b)) =Right
(Left
b) assocE (Right
c) =Right
(Right
c) unassocE ::Either
a (Either
b c) ->Either
(Either
a b) c unassocE (Left
a) =Left
(Left
a) unassocE (Right
(Left
b)) =Left
(Right
b) unassocE (Right
(Right
c)) =Right
c
right' :: p a b -> p ( Either c a) ( Either c b) Source #
Laws:
right'
≡dimap
swapE swapE.
left'
where swapE ::Either
a b ->Either
b a swapE =either
Right
Left
rmap
Right
≡lmap
Right
.
right'
lmap
(left
f).
right'
≡rmap
(left
f).
right'
right'
.
right'
≡dimap
unassocE assocE.
right'
where assocE ::Either
(Either
a b) c ->Either
a (Either
b c) assocE (Left
(Left
a)) =Left
a assocE (Left
(Right
b)) =Right
(Left
b) assocE (Right
c) =Right
(Right
c) unassocE ::Either
a (Either
b c) ->Either
(Either
a b) c unassocE (Left
a) =Left
(Left
a) unassocE (Right
(Left
b)) =Left
(Right
b) unassocE (Right
(Right
c)) =Right
c
Instances
sequenceBy :: Traversable t => ( forall x. x -> f x) -> ( forall x y. f (x -> y) -> f x -> f y) -> t (f a) -> f (t a) Source #
Sequence a container using its
Traversable
instance using
explicitly provided
Applicative
operations. This is like
sequence
where the
Applicative
instance can be manually specified.
traverseBy :: Traversable t => ( forall x. x -> f x) -> ( forall x y. f (x -> y) -> f x -> f y) -> (a -> f b) -> t a -> f (t b) Source #
Traverse a container using its
Traversable
instance using
explicitly provided
Applicative
operations. This is like
traverse
where the
Applicative
instance can be manually specified.
class ( Foldable1 t, Traversable t) => Traversable1 (t :: Type -> Type ) where Source #
Instances
class Reversing t where Source #
This class provides a generalized notion of list reversal extended to other containers.
Instances
Reversing ByteString Source # | |
Defined in Control.Lens.Internal.Iso reversing :: ByteString -> ByteString Source # |
|
Reversing ByteString Source # | |
Defined in Control.Lens.Internal.Iso reversing :: ByteString -> ByteString Source # |
|
Reversing Text Source # | |
Reversing Text Source # | |
Reversing [a] Source # | |
Defined in Control.Lens.Internal.Iso |
|
Reversing ( NonEmpty a) Source # | |
Reversing ( Seq a) Source # | |
Unbox a => Reversing ( Vector a) Source # | |
Storable a => Reversing ( Vector a) Source # | |
Prim a => Reversing ( Vector a) Source # | |
Reversing ( Vector a) Source # | |
Reversing ( Deque a) Source # | |
This data type represents a path-compressed copy of one level of a source data structure. We can safely use path-compression because we know the depth of the tree.
Path compression is performed by viewing a
Level
as a PATRICIA trie of the
paths into the structure to leaves at a given depth, similar in many ways
to a
IntMap
, but unlike a regular PATRICIA trie we do not need
to store the mask bits merely the depth of the fork.
One invariant of this structure is that underneath a
Two
node you will not
find any
Zero
nodes, so
Zero
can only occur at the root.
Instances
FunctorWithIndex i ( Level i) Source # | |
FoldableWithIndex i ( Level i) Source # | |
Defined in Control.Lens.Internal.Level ifoldMap :: Monoid m => (i -> a -> m) -> Level i a -> m Source # ifoldMap' :: Monoid m => (i -> a -> m) -> Level i a -> m Source # ifoldr :: (i -> a -> b -> b) -> b -> Level i a -> b Source # ifoldl :: (i -> b -> a -> b) -> b -> Level i a -> b Source # ifoldr' :: (i -> a -> b -> b) -> b -> Level i a -> b Source # ifoldl' :: (i -> b -> a -> b) -> b -> Level i a -> b Source # |
|
TraversableWithIndex i ( Level i) Source # | |
Defined in Control.Lens.Internal.Level |
|
Functor ( Level i) Source # | |
Foldable ( Level i) Source # | |
Defined in Control.Lens.Internal.Level fold :: Monoid m => Level i m -> m Source # foldMap :: Monoid m => (a -> m) -> Level i a -> m Source # foldMap' :: Monoid m => (a -> m) -> Level i a -> m Source # foldr :: (a -> b -> b) -> b -> Level i a -> b Source # foldr' :: (a -> b -> b) -> b -> Level i a -> b Source # foldl :: (b -> a -> b) -> b -> Level i a -> b Source # foldl' :: (b -> a -> b) -> b -> Level i a -> b Source # foldr1 :: (a -> a -> a) -> Level i a -> a Source # foldl1 :: (a -> a -> a) -> Level i a -> a Source # toList :: Level i a -> [a] Source # null :: Level i a -> Bool Source # length :: Level i a -> Int Source # elem :: Eq a => a -> Level i a -> Bool Source # maximum :: Ord a => Level i a -> a Source # minimum :: Ord a => Level i a -> a Source # |
|
Traversable ( Level i) Source # | |
Defined in Control.Lens.Internal.Level |
|
( Eq i, Eq a) => Eq ( Level i a) Source # | |
( Ord i, Ord a) => Ord ( Level i a) Source # | |
Defined in Control.Lens.Internal.Level |
|
( Read i, Read a) => Read ( Level i a) Source # | |
( Show i, Show a) => Show ( Level i a) Source # | |
newtype Indexed i a b Source #
A function with access to a index. This constructor may be useful when you need to store
an
Indexable
in a container to avoid
ImpredicativeTypes
.
index :: Indexed i a b -> i -> a -> b
Indexed | |
|
Instances
class Conjoined p => Indexable i p where Source #
This class permits overloading of function application for things that also admit a notion of a key or index.
class ( Choice p, Corepresentable p, Comonad ( Corep p), Traversable ( Corep p), Strong p, Representable p, Monad ( Rep p), MonadFix ( Rep p), Distributive ( Rep p), Costrong p, ArrowLoop p, ArrowApply p, ArrowChoice p, Closed p) => Conjoined p where Source #
This is a
Profunctor
that is both
Corepresentable
by
f
and
Representable
by
g
such
that
f
is left adjoint to
g
. From this you can derive a lot of structure due
to the preservation of limits and colimits.
Nothing
distrib :: Functor f => p a b -> p (f a) (f b) Source #
Conjoined
is strong enough to let us distribute every
Conjoined
Profunctor
over every Haskell
Functor
. This is effectively a
generalization of
fmap
.
conjoined :: (p ~ (->) => q (a -> b) r) -> q (p a b) r -> q (p a b) r Source #
This permits us to make a decision at an outermost point about whether or not we use an index.
Ideally any use of this function should be done in such a way so that you compute the same answer, but this cannot be enforced at the type level.
Instances
Conjoined ReifiedGetter Source # | |
Defined in Control.Lens.Reified distrib :: Functor f => ReifiedGetter a b -> ReifiedGetter (f a) (f b) Source # conjoined :: ( ReifiedGetter ~ (->) => q (a -> b) r) -> q ( ReifiedGetter a b) r -> q ( ReifiedGetter a b) r Source # |
|
Conjoined ( Indexed i) Source # | |
Conjoined ((->) :: Type -> Type -> Type ) Source # | |
indexing :: Indexable Int p => ((a -> Indexing f b) -> s -> Indexing f t) -> p a (f b) -> s -> f t Source #
Transform a
Traversal
into an
IndexedTraversal
or
a
Fold
into an
IndexedFold
, etc.
indexing
::Traversal
s t a b ->IndexedTraversal
Int
s t a bindexing
::Prism
s t a b ->IndexedTraversal
Int
s t a bindexing
::Lens
s t a b ->IndexedLens
Int
s t a bindexing
::Iso
s t a b ->IndexedLens
Int
s t a bindexing
::Fold
s a ->IndexedFold
Int
s aindexing
::Getter
s a ->IndexedGetter
Int
s a
indexing
::Indexable
Int
p =>LensLike
(Indexing
f) s t a b ->Over
p f s t a b
indexing64 :: Indexable Int64 p => ((a -> Indexing64 f b) -> s -> Indexing64 f t) -> p a (f b) -> s -> f t Source #
Transform a
Traversal
into an
IndexedTraversal
or
a
Fold
into an
IndexedFold
, etc.
This combinator is like
indexing
except that it handles large traversals and folds gracefully.
indexing64
::Traversal
s t a b ->IndexedTraversal
Int64
s t a bindexing64
::Prism
s t a b ->IndexedTraversal
Int64
s t a bindexing64
::Lens
s t a b ->IndexedLens
Int64
s t a bindexing64
::Iso
s t a b ->IndexedLens
Int64
s t a bindexing64
::Fold
s a ->IndexedFold
Int64
s aindexing64
::Getter
s a ->IndexedGetter
Int64
s a
indexing64
::Indexable
Int64
p =>LensLike
(Indexing64
f) s t a b ->Over
p f s t a b
withIndex :: ( Indexable i p, Functor f) => p (i, s) (f (j, t)) -> Indexed i s (f t) Source #
Fold a container with indices returning both the indices and the values.
The result is only valid to compose in a
Traversal
, if you don't edit the
index as edits to the index have no effect.
>>>
[10, 20, 30] ^.. ifolded . withIndex
[(0,10),(1,20),(2,30)]
>>>
[10, 20, 30] ^.. ifolded . withIndex . alongside negated (re _Show)
[(0,"10"),(-1,"20"),(-2,"30")]
asIndex :: ( Indexable i p, Contravariant f, Functor f) => p i (f i) -> Indexed i s (f s) Source #
When composed with an
IndexedFold
or
IndexedTraversal
this yields an
(
Indexed
)
Fold
of the indices.
Used internally by
mapM_
and the like.
The argument
a
of the result should not be used!
See 4.16 Changelog entry for the explanation of "why not Apply f =>"?
Used internally by
traverseOf_
and the like.
The argument
a
of the result should not be used!
Instances
Applicative f => Semigroup ( Traversed a f) Source # | |
Applicative f => Monoid ( Traversed a f) Source # | |
The indexed store can be used to characterize a
Lens
and is used by
cloneLens
.
is isomorphic to
Context
a b t
newtype
,
and to
Context
a b t =
Context
{ runContext :: forall f.
Functor
f => (a -> f b) -> f t }
exists s. (s,
.
Lens
s t a b)
A
Context
is like a
Lens
that has already been applied to a some structure.
Context (b -> t) a |
Instances
newtype Bazaar1 p a b t Source #
This is used to characterize a
Traversal
.
a.k.a. indexed Cartesian store comonad, indexed Kleene store comonad, or an indexed
FunList
.
http://twanvl.nl/blog/haskell/non-regular1
A
Bazaar1
is like a
Traversal
that has already been applied to some structure.
Where a
holds an
Context
a b t
a
and a function from
b
to
t
, a
holds
Bazaar1
a b t
N
a
s and a function from
N
b
s to
t
, (where
N
might be infinite).
Mnemonically, a
Bazaar1
holds many stores and you can easily add more.
This is a final encoding of
Bazaar1
.
Bazaar1 | |
|
Instances
Corepresentable p => Sellable p ( Bazaar1 p) Source # | |
Defined in Control.Lens.Internal.Bazaar |
|
Profunctor p => Bizarre1 p ( Bazaar1 p) Source # | |
Conjoined p => IndexedComonad ( Bazaar1 p) Source # | |
IndexedFunctor ( Bazaar1 p) Source # | |
Functor ( Bazaar1 p a b) Source # | |
(a ~ b, Conjoined p) => Comonad ( Bazaar1 p a b) Source # | |
(a ~ b, Conjoined p) => ComonadApply ( Bazaar1 p a b) Source # | |
Apply ( Bazaar1 p a b) Source # | |
Defined in Control.Lens.Internal.Bazaar (<.>) :: Bazaar1 p a b (a0 -> b0) -> Bazaar1 p a b a0 -> Bazaar1 p a b b0 Source # (.>) :: Bazaar1 p a b a0 -> Bazaar1 p a b b0 -> Bazaar1 p a b b0 Source # (<.) :: Bazaar1 p a b a0 -> Bazaar1 p a b b0 -> Bazaar1 p a b a0 Source # liftF2 :: (a0 -> b0 -> c) -> Bazaar1 p a b a0 -> Bazaar1 p a b b0 -> Bazaar1 p a b c Source # |
newtype Bazaar p a b t Source #
This is used to characterize a
Traversal
.
a.k.a. indexed Cartesian store comonad, indexed Kleene store comonad, or an indexed
FunList
.
http://twanvl.nl/blog/haskell/non-regular1
A
Bazaar
is like a
Traversal
that has already been applied to some structure.
Where a
holds an
Context
a b t
a
and a function from
b
to
t
, a
holds
Bazaar
a b t
N
a
s and a function from
N
b
s to
t
, (where
N
might be infinite).
Mnemonically, a
Bazaar
holds many stores and you can easily add more.
This is a final encoding of
Bazaar
.
Bazaar | |
|
Instances
Corepresentable p => Sellable p ( Bazaar p) Source # | |
Defined in Control.Lens.Internal.Bazaar |
|
Profunctor p => Bizarre p ( Bazaar p) Source # | |
Defined in Control.Lens.Internal.Bazaar bazaar :: Applicative f => p a (f b) -> Bazaar p a b t -> f t Source # |
|
Conjoined p => IndexedComonad ( Bazaar p) Source # | |
IndexedFunctor ( Bazaar p) Source # | |
Functor ( Bazaar p a b) Source # | |
Applicative ( Bazaar p a b) Source # | |
Defined in Control.Lens.Internal.Bazaar pure :: a0 -> Bazaar p a b a0 Source # (<*>) :: Bazaar p a b (a0 -> b0) -> Bazaar p a b a0 -> Bazaar p a b b0 Source # liftA2 :: (a0 -> b0 -> c) -> Bazaar p a b a0 -> Bazaar p a b b0 -> Bazaar p a b c Source # (*>) :: Bazaar p a b a0 -> Bazaar p a b b0 -> Bazaar p a b b0 Source # (<*) :: Bazaar p a b a0 -> Bazaar p a b b0 -> Bazaar p a b a0 Source # |
|
(a ~ b, Conjoined p) => Comonad ( Bazaar p a b) Source # | |
(a ~ b, Conjoined p) => ComonadApply ( Bazaar p a b) Source # | |
Apply ( Bazaar p a b) Source # | |
Defined in Control.Lens.Internal.Bazaar (<.>) :: Bazaar p a b (a0 -> b0) -> Bazaar p a b a0 -> Bazaar p a b b0 Source # (.>) :: Bazaar p a b a0 -> Bazaar p a b b0 -> Bazaar p a b b0 Source # (<.) :: Bazaar p a b a0 -> Bazaar p a b b0 -> Bazaar p a b a0 Source # liftF2 :: (a0 -> b0 -> c) -> Bazaar p a b a0 -> Bazaar p a b b0 -> Bazaar p a b c Source # |
This provides a way to peek at the internal structure of a
Traversal
or
IndexedTraversal
Instances
FunctorWithIndex i ( Magma i t b) Source # | |
FoldableWithIndex i ( Magma i t b) Source # | |
Defined in Control.Lens.Internal.Magma ifoldMap :: Monoid m => (i -> a -> m) -> Magma i t b a -> m Source # ifoldMap' :: Monoid m => (i -> a -> m) -> Magma i t b a -> m Source # ifoldr :: (i -> a -> b0 -> b0) -> b0 -> Magma i t b a -> b0 Source # ifoldl :: (i -> b0 -> a -> b0) -> b0 -> Magma i t b a -> b0 Source # ifoldr' :: (i -> a -> b0 -> b0) -> b0 -> Magma i t b a -> b0 Source # ifoldl' :: (i -> b0 -> a -> b0) -> b0 -> Magma i t b a -> b0 Source # |
|
TraversableWithIndex i ( Magma i t b) Source # | |
Defined in Control.Lens.Internal.Magma |
|
Functor ( Magma i t b) Source # | |
Foldable ( Magma i t b) Source # | |
Defined in Control.Lens.Internal.Magma fold :: Monoid m => Magma i t b m -> m Source # foldMap :: Monoid m => (a -> m) -> Magma i t b a -> m Source # foldMap' :: Monoid m => (a -> m) -> Magma i t b a -> m Source # foldr :: (a -> b0 -> b0) -> b0 -> Magma i t b a -> b0 Source # foldr' :: (a -> b0 -> b0) -> b0 -> Magma i t b a -> b0 Source # foldl :: (b0 -> a -> b0) -> b0 -> Magma i t b a -> b0 Source # foldl' :: (b0 -> a -> b0) -> b0 -> Magma i t b a -> b0 Source # foldr1 :: (a -> a -> a) -> Magma i t b a -> a Source # foldl1 :: (a -> a -> a) -> Magma i t b a -> a Source # toList :: Magma i t b a -> [a] Source # null :: Magma i t b a -> Bool Source # length :: Magma i t b a -> Int Source # elem :: Eq a => a -> Magma i t b a -> Bool Source # maximum :: Ord a => Magma i t b a -> a Source # minimum :: Ord a => Magma i t b a -> a Source # |
|
Traversable ( Magma i t b) Source # | |
Defined in Control.Lens.Internal.Magma traverse :: Applicative f => (a -> f b0) -> Magma i t b a -> f ( Magma i t b b0) Source # sequenceA :: Applicative f => Magma i t b (f a) -> f ( Magma i t b a) Source # mapM :: Monad m => (a -> m b0) -> Magma i t b a -> m ( Magma i t b b0) Source # sequence :: Monad m => Magma i t b (m a) -> m ( Magma i t b a) Source # |
|
( Show i, Show a) => Show ( Magma i t b a) Source # | |
class ( Profunctor p, Bifunctor p) => Reviewable p Source #
This class is provided mostly for backwards compatibility with lens 3.8, but it can also shorten type signatures.
Instances
( Profunctor p, Bifunctor p) => Reviewable p Source # | |
Defined in Control.Lens.Internal.Review |
retagged :: ( Profunctor p, Bifunctor p) => p a b -> p s b Source #
This is a profunctor used internally to implement Review
It plays a role similar to that of
Accessor
or
Const
do for
Control.Lens.Getter
class ( Applicative f, Distributive f, Traversable f) => Settable f Source #
Instances
Settable Identity Source # |
So you can pass our
|
Defined in Control.Lens.Internal.Setter untainted :: Identity a -> a Source # untaintedDot :: Profunctor p => p a ( Identity b) -> p a b Source # taintedDot :: Profunctor p => p a b -> p a ( Identity b) Source # |
|
Settable f => Settable ( Backwards f) Source # | |
Defined in Control.Lens.Internal.Setter untainted :: Backwards f a -> a Source # untaintedDot :: Profunctor p => p a ( Backwards f b) -> p a b Source # taintedDot :: Profunctor p => p a b -> p a ( Backwards f b) Source # |
|
( Settable f, Settable g) => Settable ( Compose f g) Source # | |
Defined in Control.Lens.Internal.Setter untainted :: Compose f g a -> a Source # untaintedDot :: Profunctor p => p a ( Compose f g b) -> p a b Source # taintedDot :: Profunctor p => p a b -> p a ( Compose f g b) Source # |
type Over p f s t a b = p a (f b) -> s -> f t Source #
This is a convenient alias for use when you need to consume either indexed or non-indexed lens-likes based on context.
type IndexedLensLike' i f s a = IndexedLensLike i f s s a a Source #
Convenient alias for constructing simple indexed lenses and their ilk.
type IndexedLensLike i f s t a b = forall p. Indexable i p => p a (f b) -> s -> f t Source #
Convenient alias for constructing indexed lenses and their ilk.
type LensLike f s t a b = (a -> f b) -> s -> f t Source #
Many combinators that accept a
Lens
can also accept a
Traversal
in limited situations.
They do so by specializing the type of
Functor
that they require of the
caller.
If a function accepts a
for some
LensLike
f s t a b
Functor
f
,
then they may be passed a
Lens
.
Further, if
f
is an
Applicative
, they may also be passed a
Traversal
.
type Optic p f s t a b = p a (f b) -> p s (f t) Source #
A valid
Optic
l
should satisfy the laws:
lpure
≡pure
l (Procompose
f g) =Procompose
(l f) (l g)
This gives rise to the laws for
Equality
,
Iso
,
Prism
,
Lens
,
Traversal
,
Traversal1
,
Setter
,
Fold
,
Fold1
, and
Getter
as well
along with their index-preserving variants.
typeLensLike
f s t a b =Optic
(->) f s t a b
type Simple f s a = f s s a a Source #
A
Simple
Lens
,
Simple
Traversal
, ... can
be used instead of a
Lens
,
Traversal
, ...
whenever the type variables don't change upon setting a value.
_imagPart
::Simple
Lens
(Complex
a) atraversed
::Simple
(IndexedTraversal
Int
) [a] a
Note: To use this alias in your own code with
or
LensLike
f
Setter
, you may have to turn on
LiberalTypeSynonyms
.
This is commonly abbreviated as a "prime" marker,
e.g.
Lens'
=
Simple
Lens
.
type IndexPreservingFold1 s a = forall p f. ( Conjoined p, Contravariant f, Apply f) => p a (f a) -> p s (f s) Source #
type IndexedFold1 i s a = forall p f. ( Indexable i p, Contravariant f, Apply f) => p a (f a) -> s -> f s Source #
type Fold1 s a = forall f. ( Contravariant f, Apply f) => (a -> f a) -> s -> f s Source #
A relevant Fold (aka
Fold1
) has one or more targets.
type IndexPreservingFold s a = forall p f. ( Conjoined p, Contravariant f, Applicative f) => p a (f a) -> p s (f s) Source #
An
IndexPreservingFold
can be used as a
Fold
, but when composed with an
IndexedTraversal
,
IndexedFold
, or
IndexedLens
yields an
IndexedFold
respectively.
type IndexedFold i s a = forall p f. ( Indexable i p, Contravariant f, Applicative f) => p a (f a) -> s -> f s Source #
Every
IndexedFold
is a valid
Fold
and can be used for
Getting
.
type Fold s a = forall f. ( Contravariant f, Applicative f) => (a -> f a) -> s -> f s Source #
A
Fold
describes how to retrieve multiple values in a way that can be composed
with other
LensLike
constructions.
A
provides a structure with operations very similar to those of the
Fold
s a
Foldable
typeclass, see
foldMapOf
and the other
Fold
combinators.
By convention, if there exists a
foo
method that expects a
, then there should be a
Foldable
(f a)
fooOf
method that takes a
and a value of type
Fold
s a
s
.
A
Getter
is a legal
Fold
that just ignores the supplied
Monoid
.
Unlike a
Traversal
a
Fold
is read-only. Since a
Fold
cannot be used to write back
there are no
Lens
laws that apply.
type IndexPreservingGetter s a = forall p f. ( Conjoined p, Contravariant f, Functor f) => p a (f a) -> p s (f s) Source #
An
IndexPreservingGetter
can be used as a
Getter
, but when composed with an
IndexedTraversal
,
IndexedFold
, or
IndexedLens
yields an
IndexedFold
,
IndexedFold
or
IndexedGetter
respectively.
type IndexedGetter i s a = forall p f. ( Indexable i p, Contravariant f, Functor f) => p a (f a) -> s -> f s Source #
Every
IndexedGetter
is a valid
IndexedFold
and can be used for
Getting
like a
Getter
.
type Getter s a = forall f. ( Contravariant f, Functor f) => (a -> f a) -> s -> f s Source #
A
Getter
describes how to retrieve a single value in a way that can be
composed with other
LensLike
constructions.
Unlike a
Lens
a
Getter
is read-only. Since a
Getter
cannot be used to write back there are no
Lens
laws that can be applied to
it. In fact, it is isomorphic to an arbitrary function from
(s -> a)
.
Moreover, a
Getter
can be used directly as a
Fold
,
since it just ignores the
Applicative
.
type As a = Equality' a a Source #
Composable
asTypeOf
. Useful for constraining excess
polymorphism,
foo . (id :: As Int) . bar
.
type Equality (s :: k1) (t :: k2) (a :: k1) (b :: k2) = forall k3 (p :: k1 -> k3 -> Type ) (f :: k2 -> k3). p a (f b) -> p s (f t) Source #
A witness that
(a ~ s, b ~ t)
.
Note: Composition with an
Equality
is index-preserving.
type Prism s t a b = forall p f. ( Choice p, Applicative f) => p a (f b) -> p s (f t) Source #
A
Prism
l
is a
Traversal
that can also be turned
around with
re
to obtain a
Getter
in the
opposite direction.
There are three laws that a
Prism
should satisfy:
First, if I
re
or
review
a value with a
Prism
and then
preview
or use (
^?
), I will get it back:
preview
l (review
l b) ≡Just
b
Second, if you can extract a value
a
using a
Prism
l
from a value
s
, then the value
s
is completely described by
l
and
a
:
preview
l s ≡Just
a ⟹review
l a ≡ s
Third, if you get non-match
t
, you can convert it result back to
s
:
matching
l s ≡Left
t ⟹matching
l t ≡Left
s
The first two laws imply that the
Traversal
laws hold for every
Prism
and that we
traverse
at most 1 element:
lengthOf
l x<=
1
It may help to think of this as an
Iso
that can be partial in one direction.
Every
Prism
is a valid
Traversal
.
For example, you might have a
allows you to always
go from a
Prism'
Integer
Natural
Natural
to an
Integer
, and provide you with tools to check if an
Integer
is
a
Natural
and/or to edit one if it is.
nat
::Prism'
Integer
Natural
nat
=prism
toInteger
$
\ i -> if i<
0 thenLeft
i elseRight
(fromInteger
i)
Now we can ask if an
Integer
is a
Natural
.
>>>
5^?nat
Just 5
>>>
(-5)^?nat
Nothing
We can update the ones that are:
>>>
(-3,4) & both.nat *~ 2
(-3,8)
And we can then convert from a
Natural
to an
Integer
.
>>>
5 ^. re nat -- :: Natural
5
Similarly we can use a
Prism
to
traverse
the
Left
half of an
Either
:
>>>
Left "hello" & _Left %~ length
Left 5
or to construct an
Either
:
>>>
5^.re _Left
Left 5
such that if you query it with the
Prism
, you will get your original input back.
>>>
5^.re _Left ^? _Left
Just 5
Another interesting way to think of a
Prism
is as the categorical dual of a
Lens
-- a co-
Lens
, so to speak. This is what permits the construction of
outside
.
Note: Composition with a
Prism
is index-preserving.
type Iso s t a b = forall p f. ( Profunctor p, Functor f) => p a (f b) -> p s (f t) Source #
type IndexPreservingSetter' s a = IndexPreservingSetter s s a a Source #
typeIndexedPreservingSetter'
i =Simple
IndexedPreservingSetter
type IndexPreservingSetter s t a b = forall p f. ( Conjoined p, Settable f) => p a (f b) -> p s (f t) Source #
An
IndexPreservingSetter
can be composed with a
IndexedSetter
,
IndexedTraversal
or
IndexedLens
and leaves the index intact, yielding an
IndexedSetter
.
type IndexedSetter' i s a = IndexedSetter i s s a a Source #
typeIndexedSetter'
i =Simple
(IndexedSetter
i)
type IndexedSetter i s t a b = forall f p. ( Indexable i p, Settable f) => p a (f b) -> s -> f t Source #
Every
IndexedSetter
is a valid
Setter
.
The
Setter
laws are still required to hold.
type Setter s t a b = forall f. Settable f => (a -> f b) -> s -> f t Source #
The only
LensLike
law that can apply to a
Setter
l
is that
set
l y (set
l x a) ≡set
l y a
You can't
view
a
Setter
in general, so the other two laws are irrelevant.
However, two
Functor
laws apply to a
Setter
:
over
lid
≡id
over
l f.
over
l g ≡over
l (f.
g)
These can be stated more directly:
lpure
≡pure
l f.
untainted
.
l g ≡ l (f.
untainted
.
g)
You can compose a
Setter
with a
Lens
or a
Traversal
using (
.
) from the
Prelude
and the result is always only a
Setter
and nothing more.
>>>
over traverse f [a,b,c,d]
[f a,f b,f c,f d]
>>>
over _1 f (a,b)
(f a,b)
>>>
over (traverse._1) f [(a,b),(c,d)]
[(f a,b),(f c,d)]
>>>
over both f (a,b)
(f a,f b)
>>>
over (traverse.both) f [(a,b),(c,d)]
[(f a,f b),(f c,f d)]
type IndexPreservingTraversal1' s a = IndexPreservingTraversal1 s s a a Source #
type IndexPreservingTraversal1 s t a b = forall p f. ( Conjoined p, Apply f) => p a (f b) -> p s (f t) Source #
type IndexPreservingTraversal' s a = IndexPreservingTraversal s s a a Source #
type IndexPreservingTraversal s t a b = forall p f. ( Conjoined p, Applicative f) => p a (f b) -> p s (f t) Source #
An
IndexPreservingLens
leaves any index it is composed with alone.
type IndexedTraversal1' i s a = IndexedTraversal1 i s s a a Source #
type IndexedTraversal1 i s t a b = forall p f. ( Indexable i p, Apply f) => p a (f b) -> s -> f t Source #
type IndexedTraversal' i s a = IndexedTraversal i s s a a Source #
typeIndexedTraversal'
i =Simple
(IndexedTraversal
i)
type IndexedTraversal i s t a b = forall p f. ( Indexable i p, Applicative f) => p a (f b) -> s -> f t Source #
Every
IndexedTraversal
is a valid
Traversal
or
IndexedFold
.
The
Indexed
constraint is used to allow an
IndexedTraversal
to be used
directly as a
Traversal
.
The
Traversal
laws are still required to hold.
In addition, the index
i
should satisfy the requirement that it stays
unchanged even when modifying the value
a
, otherwise traversals like
indices
break the
Traversal
laws.
type Traversal1' s a = Traversal1 s s a a Source #
type Traversal1 s t a b = forall f. Apply f => (a -> f b) -> s -> f t Source #
type Traversal' s a = Traversal s s a a Source #
typeTraversal'
=Simple
Traversal
type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t Source #
A
Traversal
can be used directly as a
Setter
or a
Fold
(but not as a
Lens
) and provides
the ability to both read and update multiple fields, subject to some relatively weak
Traversal
laws.
These have also been known as multilenses, but they have the signature and spirit of
traverse
::Traversable
f =>Traversal
(f a) (f b) a b
and the more evocative name suggests their application.
Most of the time the
Traversal
you will want to use is just
traverse
, but you can also pass any
Lens
or
Iso
as a
Traversal
, and composition of a
Traversal
(or
Lens
or
Iso
) with a
Traversal
(or
Lens
or
Iso
)
using (
.
) forms a valid
Traversal
.
The laws for a
Traversal
t
follow from the laws for
Traversable
as stated in "The Essence of the Iterator Pattern".
tpure
≡pure
fmap
(t f).
t g ≡getCompose
.
t (Compose
.
fmap
f.
g)
One consequence of this requirement is that a
Traversal
needs to leave the same number of elements as a
candidate for subsequent
Traversal
that it started with. Another testament to the strength of these laws
is that the caveat expressed in section 5.5 of the "Essence of the Iterator Pattern" about exotic
Traversable
instances that
traverse
the same entry multiple times was actually already ruled out by the
second law in that same paper!
type IndexPreservingLens' s a = IndexPreservingLens s s a a Source #
type IndexPreservingLens s t a b = forall p f. ( Conjoined p, Functor f) => p a (f b) -> p s (f t) Source #
An
IndexPreservingLens
leaves any index it is composed with alone.
type IndexedLens' i s a = IndexedLens i s s a a Source #
typeIndexedLens'
i =Simple
(IndexedLens
i)
type IndexedLens i s t a b = forall f p. ( Indexable i p, Functor f) => p a (f b) -> s -> f t Source #
Every
IndexedLens
is a valid
Lens
and a valid
IndexedTraversal
.
type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t Source #
A
Lens
is actually a lens family as described in
http://comonad.com/reader/2012/mirrored-lenses/
.
With great power comes great responsibility and a
Lens
is subject to the
three common sense
Lens
laws:
1) You get back what you put in:
view
l (set
l v s) ≡ v
2) Putting back what you got doesn't change anything:
set
l (view
l s) s ≡ s
3) Setting twice is the same as setting once:
set
l v' (set
l v s) ≡set
l v' s
These laws are strong enough that the 4 type parameters of a
Lens
cannot
vary fully independently. For more on how they interact, read the "Why is
it a Lens Family?" section of
http://comonad.com/reader/2012/mirrored-lenses/
.
There are some emergent properties of these laws:
1)
must be injective for every
set
l s
s
This is a consequence of law #1
2)
must be surjective, because of law #2, which indicates that it is possible to obtain any
set
l
v
from some
s
such that
set
s v = s
3) Given just the first two laws you can prove a weaker form of law #3 where the values
v
that you are setting match:
set
l v (set
l v s) ≡set
l v s
Every
Lens
can be used directly as a
Setter
or
Traversal
.
You can also use a
Lens
for
Getting
as if it were a
Fold
or
Getter
.
Since every
Lens
is a valid
Traversal
, the
Traversal
laws are required of any
Lens
you create:
lpure
≡pure
fmap
(l f).
l g ≡getCompose
.
l (Compose
.
fmap
f.
g)
typeLens
s t a b = forall f.Functor
f =>LensLike
f s t a b
type Setting' p s a = Setting p s s a a Source #
This is a convenient alias when defining highly polymorphic code that takes both
ASetter'
and
AnIndexedSetter'
as appropriate. If a function takes this it is
expecting one of those two things based on context.
type Setting p s t a b = p a ( Identity b) -> s -> Identity t Source #
This is a convenient alias when defining highly polymorphic code that takes both
ASetter
and
AnIndexedSetter
as appropriate. If a function takes this it is
expecting one of those two things based on context.
type AnIndexedSetter' i s a = AnIndexedSetter i s s a a Source #
typeAnIndexedSetter'
i =Simple
(AnIndexedSetter
i)
type AnIndexedSetter i s t a b = Indexed i a ( Identity b) -> s -> Identity t Source #
Running an
IndexedSetter
instantiates it to a concrete type.
When consuming a setter directly to perform a mapping, you can use this type, but most user code will not need to use this type.
type ASetter s t a b = (a -> Identity b) -> s -> Identity t Source #
Running a
Setter
instantiates it to a concrete type.
When consuming a setter directly to perform a mapping, you can use this type, but most user code will not need to use this type.
mapped :: Functor f => Setter (f a) (f b) a b Source #
This
Setter
can be used to map over all of the values in a
Functor
.
fmap
≡over
mapped
fmapDefault
≡over
traverse
(<$
) ≡set
mapped
>>>
over mapped f [a,b,c]
[f a,f b,f c]
>>>
over mapped (+1) [1,2,3]
[2,3,4]
>>>
set mapped x [a,b,c]
[x,x,x]
>>>
[[a,b],[c]] & mapped.mapped +~ x
[[a + x,b + x],[c + x]]
>>>
over (mapped._2) length [("hello","world"),("leaders","!!!")]
[("hello",5),("leaders",3)]
mapped
::Functor
f =>Setter
(f a) (f b) a b
If you want an
IndexPreservingSetter
use
.
setting
fmap
lifted :: Monad m => Setter (m a) (m b) a b Source #
This
setter
can be used to modify all of the values in a
Monad
.
You sometimes have to use this rather than
mapped
-- due to
temporary insanity
Functor
was not a superclass of
Monad
until
GHC 7.10.
liftM
≡over
lifted
>>>
over lifted f [a,b,c]
[f a,f b,f c]
>>>
set lifted b (Just a)
Just b
If you want an
IndexPreservingSetter
use
.
setting
liftM
contramapped :: Contravariant f => Setter (f b) (f a) a b Source #
This
Setter
can be used to map over all of the inputs to a
Contravariant
.
contramap
≡over
contramapped
>>>
getPredicate (over contramapped (*2) (Predicate even)) 5
True
>>>
getOp (over contramapped (*5) (Op show)) 100
"500"
>>>
Prelude.map ($ 1) $ over (mapped . _Unwrapping' Op . contramapped) (*12) [(*2),(+1),(^3)]
[24,13,1728]
argument :: Profunctor p => Setter (p b r) (p a r) a b Source #
This
Setter
can be used to map over the input of a
Profunctor
.
The most common
Profunctor
to use this with is
(->)
.
>>>
(argument %~ f) g x
g (f x)
>>>
(argument %~ show) length [1,2,3]
7
>>>
(argument %~ f) h x y
h (f x) y
Map over the argument of the result of a function -- i.e., its second argument:
>>>
(mapped.argument %~ f) h x y
h x (f y)
argument
::Setter
(b -> r) (a -> r) a b
setting :: ((a -> b) -> s -> t) -> IndexPreservingSetter s t a b Source #
Build an index-preserving
Setter
from a map-like function.
Your supplied function
f
is required to satisfy:
fid
≡id
f g.
f h ≡ f (g.
h)
Equational reasoning:
setting
.
over
≡id
over
.
setting
≡id
Another way to view
sets
is that it takes a "semantic editor combinator"
and transforms it into a
Setter
.
setting
:: ((a -> b) -> s -> t) ->Setter
s t a b
sets :: ( Profunctor p, Profunctor q, Settable f) => (p a b -> q s t) -> Optical p q f s t a b Source #
Build a
Setter
,
IndexedSetter
or
IndexPreservingSetter
depending on your choice of
Profunctor
.
sets
:: ((a -> b) -> s -> t) ->Setter
s t a b
cloneIndexPreservingSetter :: ASetter s t a b -> IndexPreservingSetter s t a b Source #
Build an
IndexPreservingSetter
from any
Setter
.
cloneIndexedSetter :: AnIndexedSetter i s t a b -> IndexedSetter i s t a b Source #
Clone an
IndexedSetter
.
over :: ASetter s t a b -> (a -> b) -> s -> t Source #
Modify the target of a
Lens
or all the targets of a
Setter
or
Traversal
with a function.
fmap
≡over
mapped
fmapDefault
≡over
traverse
sets
.
over
≡id
over
.
sets
≡id
Given any valid
Setter
l
, you can also rely on the law:
over
l f.
over
l g =over
l (f.
g)
e.g.
>>>
over mapped f (over mapped g [a,b,c]) == over mapped (f . g) [a,b,c]
True
Another way to view
over
is to say that it transforms a
Setter
into a
"semantic editor combinator".
>>>
over mapped f (Just a)
Just (f a)
>>>
over mapped (*10) [1,2,3]
[10,20,30]
>>>
over _1 f (a,b)
(f a,b)
>>>
over _1 show (10,20)
("10",20)
over
::Setter
s t a b -> (a -> b) -> s -> tover
::ASetter
s t a b -> (a -> b) -> s -> t
set :: ASetter s t a b -> b -> s -> t Source #
Replace the target of a
Lens
or all of the targets of a
Setter
or
Traversal
with a constant value.
(<$
) ≡set
mapped
>>>
set _2 "hello" (1,())
(1,"hello")
>>>
set mapped () [1,2,3,4]
[(),(),(),()]
Note: Attempting to
set
a
Fold
or
Getter
will fail at compile time with an
relatively nice error message.
set
::Setter
s t a b -> b -> s -> tset
::Iso
s t a b -> b -> s -> tset
::Lens
s t a b -> b -> s -> tset
::Traversal
s t a b -> b -> s -> t
set' :: ASetter' s a -> a -> s -> s Source #
Replace the target of a
Lens
or all of the targets of a
Setter'
or
Traversal
with a constant value, without changing its type.
This is a type restricted version of
set
, which retains the type of the original.
>>>
set' mapped x [a,b,c,d]
[x,x,x,x]
>>>
set' _2 "hello" (1,"world")
(1,"hello")
>>>
set' mapped 0 [1,2,3,4]
[0,0,0,0]
Note: Attempting to adjust
set'
a
Fold
or
Getter
will fail at compile time with an
relatively nice error message.
set'
::Setter'
s a -> a -> s -> sset'
::Iso'
s a -> a -> s -> sset'
::Lens'
s a -> a -> s -> sset'
::Traversal'
s a -> a -> s -> s
assign :: MonadState s m => ASetter s s a b -> b -> m () Source #
Replace the target of a
Lens
or all of the targets of a
Setter
or
Traversal
in our monadic
state with a new value, irrespective of the old.
This is an alias for (
.=
).
>>>
execState (do assign _1 c; assign _2 d) (a,b)
(c,d)
>>>
execState (both .= c) (a,b)
(c,c)
assign
::MonadState
s m =>Iso'
s a -> a -> m ()assign
::MonadState
s m =>Lens'
s a -> a -> m ()assign
::MonadState
s m =>Traversal'
s a -> a -> m ()assign
::MonadState
s m =>Setter'
s a -> a -> m ()
modifying :: MonadState s m => ASetter s s a b -> (a -> b) -> m () Source #
This is an alias for (
%=
).
scribe :: ( MonadWriter t m, Monoid s) => ASetter s t a b -> b -> m () Source #
Write to a fragment of a larger
Writer
format.
passing :: MonadWriter w m => Setter w w u v -> m (a, u -> v) -> m a Source #
This is a generalization of
pass
that allows you to modify just a
portion of the resulting
MonadWriter
.
ipassing :: MonadWriter w m => IndexedSetter i w w u v -> m (a, i -> u -> v) -> m a Source #
This is a generalization of
pass
that allows you to modify just a
portion of the resulting
MonadWriter
with access to the index of an
IndexedSetter
.
censoring :: MonadWriter w m => Setter w w u v -> (u -> v) -> m a -> m a Source #
This is a generalization of
censor
that allows you to
censor
just a
portion of the resulting
MonadWriter
.
icensoring :: MonadWriter w m => IndexedSetter i w w u v -> (i -> u -> v) -> m a -> m a Source #
This is a generalization of
censor
that allows you to
censor
just a
portion of the resulting
MonadWriter
, with access to the index of an
IndexedSetter
.
locally :: MonadReader s m => ASetter s s a b -> (a -> b) -> m r -> m r Source #
Modify the value of the
Reader
environment associated with the target of a
Setter
,
Lens
, or
Traversal
.
locally
lid
a ≡ alocally
l f.
locally l g ≡locally
l (f.
g)
>>>
(1,1) & locally _1 (+1) (uncurry (+))
3
>>>
"," & locally ($) ("Hello" <>) (<> " world!")
"Hello, world!"
locally :: MonadReader s m =>Iso
s s a b -> (a -> b) -> m r -> m r locally :: MonadReader s m =>Lens
s s a b -> (a -> b) -> m r -> m r locally :: MonadReader s m =>Traversal
s s a b -> (a -> b) -> m r -> m r locally :: MonadReader s m =>Setter
s s a b -> (a -> b) -> m r -> m r
ilocally :: MonadReader s m => AnIndexedSetter i s s a b -> (i -> a -> b) -> m r -> m r Source #
This is a generalization of
locally
that allows one to make indexed
local
changes to a
Reader
environment associated with the target of a
Setter
,
Lens
, or
Traversal
.
locally
l f ≡ilocally
l f . constilocally
l f ≡locally
l f .Indexed
ilocally :: MonadReader s m =>IndexedLens
s s a b -> (i -> a -> b) -> m r -> m r ilocally :: MonadReader s m =>IndexedTraversal
s s a b -> (i -> a -> b) -> m r -> m r ilocally :: MonadReader s m =>IndexedSetter
s s a b -> (i -> a -> b) -> m r -> m r
iover :: AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t Source #
Map with index. This is an alias for
imapOf
.
When you do not need access to the index, then
over
is more liberal in what it can accept.
over
l ≡iover
l.
const
iover
l ≡over
l.
Indexed
iover
::IndexedSetter
i s t a b -> (i -> a -> b) -> s -> tiover
::IndexedLens
i s t a b -> (i -> a -> b) -> s -> tiover
::IndexedTraversal
i s t a b -> (i -> a -> b) -> s -> t
iset :: AnIndexedSetter i s t a b -> (i -> b) -> s -> t Source #
Set with index. Equivalent to
iover
with the current value ignored.
When you do not need access to the index, then
set
is more liberal in what it can accept.
set
l ≡iset
l.
const
iset
::IndexedSetter
i s t a b -> (i -> b) -> s -> tiset
::IndexedLens
i s t a b -> (i -> b) -> s -> tiset
::IndexedTraversal
i s t a b -> (i -> b) -> s -> t
isets :: ((i -> a -> b) -> s -> t) -> IndexedSetter i s t a b Source #
Build an
IndexedSetter
from an
imap
-like function.
Your supplied function
f
is required to satisfy:
fid
≡id
f g.
f h ≡ f (g.
h)
Equational reasoning:
isets
.
iover
≡id
iover
.
isets
≡id
Another way to view
isets
is that it takes a "semantic editor combinator"
which has been modified to carry an index and transforms it into a
IndexedSetter
.
imodifying :: MonadState s m => AnIndexedSetter i s s a b -> (i -> a -> b) -> m () Source #
This is an alias for (
%@=
).
assignA :: Arrow p => ASetter s t a b -> p s b -> p s t Source #
Run an arrow command and use the output to set all the targets of
a
Lens
,
Setter
or
Traversal
to the result.
assignA
can be used very similarly to (
<~
), except that the type of
the object being modified can change; for example:
runKleisli action ((), (), ()) where action = assignA _1 (Kleisli (const getVal1)) >>> assignA _2 (Kleisli (const getVal2)) >>> assignA _3 (Kleisli (const getVal3)) getVal1 :: Either String Int getVal1 = ... getVal2 :: Either String Bool getVal2 = ... getVal3 :: Either String Char getVal3 = ...
has the type
Either
String
(
Int
,
Bool
,
Char
)
assignA
::Arrow
p =>Iso
s t a b -> p s b -> p s tassignA
::Arrow
p =>Lens
s t a b -> p s b -> p s tassignA
::Arrow
p =>Traversal
s t a b -> p s b -> p s tassignA
::Arrow
p =>Setter
s t a b -> p s b -> p s t
imapOf :: AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t Source #
Deprecated: Use
iover
Map with index. (Deprecated alias for
iover
).
When you do not need access to the index, then
mapOf
is more liberal in what it can accept.
mapOf
l ≡imapOf
l.
const
imapOf
::IndexedSetter
i s t a b -> (i -> a -> b) -> s -> timapOf
::IndexedLens
i s t a b -> (i -> a -> b) -> s -> timapOf
::IndexedTraversal
i s t a b -> (i -> a -> b) -> s -> t
type AnIndexedLens' i s a = AnIndexedLens i s s a a Source #
typeAnIndexedLens'
=Simple
(AnIndexedLens
i)
type AnIndexedLens i s t a b = Optical ( Indexed i) (->) ( Pretext ( Indexed i) a b) s t a b Source #
When you see this as an argument to a function, it expects an
IndexedLens
withLens :: forall s t a b rep (r :: TYPE rep). ALens s t a b -> ((s -> a) -> (s -> b -> t) -> r) -> r Source #
Obtain a getter and a setter from a lens, reversing
lens
.
iplens :: (s -> a) -> (s -> b -> t) -> IndexPreservingLens s t a b Source #
ilens :: (s -> (i, a)) -> (s -> b -> t) -> IndexedLens i s t a b Source #
Build an
IndexedLens
from a
Getter
and
a
Setter
.
choosing :: Functor f => LensLike f s t a b -> LensLike f s' t' a b -> LensLike f ( Either s s') ( Either t t') a b Source #
Merge two lenses, getters, setters, folds or traversals.
chosen
≡choosing
id
id
choosing
::Getter
s a ->Getter
s' a ->Getter
(Either
s s') achoosing
::Fold
s a ->Fold
s' a ->Fold
(Either
s s') achoosing
::Lens'
s a ->Lens'
s' a ->Lens'
(Either
s s') achoosing
::Traversal'
s a ->Traversal'
s' a ->Traversal'
(Either
s s') achoosing
::Setter'
s a ->Setter'
s' a ->Setter'
(Either
s s') a
chosen :: IndexPreservingLens ( Either a a) ( Either b b) a b Source #
This is a
Lens
that updates either side of an
Either
, where both sides have the same type.
chosen
≡choosing
id
id
>>>
Left a^.chosen
a
>>>
Right a^.chosen
a
>>>
Right "hello"^.chosen
"hello"
>>>
Right a & chosen *~ b
Right (a * b)
chosen
::Lens
(Either
a a) (Either
b b) a bchosen
f (Left
a) =Left
<$>
f achosen
f (Right
a) =Right
<$>
f a
alongside :: LensLike ( AlongsideLeft f b') s t a b -> LensLike ( AlongsideRight f t) s' t' a' b' -> LensLike f (s, s') (t, t') (a, a') (b, b') Source #
alongside
makes a
Lens
from two other lenses or a
Getter
from two other getters
by executing them on their respective halves of a product.
>>>
(Left a, Right b)^.alongside chosen chosen
(a,b)
>>>
(Left a, Right b) & alongside chosen chosen .~ (c,d)
(Left c,Right d)
alongside
::Lens
s t a b ->Lens
s' t' a' b' ->Lens
(s,s') (t,t') (a,a') (b,b')alongside
::Getter
s a ->Getter
s' a' ->Getter
(s,s') (a,a')
locus :: IndexedComonadStore p => Lens (p a c s) (p b c s) a b Source #
This
Lens
lets you
view
the current
pos
of any indexed
store comonad and
seek
to a new position. This reduces the API
for working these instances to a single
Lens
.
ipos
w ≡ w^.
locus
iseek
s w ≡ w&
locus
.~
siseeks
f w ≡ w&
locus
%~
f
locus
::Lens'
(Context'
a s) alocus
::Conjoined
p =>Lens'
(Pretext'
p a s) alocus
::Conjoined
p =>Lens'
(PretextT'
p g a s) a
cloneLens :: ALens s t a b -> Lens s t a b Source #
Cloning a
Lens
is one way to make sure you aren't given
something weaker, such as a
Traversal
and can be
used as a way to pass around lenses that have to be monomorphic in
f
.
Note: This only accepts a proper
Lens
.
>>>
let example l x = set (cloneLens l) (x^.cloneLens l + 1) x in example _2 ("hello",1,"you")
("hello",2,"you")
cloneIndexPreservingLens :: ALens s t a b -> IndexPreservingLens s t a b Source #
Clone a
Lens
as an
IndexedPreservingLens
that just passes through whatever
index is on any
IndexedLens
,
IndexedFold
,
IndexedGetter
or
IndexedTraversal
it is composed with.
cloneIndexedLens :: AnIndexedLens i s t a b -> IndexedLens i s t a b Source #
Clone an
IndexedLens
as an
IndexedLens
with the same index.
We can always retrieve a
()
from any type.
>>>
"hello"^.united
()
>>>
"hello" & united .~ ()
"hello"
head1 :: Traversable1 t => Lens' (t a) a Source #
A
Lens
focusing on the first element of a
Traversable1
container.
>>>
2 :| [3, 4] & head1 +~ 10
12 :| [3,4]
>>>
Identity True ^. head1
True
last1 :: Traversable1 t => Lens' (t a) a Source #
A
Lens
focusing on the last element of a
Traversable1
container.
>>>
2 :| [3, 4] & last1 +~ 10
2 :| [3,14]
>>>
Node 'a' [Node 'b' [], Node 'c' []] ^. last1
'c'
fusing :: Functor f => LensLike ( Yoneda f) s t a b -> LensLike f s t a b Source #
Fuse a composition of lenses using
Yoneda
to provide
fmap
fusion.
In general, given a pair of lenses
foo
and
bar
fusing (foo.bar) = foo.bar
however,
foo
and
bar
are either going to
fmap
internally or they are trivial.
fusing
exploits the
Yoneda
lemma to merge these separate uses into a single
fmap
.
This is particularly effective when the choice of functor
f
is unknown at compile
time or when the
Lens
foo.bar
in the above description is recursive or complex
enough to prevent inlining.
fusing
::Lens
s t a b ->Lens
s t a b
class Field19 s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
Provides access to the 19th field of a tuple.
Nothing
Access the 19th field of a tuple.
Instances
Field19 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s') s s' Source # | |
Defined in Control.Lens.Tuple |
class Field18 s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
Provides access to the 18th field of a tuple.
Nothing
Access the 18th field of a tuple.
Instances
Field18 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r') r r' Source # | |
Defined in Control.Lens.Tuple |
|
Field18 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r', s) r r' Source # | |
Defined in Control.Lens.Tuple |
class Field17 s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
Provides access to the 17th field of a tuple.
Nothing
Access the 17th field of a tuple.
Instances
Field17 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q') q q' Source # | |
Defined in Control.Lens.Tuple |
|
Field17 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q', r) q q' Source # | |
Defined in Control.Lens.Tuple |
|
Field17 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q', r, s) q q' Source # | |
Defined in Control.Lens.Tuple |
class Field16 s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
Provides access to the 16th field of a tuple.
Nothing
Access the 16th field of a tuple.
Instances
Field16 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p') p p' Source # | |
Defined in Control.Lens.Tuple |
|
Field16 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p', q) p p' Source # | |
Defined in Control.Lens.Tuple |
|
Field16 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p', q, r) p p' Source # | |
Defined in Control.Lens.Tuple |
|
Field16 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p', q, r, s) p p' Source # | |
Defined in Control.Lens.Tuple |
class Field15 s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
Provides access to the 15th field of a tuple.
Nothing
Access the 15th field of a tuple.
Instances
Field15 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o') o o' Source # | |
Defined in Control.Lens.Tuple |
|
Field15 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o', p) o o' Source # | |
Defined in Control.Lens.Tuple |
|
Field15 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o', p, q) o o' Source # | |
Defined in Control.Lens.Tuple |
|
Field15 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o', p, q, r) o o' Source # | |
Defined in Control.Lens.Tuple |
|
Field15 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o', p, q, r, s) o o' Source # | |
Defined in Control.Lens.Tuple |
class Field14 s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
Provides access to the 14th field of a tuple.
Nothing
Access the 14th field of a tuple.
Instances
Field14 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n') n n' Source # | |
Defined in Control.Lens.Tuple |
|
Field14 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n', o) n n' Source # | |
Defined in Control.Lens.Tuple |
|
Field14 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n', o, p) n n' Source # | |
Defined in Control.Lens.Tuple |
|
Field14 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n', o, p, q) n n' Source # | |
Defined in Control.Lens.Tuple |
|
Field14 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n', o, p, q, r) n n' Source # | |
Defined in Control.Lens.Tuple |
|
Field14 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h, i, j, kk, l, m, n', o, p, q, r, s) n n' Source # | |
Defined in Control.Lens.Tuple |
class Field13 s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
Provides access to the 13th field of a tuple.
Nothing
Access the 13th field of a tuple.
Instances
Field13 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b, c, d, e, f, g, h, i, j, kk, l, m') m m' Source # | |
Defined in Control.Lens.Tuple |
|
Field13 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c, d, e, f, g, h, i, j, kk, l, m', n) m m' Source # | |
Defined in Control.Lens.Tuple |
|
Field13 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d, e, f, g, h, i, j, kk, l, m', n, o) m m' Source # | |
Defined in Control.Lens.Tuple |
|
Field13 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e, f, g, h, i, j, kk, l, m', n, o, p) m m' Source # | |
Defined in Control.Lens.Tuple |
|
Field13 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f, g, h, i, j, kk, l, m', n, o, p, q) m m' Source # | |
Defined in Control.Lens.Tuple |
|
Field13 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g, h, i, j, kk, l, m', n, o, p, q, r) m m' Source # | |
Defined in Control.Lens.Tuple |
|
Field13 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h, i, j, kk, l, m', n, o, p, q, r, s) m m' Source # | |
Defined in Control.Lens.Tuple |
class Field12 s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
Provides access to the 12th field of a tuple.
Nothing
Access the 12th field of a tuple.
Instances
Field12 (a, b, c, d, e, f, g, h, i, j, kk, l) (a, b, c, d, e, f, g, h, i, j, kk, l') l l' Source # | |
Defined in Control.Lens.Tuple |
|
Field12 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b, c, d, e, f, g, h, i, j, kk, l', m) l l' Source # | |
Defined in Control.Lens.Tuple |
|
Field12 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c, d, e, f, g, h, i, j, kk, l', m, n) l l' Source # | |
Defined in Control.Lens.Tuple |
|
Field12 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d, e, f, g, h, i, j, kk, l', m, n, o) l l' Source # | |
Defined in Control.Lens.Tuple |
|
Field12 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e, f, g, h, i, j, kk, l', m, n, o, p) l l' Source # | |
Defined in Control.Lens.Tuple |
|
Field12 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f, g, h, i, j, kk, l', m, n, o, p, q) l l' Source # | |
Defined in Control.Lens.Tuple |
|
Field12 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g, h, i, j, kk, l', m, n, o, p, q, r) l l' Source # | |
Defined in Control.Lens.Tuple |
|
Field12 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h, i, j, kk, l', m, n, o, p, q, r, s) l l' Source # | |
Defined in Control.Lens.Tuple |
class Field11 s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
Provides access to the 11th field of a tuple.
Nothing
Access the 11th field of a tuple.
Instances
Field11 (a, b, c, d, e, f, g, h, i, j, kk) (a, b, c, d, e, f, g, h, i, j, kk') kk kk' Source # | |
Defined in Control.Lens.Tuple |
|
Field11 (a, b, c, d, e, f, g, h, i, j, kk, l) (a, b, c, d, e, f, g, h, i, j, kk', l) kk kk' Source # | |
Defined in Control.Lens.Tuple |
|
Field11 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b, c, d, e, f, g, h, i, j, kk', l, m) kk kk' Source # | |
Defined in Control.Lens.Tuple |
|
Field11 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c, d, e, f, g, h, i, j, kk', l, m, n) kk kk' Source # | |
Defined in Control.Lens.Tuple |
|
Field11 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d, e, f, g, h, i, j, kk', l, m, n, o) kk kk' Source # | |
Defined in Control.Lens.Tuple |
|
Field11 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e, f, g, h, i, j, kk', l, m, n, o, p) kk kk' Source # | |
Defined in Control.Lens.Tuple |
|
Field11 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f, g, h, i, j, kk', l, m, n, o, p, q) kk kk' Source # | |
Defined in Control.Lens.Tuple |
|
Field11 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g, h, i, j, kk', l, m, n, o, p, q, r) kk kk' Source # | |
Defined in Control.Lens.Tuple |
|
Field11 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h, i, j, kk', l, m, n, o, p, q, r, s) kk kk' Source # | |
Defined in Control.Lens.Tuple |
class Field10 s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
Provides access to the 10th field of a tuple.
Nothing
Access the 10th field of a tuple.
Instances
Field10 (a, b, c, d, e, f, g, h, i, j) (a, b, c, d, e, f, g, h, i, j') j j' Source # | |
Defined in Control.Lens.Tuple |
|
Field10 (a, b, c, d, e, f, g, h, i, j, kk) (a, b, c, d, e, f, g, h, i, j', kk) j j' Source # | |
Defined in Control.Lens.Tuple |
|
Field10 (a, b, c, d, e, f, g, h, i, j, kk, l) (a, b, c, d, e, f, g, h, i, j', kk, l) j j' Source # | |
Defined in Control.Lens.Tuple |
|
Field10 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b, c, d, e, f, g, h, i, j', kk, l, m) j j' Source # | |
Defined in Control.Lens.Tuple |
|
Field10 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c, d, e, f, g, h, i, j', kk, l, m, n) j j' Source # | |
Defined in Control.Lens.Tuple |
|
Field10 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d, e, f, g, h, i, j', kk, l, m, n, o) j j' Source # | |
Defined in Control.Lens.Tuple |
|
Field10 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e, f, g, h, i, j', kk, l, m, n, o, p) j j' Source # | |
Defined in Control.Lens.Tuple |
|
Field10 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f, g, h, i, j', kk, l, m, n, o, p, q) j j' Source # | |
Defined in Control.Lens.Tuple |
|
Field10 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g, h, i, j', kk, l, m, n, o, p, q, r) j j' Source # | |
Defined in Control.Lens.Tuple |
|
Field10 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h, i, j', kk, l, m, n, o, p, q, r, s) j j' Source # | |
Defined in Control.Lens.Tuple |
class Field9 s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
Provides access to the 9th field of a tuple.
Nothing
Access the 9th field of a tuple.
Instances
Field9 (a, b, c, d, e, f, g, h, i) (a, b, c, d, e, f, g, h, i') i i' Source # | |
Defined in Control.Lens.Tuple |
|
Field9 (a, b, c, d, e, f, g, h, i, j) (a, b, c, d, e, f, g, h, i', j) i i' Source # | |
Defined in Control.Lens.Tuple |
|
Field9 (a, b, c, d, e, f, g, h, i, j, kk) (a, b, c, d, e, f, g, h, i', j, kk) i i' Source # | |
Defined in Control.Lens.Tuple |
|
Field9 (a, b, c, d, e, f, g, h, i, j, kk, l) (a, b, c, d, e, f, g, h, i', j, kk, l) i i' Source # | |
Defined in Control.Lens.Tuple |
|
Field9 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b, c, d, e, f, g, h, i', j, kk, l, m) i i' Source # | |
Defined in Control.Lens.Tuple |
|
Field9 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c, d, e, f, g, h, i', j, kk, l, m, n) i i' Source # | |
Defined in Control.Lens.Tuple |
|
Field9 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d, e, f, g, h, i', j, kk, l, m, n, o) i i' Source # | |
Defined in Control.Lens.Tuple |
|
Field9 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e, f, g, h, i', j, kk, l, m, n, o, p) i i' Source # | |
Defined in Control.Lens.Tuple |
|
Field9 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f, g, h, i', j, kk, l, m, n, o, p, q) i i' Source # | |
Defined in Control.Lens.Tuple |
|
Field9 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g, h, i', j, kk, l, m, n, o, p, q, r) i i' Source # | |
Defined in Control.Lens.Tuple |
|
Field9 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h, i', j, kk, l, m, n, o, p, q, r, s) i i' Source # | |
Defined in Control.Lens.Tuple |
class Field8 s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
Provide access to the 8th field of a tuple.
Nothing
Access the 8th field of a tuple.
Instances
Field8 (a, b, c, d, e, f, g, h) (a, b, c, d, e, f, g, h') h h' Source # | |
Defined in Control.Lens.Tuple |
|
Field8 (a, b, c, d, e, f, g, h, i) (a, b, c, d, e, f, g, h', i) h h' Source # | |
Defined in Control.Lens.Tuple |
|
Field8 (a, b, c, d, e, f, g, h, i, j) (a, b, c, d, e, f, g, h', i, j) h h' Source # | |
Defined in Control.Lens.Tuple |
|
Field8 (a, b, c, d, e, f, g, h, i, j, kk) (a, b, c, d, e, f, g, h', i, j, kk) h h' Source # | |
Defined in Control.Lens.Tuple |
|
Field8 (a, b, c, d, e, f, g, h, i, j, kk, l) (a, b, c, d, e, f, g, h', i, j, kk, l) h h' Source # | |
Defined in Control.Lens.Tuple |
|
Field8 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b, c, d, e, f, g, h', i, j, kk, l, m) h h' Source # | |
Defined in Control.Lens.Tuple |
|
Field8 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c, d, e, f, g, h', i, j, kk, l, m, n) h h' Source # | |
Defined in Control.Lens.Tuple |
|
Field8 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d, e, f, g, h', i, j, kk, l, m, n, o) h h' Source # | |
Defined in Control.Lens.Tuple |
|
Field8 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e, f, g, h', i, j, kk, l, m, n, o, p) h h' Source # | |
Defined in Control.Lens.Tuple |
|
Field8 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f, g, h', i, j, kk, l, m, n, o, p, q) h h' Source # | |
Defined in Control.Lens.Tuple |
|
Field8 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g, h', i, j, kk, l, m, n, o, p, q, r) h h' Source # | |
Defined in Control.Lens.Tuple |
|
Field8 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g, h', i, j, kk, l, m, n, o, p, q, r, s) h h' Source # | |
Defined in Control.Lens.Tuple |
class Field7 s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
Provide access to the 7th field of a tuple.
Nothing
Access the 7th field of a tuple.
Instances
Field7 (a, b, c, d, e, f, g) (a, b, c, d, e, f, g') g g' Source # | |
Defined in Control.Lens.Tuple |
|
Field7 (a, b, c, d, e, f, g, h) (a, b, c, d, e, f, g', h) g g' Source # | |
Defined in Control.Lens.Tuple |
|
Field7 (a, b, c, d, e, f, g, h, i) (a, b, c, d, e, f, g', h, i) g g' Source # | |
Defined in Control.Lens.Tuple |
|
Field7 (a, b, c, d, e, f, g, h, i, j) (a, b, c, d, e, f, g', h, i, j) g g' Source # | |
Defined in Control.Lens.Tuple |
|
Field7 (a, b, c, d, e, f, g, h, i, j, kk) (a, b, c, d, e, f, g', h, i, j, kk) g g' Source # | |
Defined in Control.Lens.Tuple |
|
Field7 (a, b, c, d, e, f, g, h, i, j, kk, l) (a, b, c, d, e, f, g', h, i, j, kk, l) g g' Source # | |
Defined in Control.Lens.Tuple |
|
Field7 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b, c, d, e, f, g', h, i, j, kk, l, m) g g' Source # | |
Defined in Control.Lens.Tuple |
|
Field7 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c, d, e, f, g', h, i, j, kk, l, m, n) g g' Source # | |
Defined in Control.Lens.Tuple |
|
Field7 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d, e, f, g', h, i, j, kk, l, m, n, o) g g' Source # | |
Defined in Control.Lens.Tuple |
|
Field7 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e, f, g', h, i, j, kk, l, m, n, o, p) g g' Source # | |
Defined in Control.Lens.Tuple |
|
Field7 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f, g', h, i, j, kk, l, m, n, o, p, q) g g' Source # | |
Defined in Control.Lens.Tuple |
|
Field7 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f, g', h, i, j, kk, l, m, n, o, p, q, r) g g' Source # | |
Defined in Control.Lens.Tuple |
|
Field7 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f, g', h, i, j, kk, l, m, n, o, p, q, r, s) g g' Source # | |
Defined in Control.Lens.Tuple |
class Field6 s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
Provides access to the 6th element of a tuple.
Nothing
Access the 6th field of a tuple.
Instances
Field6 (a, b, c, d, e, f) (a, b, c, d, e, f') f f' Source # | |
Defined in Control.Lens.Tuple |
|
Field6 (a, b, c, d, e, f, g) (a, b, c, d, e, f', g) f f' Source # | |
Defined in Control.Lens.Tuple |
|
Field6 (a, b, c, d, e, f, g, h) (a, b, c, d, e, f', g, h) f f' Source # | |
Defined in Control.Lens.Tuple |
|
Field6 (a, b, c, d, e, f, g, h, i) (a, b, c, d, e, f', g, h, i) f f' Source # | |
Defined in Control.Lens.Tuple |
|
Field6 (a, b, c, d, e, f, g, h, i, j) (a, b, c, d, e, f', g, h, i, j) f f' Source # | |
Defined in Control.Lens.Tuple |
|
Field6 (a, b, c, d, e, f, g, h, i, j, kk) (a, b, c, d, e, f', g, h, i, j, kk) f f' Source # | |
Defined in Control.Lens.Tuple |
|
Field6 (a, b, c, d, e, f, g, h, i, j, kk, l) (a, b, c, d, e, f', g, h, i, j, kk, l) f f' Source # | |
Defined in Control.Lens.Tuple |
|
Field6 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b, c, d, e, f', g, h, i, j, kk, l, m) f f' Source # | |
Defined in Control.Lens.Tuple |
|
Field6 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c, d, e, f', g, h, i, j, kk, l, m, n) f f' Source # | |
Defined in Control.Lens.Tuple |
|
Field6 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d, e, f', g, h, i, j, kk, l, m, n, o) f f' Source # | |
Defined in Control.Lens.Tuple |
|
Field6 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e, f', g, h, i, j, kk, l, m, n, o, p) f f' Source # | |
Defined in Control.Lens.Tuple |
|
Field6 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e, f', g, h, i, j, kk, l, m, n, o, p, q) f f' Source # | |
Defined in Control.Lens.Tuple |
|
Field6 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e, f', g, h, i, j, kk, l, m, n, o, p, q, r) f f' Source # | |
Defined in Control.Lens.Tuple |
|
Field6 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e, f', g, h, i, j, kk, l, m, n, o, p, q, r, s) f f' Source # | |
Defined in Control.Lens.Tuple |
class Field5 s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
Provides access to the 5th field of a tuple.
Nothing
Access the 5th field of a tuple.
Instances
Field5 (a, b, c, d, e) (a, b, c, d, e') e e' Source # | |
Defined in Control.Lens.Tuple |
|
Field5 (a, b, c, d, e, f) (a, b, c, d, e', f) e e' Source # | |
Defined in Control.Lens.Tuple |
|
Field5 (a, b, c, d, e, f, g) (a, b, c, d, e', f, g) e e' Source # | |
Defined in Control.Lens.Tuple |
|
Field5 (a, b, c, d, e, f, g, h) (a, b, c, d, e', f, g, h) e e' Source # | |
Defined in Control.Lens.Tuple |
|
Field5 (a, b, c, d, e, f, g, h, i) (a, b, c, d, e', f, g, h, i) e e' Source # | |
Defined in Control.Lens.Tuple |
|
Field5 (a, b, c, d, e, f, g, h, i, j) (a, b, c, d, e', f, g, h, i, j) e e' Source # | |
Defined in Control.Lens.Tuple |
|
Field5 (a, b, c, d, e, f, g, h, i, j, kk) (a, b, c, d, e', f, g, h, i, j, kk) e e' Source # | |
Defined in Control.Lens.Tuple |
|
Field5 (a, b, c, d, e, f, g, h, i, j, kk, l) (a, b, c, d, e', f, g, h, i, j, kk, l) e e' Source # | |
Defined in Control.Lens.Tuple |
|
Field5 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b, c, d, e', f, g, h, i, j, kk, l, m) e e' Source # | |
Defined in Control.Lens.Tuple |
|
Field5 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c, d, e', f, g, h, i, j, kk, l, m, n) e e' Source # | |
Defined in Control.Lens.Tuple |
|
Field5 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d, e', f, g, h, i, j, kk, l, m, n, o) e e' Source # | |
Defined in Control.Lens.Tuple |
|
Field5 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d, e', f, g, h, i, j, kk, l, m, n, o, p) e e' Source # | |
Defined in Control.Lens.Tuple |
|
Field5 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d, e', f, g, h, i, j, kk, l, m, n, o, p, q) e e' Source # | |
Defined in Control.Lens.Tuple |
|
Field5 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d, e', f, g, h, i, j, kk, l, m, n, o, p, q, r) e e' Source # | |
Defined in Control.Lens.Tuple |
|
Field5 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d, e', f, g, h, i, j, kk, l, m, n, o, p, q, r, s) e e' Source # | |
Defined in Control.Lens.Tuple |
class Field4 s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
Provide access to the 4th field of a tuple.
Nothing
Access the 4th field of a tuple.
Instances
Field4 (a, b, c, d) (a, b, c, d') d d' Source # | |
Defined in Control.Lens.Tuple |
|
Field4 (a, b, c, d, e) (a, b, c, d', e) d d' Source # | |
Defined in Control.Lens.Tuple |
|
Field4 (a, b, c, d, e, f) (a, b, c, d', e, f) d d' Source # | |
Defined in Control.Lens.Tuple |
|
Field4 (a, b, c, d, e, f, g) (a, b, c, d', e, f, g) d d' Source # | |
Defined in Control.Lens.Tuple |
|
Field4 (a, b, c, d, e, f, g, h) (a, b, c, d', e, f, g, h) d d' Source # | |
Defined in Control.Lens.Tuple |
|
Field4 (a, b, c, d, e, f, g, h, i) (a, b, c, d', e, f, g, h, i) d d' Source # | |
Defined in Control.Lens.Tuple |
|
Field4 (a, b, c, d, e, f, g, h, i, j) (a, b, c, d', e, f, g, h, i, j) d d' Source # | |
Defined in Control.Lens.Tuple |
|
Field4 (a, b, c, d, e, f, g, h, i, j, kk) (a, b, c, d', e, f, g, h, i, j, kk) d d' Source # | |
Defined in Control.Lens.Tuple |
|
Field4 (a, b, c, d, e, f, g, h, i, j, kk, l) (a, b, c, d', e, f, g, h, i, j, kk, l) d d' Source # | |
Defined in Control.Lens.Tuple |
|
Field4 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b, c, d', e, f, g, h, i, j, kk, l, m) d d' Source # | |
Defined in Control.Lens.Tuple |
|
Field4 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c, d', e, f, g, h, i, j, kk, l, m, n) d d' Source # | |
Defined in Control.Lens.Tuple |
|
Field4 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c, d', e, f, g, h, i, j, kk, l, m, n, o) d d' Source # | |
Defined in Control.Lens.Tuple |
|
Field4 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c, d', e, f, g, h, i, j, kk, l, m, n, o, p) d d' Source # | |
Defined in Control.Lens.Tuple |
|
Field4 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c, d', e, f, g, h, i, j, kk, l, m, n, o, p, q) d d' Source # | |
Defined in Control.Lens.Tuple |
|
Field4 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c, d', e, f, g, h, i, j, kk, l, m, n, o, p, q, r) d d' Source # | |
Defined in Control.Lens.Tuple |
|
Field4 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c, d', e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) d d' Source # | |
Defined in Control.Lens.Tuple |
class Field3 s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
Provides access to the 3rd field of a tuple.
Nothing
Access the 3rd field of a tuple.
Instances
Field3 (a, b, c) (a, b, c') c c' Source # | |
Defined in Control.Lens.Tuple |
|
Field3 (a, b, c, d) (a, b, c', d) c c' Source # | |
Defined in Control.Lens.Tuple |
|
Field3 (a, b, c, d, e) (a, b, c', d, e) c c' Source # | |
Defined in Control.Lens.Tuple |
|
Field3 (a, b, c, d, e, f) (a, b, c', d, e, f) c c' Source # | |
Defined in Control.Lens.Tuple |
|
Field3 (a, b, c, d, e, f, g) (a, b, c', d, e, f, g) c c' Source # | |
Defined in Control.Lens.Tuple |
|
Field3 (a, b, c, d, e, f, g, h) (a, b, c', d, e, f, g, h) c c' Source # | |
Defined in Control.Lens.Tuple |
|
Field3 (a, b, c, d, e, f, g, h, i) (a, b, c', d, e, f, g, h, i) c c' Source # | |
Defined in Control.Lens.Tuple |
|
Field3 (a, b, c, d, e, f, g, h, i, j) (a, b, c', d, e, f, g, h, i, j) c c' Source # | |
Defined in Control.Lens.Tuple |
|
Field3 (a, b, c, d, e, f, g, h, i, j, kk) (a, b, c', d, e, f, g, h, i, j, kk) c c' Source # | |
Defined in Control.Lens.Tuple |
|
Field3 (a, b, c, d, e, f, g, h, i, j, kk, l) (a, b, c', d, e, f, g, h, i, j, kk, l) c c' Source # | |
Defined in Control.Lens.Tuple |
|
Field3 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b, c', d, e, f, g, h, i, j, kk, l, m) c c' Source # | |
Defined in Control.Lens.Tuple |
|
Field3 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b, c', d, e, f, g, h, i, j, kk, l, m, n) c c' Source # | |
Defined in Control.Lens.Tuple |
|
Field3 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b, c', d, e, f, g, h, i, j, kk, l, m, n, o) c c' Source # | |
Defined in Control.Lens.Tuple |
|
Field3 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b, c', d, e, f, g, h, i, j, kk, l, m, n, o, p) c c' Source # | |
Defined in Control.Lens.Tuple |
|
Field3 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b, c', d, e, f, g, h, i, j, kk, l, m, n, o, p, q) c c' Source # | |
Defined in Control.Lens.Tuple |
|
Field3 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b, c', d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) c c' Source # | |
Defined in Control.Lens.Tuple |
|
Field3 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b, c', d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) c c' Source # | |
Defined in Control.Lens.Tuple |
class Field2 s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
Provides access to the 2nd field of a tuple.
Nothing
Access the 2nd field of a tuple.
>>>
_2 .~ "hello" $ (1,(),3,4)
(1,"hello",3,4)
>>>
(1,2,3,4) & _2 *~ 3
(1,6,3,4)
>>>
_2 print (1,2)
2 (1,())
anyOf
_2
:: (s ->Bool
) -> (a, s) ->Bool
traverse
.
_2
:: (Applicative
f,Traversable
t) => (a -> f b) -> t (s, a) -> f (t (s, b))foldMapOf
(traverse
.
_2
) :: (Traversable
t,Monoid
m) => (s -> m) -> t (b, s) -> m
Instances
Field2 (a, b) (a, b') b b' Source # |
|
Defined in Control.Lens.Tuple |
|
Field2 ( Pair a b) ( Pair a b') b b' Source # |
Since: 4.20 |
Field2 (a, b, c) (a, b', c) b b' Source # | |
Defined in Control.Lens.Tuple |
|
Field2 (a, b, c, d) (a, b', c, d) b b' Source # | |
Defined in Control.Lens.Tuple |
|
Field2 ((f :*: g) p) ((f :*: g') p) (g p) (g' p) Source # | |
Field2 ( Product f g a) ( Product f g' a) (g a) (g' a) Source # | |
Field2 (a, b, c, d, e) (a, b', c, d, e) b b' Source # | |
Defined in Control.Lens.Tuple |
|
Field2 (a, b, c, d, e, f) (a, b', c, d, e, f) b b' Source # | |
Defined in Control.Lens.Tuple |
|
Field2 (a, b, c, d, e, f, g) (a, b', c, d, e, f, g) b b' Source # | |
Defined in Control.Lens.Tuple |
|
Field2 (a, b, c, d, e, f, g, h) (a, b', c, d, e, f, g, h) b b' Source # | |
Defined in Control.Lens.Tuple |
|
Field2 (a, b, c, d, e, f, g, h, i) (a, b', c, d, e, f, g, h, i) b b' Source # | |
Defined in Control.Lens.Tuple |
|
Field2 (a, b, c, d, e, f, g, h, i, j) (a, b', c, d, e, f, g, h, i, j) b b' Source # | |
Defined in Control.Lens.Tuple |
|
Field2 (a, b, c, d, e, f, g, h, i, j, kk) (a, b', c, d, e, f, g, h, i, j, kk) b b' Source # | |
Defined in Control.Lens.Tuple |
|
Field2 (a, b, c, d, e, f, g, h, i, j, kk, l) (a, b', c, d, e, f, g, h, i, j, kk, l) b b' Source # | |
Defined in Control.Lens.Tuple |
|
Field2 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a, b', c, d, e, f, g, h, i, j, kk, l, m) b b' Source # | |
Defined in Control.Lens.Tuple |
|
Field2 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a, b', c, d, e, f, g, h, i, j, kk, l, m, n) b b' Source # | |
Defined in Control.Lens.Tuple |
|
Field2 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a, b', c, d, e, f, g, h, i, j, kk, l, m, n, o) b b' Source # | |
Defined in Control.Lens.Tuple |
|
Field2 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a, b', c, d, e, f, g, h, i, j, kk, l, m, n, o, p) b b' Source # | |
Defined in Control.Lens.Tuple |
|
Field2 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a, b', c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) b b' Source # | |
Defined in Control.Lens.Tuple |
|
Field2 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a, b', c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) b b' Source # | |
Defined in Control.Lens.Tuple |
|
Field2 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a, b', c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) b b' Source # | |
Defined in Control.Lens.Tuple |
class Field1 s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
Provides access to 1st field of a tuple.
Nothing
Access the 1st field of a tuple (and possibly change its type).
>>>
(1,2)^._1
1
>>>
_1 .~ "hello" $ (1,2)
("hello",2)
>>>
(1,2) & _1 .~ "hello"
("hello",2)
>>>
_1 putStrLn ("hello","world")
hello ((),"world")
This can also be used on larger tuples as well:
>>>
(1,2,3,4,5) & _1 +~ 41
(42,2,3,4,5)
_1
::Lens
(a,b) (a',b) a a'_1
::Lens
(a,b,c) (a',b,c) a a'_1
::Lens
(a,b,c,d) (a',b,c,d) a a' ..._1
::Lens
(a,b,c,d,e,f,g,h,i) (a',b,c,d,e,f,g,h,i) a a'
Instances
Field1 ( Identity a) ( Identity b) a b Source # | |
Field1 (a, b) (a', b) a a' Source # |
|
Defined in Control.Lens.Tuple |
|
Field1 ( Pair a b) ( Pair a' b) a a' Source # |
Since: 4.20 |
Field1 (a, b, c) (a', b, c) a a' Source # | |
Defined in Control.Lens.Tuple |
|
Field1 (a, b, c, d) (a', b, c, d) a a' Source # | |
Defined in Control.Lens.Tuple |
|
Field1 ((f :*: g) p) ((f' :*: g) p) (f p) (f' p) Source # | |
Field1 ( Product f g a) ( Product f' g a) (f a) (f' a) Source # | |
Field1 (a, b, c, d, e) (a', b, c, d, e) a a' Source # | |
Defined in Control.Lens.Tuple |
|
Field1 (a, b, c, d, e, f) (a', b, c, d, e, f) a a' Source # | |
Defined in Control.Lens.Tuple |
|
Field1 (a, b, c, d, e, f, g) (a', b, c, d, e, f, g) a a' Source # | |
Defined in Control.Lens.Tuple |
|
Field1 (a, b, c, d, e, f, g, h) (a', b, c, d, e, f, g, h) a a' Source # | |
Defined in Control.Lens.Tuple |
|
Field1 (a, b, c, d, e, f, g, h, i) (a', b, c, d, e, f, g, h, i) a a' Source # | |
Defined in Control.Lens.Tuple |
|
Field1 (a, b, c, d, e, f, g, h, i, j) (a', b, c, d, e, f, g, h, i, j) a a' Source # | |
Defined in Control.Lens.Tuple |
|
Field1 (a, b, c, d, e, f, g, h, i, j, kk) (a', b, c, d, e, f, g, h, i, j, kk) a a' Source # | |
Defined in Control.Lens.Tuple |
|
Field1 (a, b, c, d, e, f, g, h, i, j, kk, l) (a', b, c, d, e, f, g, h, i, j, kk, l) a a' Source # | |
Defined in Control.Lens.Tuple |
|
Field1 (a, b, c, d, e, f, g, h, i, j, kk, l, m) (a', b, c, d, e, f, g, h, i, j, kk, l, m) a a' Source # | |
Defined in Control.Lens.Tuple |
|
Field1 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n) (a', b, c, d, e, f, g, h, i, j, kk, l, m, n) a a' Source # | |
Defined in Control.Lens.Tuple |
|
Field1 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o) (a', b, c, d, e, f, g, h, i, j, kk, l, m, n, o) a a' Source # | |
Defined in Control.Lens.Tuple |
|
Field1 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) (a', b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p) a a' Source # | |
Defined in Control.Lens.Tuple |
|
Field1 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) (a', b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q) a a' Source # | |
Defined in Control.Lens.Tuple |
|
Field1 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) (a', b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r) a a' Source # | |
Defined in Control.Lens.Tuple |
|
Field1 (a, b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) (a', b, c, d, e, f, g, h, i, j, kk, l, m, n, o, p, q, r, s) a a' Source # | |
Defined in Control.Lens.Tuple |
type Accessing p m s a = p a ( Const m a) -> s -> Const m s Source #
This is a convenient alias used when consuming (indexed) getters and (indexed) folds in a highly general fashion.
type IndexedGetting i m s a = Indexed i a ( Const m a) -> s -> Const m s Source #
Used to consume an
IndexedFold
.
type Getting r s a = (a -> Const r a) -> s -> Const r s Source #
When you see this in a type signature it indicates that you can
pass the function a
Lens
,
Getter
,
Traversal
,
Fold
,
Prism
,
Iso
, or one of
the indexed variants, and it will just "do the right thing".
Most
Getter
combinators are able to be used with both a
Getter
or a
Fold
in limited situations, to do so, they need to be
monomorphic in what we are going to extract with
Const
. To be compatible
with
Lens
,
Traversal
and
Iso
we also restricted choices of the irrelevant
t
and
b
parameters.
If a function accepts a
, then when
Getting
r s a
r
is a
Monoid
, then
you can pass a
Fold
(or
Traversal
), otherwise you can only pass this a
Getter
or
Lens
.
to :: ( Profunctor p, Contravariant f) => (s -> a) -> Optic' p f s a Source #
ito :: ( Indexable i p, Contravariant f) => (s -> (i, a)) -> Over' p f s a Source #
ito
:: (s -> (i, a)) ->IndexedGetter
i s a
like :: ( Profunctor p, Contravariant f, Functor f) => a -> Optic' p f s a Source #
ilike :: ( Indexable i p, Contravariant f, Functor f) => i -> a -> Over' p f s a Source #
ilike
:: i -> a ->IndexedGetter
i s a
view :: MonadReader s m => Getting a s a -> m a Source #
View the value pointed to by a
Getter
,
Iso
or
Lens
or the result of folding over all the results of a
Fold
or
Traversal
that points
at a monoidal value.
view
.
to
≡id
>>>
view (to f) a
f a
>>>
view _2 (1,"hello")
"hello"
>>>
view (to succ) 5
6
>>>
view (_2._1) ("hello",("world","!!!"))
"world"
As
view
is commonly used to access the target of a
Getter
or obtain a monoidal summary of the targets of a
Fold
,
It may be useful to think of it as having one of these more restricted signatures:
view
::Getter
s a -> s -> aview
::Monoid
m =>Fold
s m -> s -> mview
::Iso'
s a -> s -> aview
::Lens'
s a -> s -> aview
::Monoid
m =>Traversal'
s m -> s -> m
In a more general setting, such as when working with a
Monad
transformer stack you can use:
view
::MonadReader
s m =>Getter
s a -> m aview
:: (MonadReader
s m,Monoid
a) =>Fold
s a -> m aview
::MonadReader
s m =>Iso'
s a -> m aview
::MonadReader
s m =>Lens'
s a -> m aview
:: (MonadReader
s m,Monoid
a) =>Traversal'
s a -> m a
views :: MonadReader s m => LensLike' ( Const r) s a -> (a -> r) -> m r Source #
View a function of the value pointed to by a
Getter
or
Lens
or the result of
folding over the result of mapping the targets of a
Fold
or
Traversal
.
views
l f ≡view
(l.
to
f)
>>>
views (to f) g a
g (f a)
>>>
views _2 length (1,"hello")
5
As
views
is commonly used to access the target of a
Getter
or obtain a monoidal summary of the targets of a
Fold
,
It may be useful to think of it as having one of these more restricted signatures:
views
::Getter
s a -> (a -> r) -> s -> rviews
::Monoid
m =>Fold
s a -> (a -> m) -> s -> mviews
::Iso'
s a -> (a -> r) -> s -> rviews
::Lens'
s a -> (a -> r) -> s -> rviews
::Monoid
m =>Traversal'
s a -> (a -> m) -> s -> m
In a more general setting, such as when working with a
Monad
transformer stack you can use:
views
::MonadReader
s m =>Getter
s a -> (a -> r) -> m rviews
:: (MonadReader
s m,Monoid
r) =>Fold
s a -> (a -> r) -> m rviews
::MonadReader
s m =>Iso'
s a -> (a -> r) -> m rviews
::MonadReader
s m =>Lens'
s a -> (a -> r) -> m rviews
:: (MonadReader
s m,Monoid
r) =>Traversal'
s a -> (a -> r) -> m r
views
::MonadReader
s m =>Getting
r s a -> (a -> r) -> m r
use :: MonadState s m => Getting a s a -> m a Source #
Use the target of a
Lens
,
Iso
, or
Getter
in the current state, or use a summary of a
Fold
or
Traversal
that points
to a monoidal value.
>>>
evalState (use _1) (a,b)
a
>>>
evalState (use _1) ("hello","world")
"hello"
use
::MonadState
s m =>Getter
s a -> m ause
:: (MonadState
s m,Monoid
r) =>Fold
s r -> m ruse
::MonadState
s m =>Iso'
s a -> m ause
::MonadState
s m =>Lens'
s a -> m ause
:: (MonadState
s m,Monoid
r) =>Traversal'
s r -> m r
uses :: MonadState s m => LensLike' ( Const r) s a -> (a -> r) -> m r Source #
Use the target of a
Lens
,
Iso
or
Getter
in the current state, or use a summary of a
Fold
or
Traversal
that
points to a monoidal value.
>>>
evalState (uses _1 length) ("hello","world")
5
uses
::MonadState
s m =>Getter
s a -> (a -> r) -> m ruses
:: (MonadState
s m,Monoid
r) =>Fold
s a -> (a -> r) -> m ruses
::MonadState
s m =>Lens'
s a -> (a -> r) -> m ruses
::MonadState
s m =>Iso'
s a -> (a -> r) -> m ruses
:: (MonadState
s m,Monoid
r) =>Traversal'
s a -> (a -> r) -> m r
uses
::MonadState
s m =>Getting
r s t a b -> (a -> r) -> m r
listening :: MonadWriter w m => Getting u w u -> m a -> m (a, u) Source #
This is a generalized form of
listen
that only extracts the portion of
the log that is focused on by a
Getter
. If given a
Fold
or a
Traversal
then a monoidal summary of the parts of the log that are visited will be
returned.
listening
::MonadWriter
w m =>Getter
w u -> m a -> m (a, u)listening
::MonadWriter
w m =>Lens'
w u -> m a -> m (a, u)listening
::MonadWriter
w m =>Iso'
w u -> m a -> m (a, u)listening
:: (MonadWriter
w m,Monoid
u) =>Fold
w u -> m a -> m (a, u)listening
:: (MonadWriter
w m,Monoid
u) =>Traversal'
w u -> m a -> m (a, u)listening
:: (MonadWriter
w m,Monoid
u) =>Prism'
w u -> m a -> m (a, u)
ilistening :: MonadWriter w m => IndexedGetting i (i, u) w u -> m a -> m (a, (i, u)) Source #
This is a generalized form of
listen
that only extracts the portion of
the log that is focused on by a
Getter
. If given a
Fold
or a
Traversal
then a monoidal summary of the parts of the log that are visited will be
returned.
ilistening
::MonadWriter
w m =>IndexedGetter
i w u -> m a -> m (a, (i, u))ilistening
::MonadWriter
w m =>IndexedLens'
i w u -> m a -> m (a, (i, u))ilistening
:: (MonadWriter
w m,Monoid
u) =>IndexedFold
i w u -> m a -> m (a, (i, u))ilistening
:: (MonadWriter
w m,Monoid
u) =>IndexedTraversal'
i w u -> m a -> m (a, (i, u))
listenings :: MonadWriter w m => Getting v w u -> (u -> v) -> m a -> m (a, v) Source #
This is a generalized form of
listen
that only extracts the portion of
the log that is focused on by a
Getter
. If given a
Fold
or a
Traversal
then a monoidal summary of the parts of the log that are visited will be
returned.
listenings
::MonadWriter
w m =>Getter
w u -> (u -> v) -> m a -> m (a, v)listenings
::MonadWriter
w m =>Lens'
w u -> (u -> v) -> m a -> m (a, v)listenings
::MonadWriter
w m =>Iso'
w u -> (u -> v) -> m a -> m (a, v)listenings
:: (MonadWriter
w m,Monoid
v) =>Fold
w u -> (u -> v) -> m a -> m (a, v)listenings
:: (MonadWriter
w m,Monoid
v) =>Traversal'
w u -> (u -> v) -> m a -> m (a, v)listenings
:: (MonadWriter
w m,Monoid
v) =>Prism'
w u -> (u -> v) -> m a -> m (a, v)
ilistenings :: MonadWriter w m => IndexedGetting i v w u -> (i -> u -> v) -> m a -> m (a, v) Source #
This is a generalized form of
listen
that only extracts the portion of
the log that is focused on by a
Getter
. If given a
Fold
or a
Traversal
then a monoidal summary of the parts of the log that are visited will be
returned.
ilistenings
::MonadWriter
w m =>IndexedGetter
w u -> (i -> u -> v) -> m a -> m (a, v)ilistenings
::MonadWriter
w m =>IndexedLens'
w u -> (i -> u -> v) -> m a -> m (a, v)ilistenings
:: (MonadWriter
w m,Monoid
v) =>IndexedFold
w u -> (i -> u -> v) -> m a -> m (a, v)ilistenings
:: (MonadWriter
w m,Monoid
v) =>IndexedTraversal'
w u -> (i -> u -> v) -> m a -> m (a, v)
iview :: MonadReader s m => IndexedGetting i (i, a) s a -> m (i, a) Source #
View the index and value of an
IndexedGetter
into the current environment as a pair.
When applied to an
IndexedFold
the result will most likely be a nonsensical monoidal summary of
the indices tupled with a monoidal summary of the values and probably not whatever it is you wanted.
iviews :: MonadReader s m => IndexedGetting i r s a -> (i -> a -> r) -> m r Source #
View a function of the index and value of an
IndexedGetter
into the current environment.
When applied to an
IndexedFold
the result will be a monoidal summary instead of a single answer.
iviews
≡ifoldMapOf
iuse :: MonadState s m => IndexedGetting i (i, a) s a -> m (i, a) Source #
Use the index and value of an
IndexedGetter
into the current state as a pair.
When applied to an
IndexedFold
the result will most likely be a nonsensical monoidal summary of
the indices tupled with a monoidal summary of the values and probably not whatever it is you wanted.
iuses :: MonadState s m => IndexedGetting i r s a -> (i -> a -> r) -> m r Source #
Use a function of the index and value of an
IndexedGetter
into the current state.
When applied to an
IndexedFold
the result will be a monoidal summary instead of a single answer.
getting :: ( Profunctor p, Profunctor q, Functor f, Contravariant f) => Optical p q f s t a b -> Optical' p q f s a Source #
Coerce a
Getter
-compatible
Optical
to an
Optical'
. This
is useful when using a
Traversal
that is not simple as a
Getter
or a
Fold
.
getting
::Traversal
s t a b ->Fold
s agetting
::Lens
s t a b ->Getter
s agetting
::IndexedTraversal
i s t a b ->IndexedFold
i s agetting
::IndexedLens
i s t a b ->IndexedGetter
i s a
re :: AReview t b -> Getter b t Source #
Turn a
Prism
or
Iso
around to build a
Getter
.
If you have an
Iso
,
from
is a more powerful version of this function
that will return an
Iso
instead of a mere
Getter
.
>>>
5 ^.re _Left
Left 5
>>>
6 ^.re (_Left.unto succ)
Left 7
review
≡view
.
re
reviews
≡views
.
re
reuse
≡use
.
re
reuses
≡uses
.
re
re
::Prism
s t a b ->Getter
b tre
::Iso
s t a b ->Getter
b t
review :: MonadReader b m => AReview t b -> m t Source #
This can be used to turn an
Iso
or
Prism
around and
view
a value (or the current environment) through it the other way.
review
≡view
.
re
review
.unto
≡id
>>>
review _Left "mustard"
Left "mustard"
>>>
review (unto succ) 5
6
Usually
review
is used in the
(->)
Monad
with a
Prism
or
Iso
, in which case it may be useful to think of
it as having one of these more restricted type signatures:
review
::Iso'
s a -> a -> sreview
::Prism'
s a -> a -> s
However, when working with a
Monad
transformer stack, it is sometimes useful to be able to
review
the current environment, in which case
it may be beneficial to think of it as having one of these slightly more liberal type signatures:
review
::MonadReader
a m =>Iso'
s a -> m sreview
::MonadReader
a m =>Prism'
s a -> m s
reviews :: MonadReader b m => AReview t b -> (t -> r) -> m r Source #
This can be used to turn an
Iso
or
Prism
around and
view
a value (or the current environment) through it the other way,
applying a function.
reviews
≡views
.
re
reviews
(unto
f) g ≡ g.
f
>>>
reviews _Left isRight "mustard"
False
>>>
reviews (unto succ) (*2) 3
8
Usually this function is used in the
(->)
Monad
with a
Prism
or
Iso
, in which case it may be useful to think of
it as having one of these more restricted type signatures:
reviews
::Iso'
s a -> (s -> r) -> a -> rreviews
::Prism'
s a -> (s -> r) -> a -> r
However, when working with a
Monad
transformer stack, it is sometimes useful to be able to
review
the current environment, in which case
it may be beneficial to think of it as having one of these slightly more liberal type signatures:
reviews
::MonadReader
a m =>Iso'
s a -> (s -> r) -> m rreviews
::MonadReader
a m =>Prism'
s a -> (s -> r) -> m r
reuse :: MonadState b m => AReview t b -> m t Source #
This can be used to turn an
Iso
or
Prism
around and
use
a value (or the current environment) through it the other way.
reuse
≡use
.
re
reuse
.
unto
≡gets
>>>
evalState (reuse _Left) 5
Left 5
>>>
evalState (reuse (unto succ)) 5
6
reuse
::MonadState
a m =>Prism'
s a -> m sreuse
::MonadState
a m =>Iso'
s a -> m s
reuses :: MonadState b m => AReview t b -> (t -> r) -> m r Source #
This can be used to turn an
Iso
or
Prism
around and
use
the current state through it the other way,
applying a function.
reuses
≡uses
.
re
reuses
(unto
f) g ≡gets
(g.
f)
>>>
evalState (reuses _Left isLeft) (5 :: Int)
True
reuses
::MonadState
a m =>Prism'
s a -> (s -> r) -> m rreuses
::MonadState
a m =>Iso'
s a -> (s -> r) -> m r
type APrism s t a b = Market a b a ( Identity b) -> Market a b s ( Identity t) Source #
If you see this in a signature for a function, the function is expecting a
Prism
.
withPrism :: APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r Source #
Convert
APrism
to the pair of functions that characterize it.
clonePrism :: APrism s t a b -> Prism s t a b Source #
Clone a
Prism
so that you can reuse the same monomorphically typed
Prism
for different purposes.
See
cloneLens
and
cloneTraversal
for examples of why you might want to do this.
without :: APrism s t a b -> APrism u v c d -> Prism ( Either s u) ( Either t v) ( Either a c) ( Either b d) Source #
aside :: APrism s t a b -> Prism (e, s) (e, t) (e, a) (e, b) Source #
Use a
Prism
to work over part of a structure.
below :: Traversable f => APrism' s a -> Prism' (f s) (f a) Source #
lift
a
Prism
through a
Traversable
functor, giving a Prism that matches only if all the elements of the container match the
Prism
.
>>>
[Left 1, Right "foo", Left 4, Right "woot"]^..below _Right
[]
>>>
[Right "hail hydra!", Right "foo", Right "blah", Right "woot"]^..below _Right
[["hail hydra!","foo","blah","woot"]]
matching :: APrism s t a b -> s -> Either t a Source #
Retrieve the value targeted by a
Prism
or return the
original value while allowing the type to change if it does
not match.
>>>
matching _Just (Just 12)
Right 12
>>>
matching _Just (Nothing :: Maybe Int) :: Either (Maybe Bool) Int
Left Nothing
_Left :: Prism ( Either a c) ( Either b c) a b Source #
This
Prism
provides a
Traversal
for tweaking the
Left
half of an
Either
:
>>>
over _Left (+1) (Left 2)
Left 3
>>>
over _Left (+1) (Right 2)
Right 2
>>>
Right 42 ^._Left :: String
""
>>>
Left "hello" ^._Left
"hello"
It also can be turned around to obtain the embedding into the
Left
half of an
Either
:
>>>
_Left # 5
Left 5
>>>
5^.re _Left
Left 5
_Right :: Prism ( Either c a) ( Either c b) a b Source #
This
Prism
provides a
Traversal
for tweaking the
Right
half of an
Either
:
>>>
over _Right (+1) (Left 2)
Left 2
>>>
over _Right (+1) (Right 2)
Right 3
>>>
Right "hello" ^._Right
"hello"
>>>
Left "hello" ^._Right :: [Double]
[]
It also can be turned around to obtain the embedding into the
Right
half of an
Either
:
>>>
_Right # 5
Right 5
>>>
5^.re _Right
Right 5
_Just :: Prism ( Maybe a) ( Maybe b) a b Source #
This
Prism
provides a
Traversal
for tweaking the target of the value of
Just
in a
Maybe
.
>>>
over _Just (+1) (Just 2)
Just 3
Unlike
traverse
this is a
Prism
, and so you can use it to inject as well:
>>>
_Just # 5
Just 5
>>>
5^.re _Just
Just 5
Interestingly,
m^?
_Just
≡ m
>>>
Just x ^? _Just
Just x
>>>
Nothing ^? _Just
Nothing
only :: Eq a => a -> Prism' a () Source #
This
Prism
compares for exact equality with a given value.
>>>
only 4 # ()
4
>>>
5 ^? only 4
Nothing
nearly :: a -> (a -> Bool ) -> Prism' a () Source #
This
Prism
compares for approximate equality with a given value and a predicate for testing,
an example where the value is the empty list and the predicate checks that a list is empty (same
as
_Empty
with the
AsEmpty
list instance):
>>>
nearly [] null # ()
[]>>>
[1,2,3,4] ^? nearly [] null
Nothing
nearly
[]null
::Prism'
[a] ()
To comply with the
Prism
laws the arguments you supply to
nearly a p
are somewhat constrained.
We assume
p x
holds iff
x ≡ a
. Under that assumption then this is a valid
Prism
.
This is useful when working with a type where you can test equality for only a subset of its values, and the prism selects such a value.
_Show :: ( Read a, Show a) => Prism' String a Source #
This is an improper prism for text formatting based on
Read
and
Show
.
This
Prism
is "improper" in the sense that it normalizes the text formatting, but round tripping
is idempotent given sane
Read
/
Show
instances.
>>>
_Show # 2
"2"
>>>
"EQ" ^? _Show :: Maybe Ordering
Just EQ
_Show
≡prism'
show
readMaybe
ifolding :: ( Foldable f, Indexable i p, Contravariant g, Applicative g) => (s -> f (i, a)) -> Over p g s t a b Source #
foldring :: ( Contravariant f, Applicative f) => ((a -> f a -> f a) -> f a -> s -> f a) -> LensLike f s t a b Source #
ifoldring :: ( Indexable i p, Contravariant f, Applicative f) => ((i -> a -> f a -> f a) -> f a -> s -> f a) -> Over p f s t a b Source #
Obtain
FoldWithIndex
by lifting
ifoldr
like function.
replicated :: Int -> Fold a a Source #
A
Fold
that replicates its input
n
times.
replicate
n ≡toListOf
(replicated
n)
>>>
5^..replicated 20
[5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5]
filtered :: ( Choice p, Applicative f) => (a -> Bool ) -> Optic' p f a a Source #
Obtain a
Fold
that can be composed with to filter another
Lens
,
Iso
,
Getter
,
Fold
(or
Traversal
).
Note: This is
not
a legal
Traversal
, unless you are very careful not to invalidate the predicate on the target.
Note: This is also
not
a legal
Prism
, unless you are very careful not to inject a value that fails the predicate.
As a counter example, consider that given
evens =
the second
filtered
even
Traversal
law is violated:
over
evenssucc
.
over
evenssucc
/=
over
evens (succ
.
succ
)
So, in order for this to qualify as a legal
Traversal
you can only use it for actions that preserve the result of the predicate!
>>>
[1..10]^..folded.filtered even
[2,4,6,8,10]
This will preserve an index if it is present.
filteredBy :: ( Indexable i p, Applicative f) => Getting ( First i) a i -> p a (f a) -> a -> f a Source #
Obtain a potentially empty
IndexedTraversal
by taking the first element from another,
potentially empty
Fold
and using it as an index.
The resulting optic can be composed with to filter another
Lens
,
Iso
,
Getter
,
Fold
(or
Traversal
).
>>>
[(Just 2, 3), (Nothing, 4)] & mapped . filteredBy (_1 . _Just) <. _2 %@~ (*) :: [(Maybe Int, Int)]
[(Just 2,6),(Nothing,4)]
filteredBy
::Fold
a i ->IndexedTraversal'
i a a
Note: As with
filtered
, this is
not
a legal
IndexedTraversal
, unless you are very careful not to invalidate the predicate on the target!
takingWhile :: ( Conjoined p, Applicative f) => (a -> Bool ) -> Over p ( TakingWhile p f a a) s t a a -> Over p f s t a a Source #
Obtain a
Fold
by taking elements from another
Fold
,
Lens
,
Iso
,
Getter
or
Traversal
while a predicate holds.
takeWhile
p ≡toListOf
(takingWhile
pfolded
)
>>>
timingOut $ toListOf (takingWhile (<=3) folded) [1..]
[1,2,3]
takingWhile
:: (a ->Bool
) ->Fold
s a ->Fold
s atakingWhile
:: (a ->Bool
) ->Getter
s a ->Fold
s atakingWhile
:: (a ->Bool
) ->Traversal'
s a ->Fold
s a -- * See note belowtakingWhile
:: (a ->Bool
) ->Lens'
s a ->Fold
s a -- * See note belowtakingWhile
:: (a ->Bool
) ->Prism'
s a ->Fold
s a -- * See note belowtakingWhile
:: (a ->Bool
) ->Iso'
s a ->Fold
s a -- * See note belowtakingWhile
:: (a ->Bool
) ->IndexedTraversal'
i s a ->IndexedFold
i s a -- * See note belowtakingWhile
:: (a ->Bool
) ->IndexedLens'
i s a ->IndexedFold
i s a -- * See note belowtakingWhile
:: (a ->Bool
) ->IndexedFold
i s a ->IndexedFold
i s atakingWhile
:: (a ->Bool
) ->IndexedGetter
i s a ->IndexedFold
i s a
Note:
When applied to a
Traversal
,
takingWhile
yields something that can be used as if it were a
Traversal
, but
which is not a
Traversal
per the laws, unless you are careful to ensure that you do not invalidate the predicate when
writing back through it.
droppingWhile :: ( Conjoined p, Profunctor q, Applicative f) => (a -> Bool ) -> Optical p q ( Compose ( State Bool ) f) s t a a -> Optical p q f s t a a Source #
Obtain a
Fold
by dropping elements from another
Fold
,
Lens
,
Iso
,
Getter
or
Traversal
while a predicate holds.
dropWhile
p ≡toListOf
(droppingWhile
pfolded
)
>>>
toListOf (droppingWhile (<=3) folded) [1..6]
[4,5,6]
>>>
toListOf (droppingWhile (<=3) folded) [1,6,1]
[6,1]
droppingWhile
:: (a ->Bool
) ->Fold
s a ->Fold
s adroppingWhile
:: (a ->Bool
) ->Getter
s a ->Fold
s adroppingWhile
:: (a ->Bool
) ->Traversal'
s a ->Fold
s a -- see notesdroppingWhile
:: (a ->Bool
) ->Lens'
s a ->Fold
s a -- see notesdroppingWhile
:: (a ->Bool
) ->Prism'
s a ->Fold
s a -- see notesdroppingWhile
:: (a ->Bool
) ->Iso'
s a ->Fold
s a -- see notes
droppingWhile
:: (a ->Bool
) ->IndexPreservingTraversal'
s a ->IndexPreservingFold
s a -- see notesdroppingWhile
:: (a ->Bool
) ->IndexPreservingLens'
s a ->IndexPreservingFold
s a -- see notesdroppingWhile
:: (a ->Bool
) ->IndexPreservingGetter
s a ->IndexPreservingFold
s adroppingWhile
:: (a ->Bool
) ->IndexPreservingFold
s a ->IndexPreservingFold
s a
droppingWhile
:: (a ->Bool
) ->IndexedTraversal'
i s a ->IndexedFold
i s a -- see notesdroppingWhile
:: (a ->Bool
) ->IndexedLens'
i s a ->IndexedFold
i s a -- see notesdroppingWhile
:: (a ->Bool
) ->IndexedGetter
i s a ->IndexedFold
i s adroppingWhile
:: (a ->Bool
) ->IndexedFold
i s a ->IndexedFold
i s a
Note: Many uses of this combinator will yield something that meets the types, but not the laws of a valid
Traversal
or
IndexedTraversal
. The
Traversal
and
IndexedTraversal
laws are only satisfied if the
new values you assign to the first target also does not pass the predicate! Otherwise subsequent traversals
will visit fewer elements and
Traversal
fusion is not sound.
So for any traversal
t
and predicate
p
,
may not be lawful, but
droppingWhile
p t
(
is. For example:
dropping
1 .
droppingWhile
p) t
>>>
let l :: Traversal' [Int] Int; l = droppingWhile (<= 1) traverse
>>>
let l' :: Traversal' [Int] Int; l' = dropping 1 l
l
is not a lawful setter because
:
over
l f .
over
l g ≢
over
l (f . g)
>>>
[1,2,3] & l .~ 0 & l .~ 4
[1,0,0]>>>
[1,2,3] & l .~ 4
[1,4,4]
l'
on the other hand behaves lawfully:
>>>
[1,2,3] & l' .~ 0 & l' .~ 4
[1,2,4]>>>
[1,2,3] & l' .~ 4
[1,2,4]
worded :: Applicative f => IndexedLensLike' Int f String String Source #
A
Fold
over the individual
words
of a
String
.
worded
::Fold
String
String
worded
::Traversal'
String
String
worded
::IndexedFold
Int
String
String
worded
::IndexedTraversal'
Int
String
String
Note: This function type-checks as a
Traversal
but it doesn't satisfy the laws. It's only valid to use it
when you don't insert any whitespace characters while traversing, and if your original
String
contains only
isolated space characters (and no other characters that count as space, such as non-breaking spaces).
lined :: Applicative f => IndexedLensLike' Int f String String Source #
A
Fold
over the individual
lines
of a
String
.
lined
::Fold
String
String
lined
::Traversal'
String
String
lined
::IndexedFold
Int
String
String
lined
::IndexedTraversal'
Int
String
String
Note: This function type-checks as a
Traversal
but it doesn't satisfy the laws. It's only valid to use it
when you don't insert any newline characters while traversing, and if your original
String
contains only
isolated newline characters.
foldMapOf :: Getting r s a -> (a -> r) -> s -> r Source #
Map each part of a structure viewed through a
Lens
,
Getter
,
Fold
or
Traversal
to a monoid and combine the results.
>>>
foldMapOf (folded . both . _Just) Sum [(Just 21, Just 21)]
Sum {getSum = 42}
foldMap
=foldMapOf
folded
foldMapOf
≡views
ifoldMapOf
l =foldMapOf
l.
Indexed
foldMapOf
::Getter
s a -> (a -> r) -> s -> rfoldMapOf
::Monoid
r =>Fold
s a -> (a -> r) -> s -> rfoldMapOf
::Semigroup
r =>Fold1
s a -> (a -> r) -> s -> rfoldMapOf
::Lens'
s a -> (a -> r) -> s -> rfoldMapOf
::Iso'
s a -> (a -> r) -> s -> rfoldMapOf
::Monoid
r =>Traversal'
s a -> (a -> r) -> s -> rfoldMapOf
::Semigroup
r =>Traversal1'
s a -> (a -> r) -> s -> rfoldMapOf
::Monoid
r =>Prism'
s a -> (a -> r) -> s -> r
foldMapOf
::Getting
r s a -> (a -> r) -> s -> r
foldOf :: Getting a s a -> s -> a Source #
Combine the elements of a structure viewed through a
Lens
,
Getter
,
Fold
or
Traversal
using a monoid.
>>>
foldOf (folded.folded) [[Sum 1,Sum 4],[Sum 8, Sum 8],[Sum 21]]
Sum {getSum = 42}
fold
=foldOf
folded
foldOf
≡view
foldOf
::Getter
s m -> s -> mfoldOf
::Monoid
m =>Fold
s m -> s -> mfoldOf
::Lens'
s m -> s -> mfoldOf
::Iso'
s m -> s -> mfoldOf
::Monoid
m =>Traversal'
s m -> s -> mfoldOf
::Monoid
m =>Prism'
s m -> s -> m
foldrOf :: Getting ( Endo r) s a -> (a -> r -> r) -> r -> s -> r Source #
Right-associative fold of parts of a structure that are viewed through a
Lens
,
Getter
,
Fold
or
Traversal
.
foldr
≡foldrOf
folded
foldrOf
::Getter
s a -> (a -> r -> r) -> r -> s -> rfoldrOf
::Fold
s a -> (a -> r -> r) -> r -> s -> rfoldrOf
::Lens'
s a -> (a -> r -> r) -> r -> s -> rfoldrOf
::Iso'
s a -> (a -> r -> r) -> r -> s -> rfoldrOf
::Traversal'
s a -> (a -> r -> r) -> r -> s -> rfoldrOf
::Prism'
s a -> (a -> r -> r) -> r -> s -> r
ifoldrOf
l ≡foldrOf
l.
Indexed
foldrOf
::Getting
(Endo
r) s a -> (a -> r -> r) -> r -> s -> r
foldlOf :: Getting ( Dual ( Endo r)) s a -> (r -> a -> r) -> r -> s -> r Source #
Left-associative fold of the parts of a structure that are viewed through a
Lens
,
Getter
,
Fold
or
Traversal
.
foldl
≡foldlOf
folded
foldlOf
::Getter
s a -> (r -> a -> r) -> r -> s -> rfoldlOf
::Fold
s a -> (r -> a -> r) -> r -> s -> rfoldlOf
::Lens'
s a -> (r -> a -> r) -> r -> s -> rfoldlOf
::Iso'
s a -> (r -> a -> r) -> r -> s -> rfoldlOf
::Traversal'
s a -> (r -> a -> r) -> r -> s -> rfoldlOf
::Prism'
s a -> (r -> a -> r) -> r -> s -> r
toNonEmptyOf :: Getting ( NonEmptyDList a) s a -> s -> NonEmpty a Source #
Extract a
NonEmpty
of the targets of
Fold1
.
>>>
toNonEmptyOf both1 ("hello", "world")
"hello" :| ["world"]
toNonEmptyOf
::Getter
s a -> s -> NonEmpty atoNonEmptyOf
::Fold1
s a -> s -> NonEmpty atoNonEmptyOf
::Lens'
s a -> s -> NonEmpty atoNonEmptyOf
::Iso'
s a -> s -> NonEmpty atoNonEmptyOf
::Traversal1'
s a -> s -> NonEmpty atoNonEmptyOf
::Prism'
s a -> s -> NonEmpty a
andOf :: Getting All s Bool -> s -> Bool Source #
Returns
True
if every target of a
Fold
is
True
.
>>>
andOf both (True,False)
False>>>
andOf both (True,True)
True
and
≡andOf
folded
andOf
::Getter
sBool
-> s ->Bool
andOf
::Fold
sBool
-> s ->Bool
andOf
::Lens'
sBool
-> s ->Bool
andOf
::Iso'
sBool
-> s ->Bool
andOf
::Traversal'
sBool
-> s ->Bool
andOf
::Prism'
sBool
-> s ->Bool
orOf :: Getting Any s Bool -> s -> Bool Source #
Returns
True
if any target of a
Fold
is
True
.
>>>
orOf both (True,False)
True>>>
orOf both (False,False)
False
or
≡orOf
folded
orOf
::Getter
sBool
-> s ->Bool
orOf
::Fold
sBool
-> s ->Bool
orOf
::Lens'
sBool
-> s ->Bool
orOf
::Iso'
sBool
-> s ->Bool
orOf
::Traversal'
sBool
-> s ->Bool
orOf
::Prism'
sBool
-> s ->Bool
anyOf :: Getting Any s a -> (a -> Bool ) -> s -> Bool Source #
Returns
True
if any target of a
Fold
satisfies a predicate.
>>>
anyOf both (=='x') ('x','y')
True>>>
import Data.Data.Lens
>>>
anyOf biplate (== "world") (((),2::Int),"hello",("world",11::Int))
True
any
≡anyOf
folded
ianyOf
l ≡anyOf
l.
Indexed
anyOf
::Getter
s a -> (a ->Bool
) -> s ->Bool
anyOf
::Fold
s a -> (a ->Bool
) -> s ->Bool
anyOf
::Lens'
s a -> (a ->Bool
) -> s ->Bool
anyOf
::Iso'
s a -> (a ->Bool
) -> s ->Bool
anyOf
::Traversal'
s a -> (a ->Bool
) -> s ->Bool
anyOf
::Prism'
s a -> (a ->Bool
) -> s ->Bool
allOf :: Getting All s a -> (a -> Bool ) -> s -> Bool Source #
Returns
True
if every target of a
Fold
satisfies a predicate.
>>>
allOf both (>=3) (4,5)
True>>>
allOf folded (>=2) [1..10]
False
all
≡allOf
folded
iallOf
l =allOf
l.
Indexed
allOf
::Getter
s a -> (a ->Bool
) -> s ->Bool
allOf
::Fold
s a -> (a ->Bool
) -> s ->Bool
allOf
::Lens'
s a -> (a ->Bool
) -> s ->Bool
allOf
::Iso'
s a -> (a ->Bool
) -> s ->Bool
allOf
::Traversal'
s a -> (a ->Bool
) -> s ->Bool
allOf
::Prism'
s a -> (a ->Bool
) -> s ->Bool
noneOf :: Getting Any s a -> (a -> Bool ) -> s -> Bool Source #
Returns
True
only if no targets of a
Fold
satisfy a predicate.
>>>
noneOf each (is _Nothing) (Just 3, Just 4, Just 5)
True>>>
noneOf (folded.folded) (<10) [[13,99,20],[3,71,42]]
False
inoneOf
l =noneOf
l.
Indexed
noneOf
::Getter
s a -> (a ->Bool
) -> s ->Bool
noneOf
::Fold
s a -> (a ->Bool
) -> s ->Bool
noneOf
::Lens'
s a -> (a ->Bool
) -> s ->Bool
noneOf
::Iso'
s a -> (a ->Bool
) -> s ->Bool
noneOf
::Traversal'
s a -> (a ->Bool
) -> s ->Bool
noneOf
::Prism'
s a -> (a ->Bool
) -> s ->Bool
productOf :: Num a => Getting ( Endo ( Endo a)) s a -> s -> a Source #
Calculate the
Product
of every number targeted by a
Fold
.
>>>
productOf both (4,5)
20>>>
productOf folded [1,2,3,4,5]
120
product
≡productOf
folded
This operation may be more strict than you would expect. If you
want a lazier version use
ala
Product
.
foldMapOf
productOf
::Num
a =>Getter
s a -> s -> aproductOf
::Num
a =>Fold
s a -> s -> aproductOf
::Num
a =>Lens'
s a -> s -> aproductOf
::Num
a =>Iso'
s a -> s -> aproductOf
::Num
a =>Traversal'
s a -> s -> aproductOf
::Num
a =>Prism'
s a -> s -> a
sumOf :: Num a => Getting ( Endo ( Endo a)) s a -> s -> a Source #
Calculate the
Sum
of every number targeted by a
Fold
.
>>>
sumOf both (5,6)
11>>>
sumOf folded [1,2,3,4]
10>>>
sumOf (folded.both) [(1,2),(3,4)]
10>>>
import Data.Data.Lens
>>>
sumOf biplate [(1::Int,[]),(2,[(3::Int,4::Int)])] :: Int
10
sum
≡sumOf
folded
This operation may be more strict than you would expect. If you
want a lazier version use
ala
Sum
.
foldMapOf
sumOf
_1
::Num
a => (a, b) -> asumOf
(folded
.
_1
) :: (Foldable
f,Num
a) => f (a, b) -> a
sumOf
::Num
a =>Getter
s a -> s -> asumOf
::Num
a =>Fold
s a -> s -> asumOf
::Num
a =>Lens'
s a -> s -> asumOf
::Num
a =>Iso'
s a -> s -> asumOf
::Num
a =>Traversal'
s a -> s -> asumOf
::Num
a =>Prism'
s a -> s -> a
traverseOf_ :: Functor f => Getting ( Traversed r f) s a -> (a -> f r) -> s -> f () Source #
Traverse over all of the targets of a
Fold
(or
Getter
), computing an
Applicative
(or
Functor
)-based answer,
but unlike
traverseOf
do not construct a new structure.
traverseOf_
generalizes
traverse_
to work over any
Fold
.
When passed a
Getter
,
traverseOf_
can work over any
Functor
, but when passed a
Fold
,
traverseOf_
requires
an
Applicative
.
>>>
traverseOf_ both putStrLn ("hello","world")
hello world
traverse_
≡traverseOf_
folded
traverseOf_
_2
::Functor
f => (c -> f r) -> (d, c) -> f ()traverseOf_
_Left
::Applicative
f => (a -> f b) ->Either
a c -> f ()
itraverseOf_
l ≡traverseOf_
l.
Indexed
The rather specific signature of
traverseOf_
allows it to be used as if the signature was any of:
traverseOf_
::Functor
f =>Getter
s a -> (a -> f r) -> s -> f ()traverseOf_
::Applicative
f =>Fold
s a -> (a -> f r) -> s -> f ()traverseOf_
::Functor
f =>Lens'
s a -> (a -> f r) -> s -> f ()traverseOf_
::Functor
f =>Iso'
s a -> (a -> f r) -> s -> f ()traverseOf_
::Applicative
f =>Traversal'
s a -> (a -> f r) -> s -> f ()traverseOf_
::Applicative
f =>Prism'
s a -> (a -> f r) -> s -> f ()
forOf_ :: Functor f => Getting ( Traversed r f) s a -> s -> (a -> f r) -> f () Source #
Traverse over all of the targets of a
Fold
(or
Getter
), computing an
Applicative
(or
Functor
)-based answer,
but unlike
forOf
do not construct a new structure.
forOf_
generalizes
for_
to work over any
Fold
.
When passed a
Getter
,
forOf_
can work over any
Functor
, but when passed a
Fold
,
forOf_
requires
an
Applicative
.
for_
≡forOf_
folded
>>>
forOf_ both ("hello","world") putStrLn
hello world
The rather specific signature of
forOf_
allows it to be used as if the signature was any of:
iforOf_
l s ≡forOf_
l s.
Indexed
forOf_
::Functor
f =>Getter
s a -> s -> (a -> f r) -> f ()forOf_
::Applicative
f =>Fold
s a -> s -> (a -> f r) -> f ()forOf_
::Functor
f =>Lens'
s a -> s -> (a -> f r) -> f ()forOf_
::Functor
f =>Iso'
s a -> s -> (a -> f r) -> f ()forOf_
::Applicative
f =>Traversal'
s a -> s -> (a -> f r) -> f ()forOf_
::Applicative
f =>Prism'
s a -> s -> (a -> f r) -> f ()
sequenceAOf_ :: Functor f => Getting ( Traversed a f) s (f a) -> s -> f () Source #
Evaluate each action in observed by a
Fold
on a structure from left to right, ignoring the results.
sequenceA_
≡sequenceAOf_
folded
>>>
sequenceAOf_ both (putStrLn "hello",putStrLn "world")
hello world
sequenceAOf_
::Functor
f =>Getter
s (f a) -> s -> f ()sequenceAOf_
::Applicative
f =>Fold
s (f a) -> s -> f ()sequenceAOf_
::Functor
f =>Lens'
s (f a) -> s -> f ()sequenceAOf_
::Functor
f =>Iso'
s (f a) -> s -> f ()sequenceAOf_
::Applicative
f =>Traversal'
s (f a) -> s -> f ()sequenceAOf_
::Applicative
f =>Prism'
s (f a) -> s -> f ()
traverse1Of_ :: Functor f => Getting ( TraversedF r f) s a -> (a -> f r) -> s -> f () Source #
Traverse over all of the targets of a
Fold1
, computing an
Apply
based answer.
As long as you have
Applicative
or
Functor
effect you are better using
traverseOf_
.
The
traverse1Of_
is useful only when you have genuine
Apply
effect.
>>>
traverse1Of_ both1 (\ks -> Map.fromList [ (k, ()) | k <- ks ]) ("abc", "bcd")
fromList [('b',()),('c',())]
traverse1Of_
::Apply
f =>Fold1
s a -> (a -> f r) -> s -> f ()
Since: 4.16
for1Of_ :: Functor f => Getting ( TraversedF r f) s a -> s -> (a -> f r) -> f () Source #
See
forOf_
and
traverse1Of_
.
>>>
for1Of_ both1 ("abc", "bcd") (\ks -> Map.fromList [ (k, ()) | k <- ks ])
fromList [('b',()),('c',())]
for1Of_
::Apply
f =>Fold1
s a -> s -> (a -> f r) -> f ()
Since: 4.16
sequence1Of_ :: Functor f => Getting ( TraversedF a f) s (f a) -> s -> f () Source #
See
sequenceAOf_
and
traverse1Of_
.
sequence1Of_
::Apply
f =>Fold1
s (f a) -> s -> f ()
Since: 4.16
mapMOf_ :: Monad m => Getting ( Sequenced r m) s a -> (a -> m r) -> s -> m () Source #
Map each target of a
Fold
on a structure to a monadic action, evaluate these actions from left to right, and ignore the results.
>>>
mapMOf_ both putStrLn ("hello","world")
hello world
mapM_
≡mapMOf_
folded
mapMOf_
::Monad
m =>Getter
s a -> (a -> m r) -> s -> m ()mapMOf_
::Monad
m =>Fold
s a -> (a -> m r) -> s -> m ()mapMOf_
::Monad
m =>Lens'
s a -> (a -> m r) -> s -> m ()mapMOf_
::Monad
m =>Iso'
s a -> (a -> m r) -> s -> m ()mapMOf_
::Monad
m =>Traversal'
s a -> (a -> m r) -> s -> m ()mapMOf_
::Monad
m =>Prism'
s a -> (a -> m r) -> s -> m ()
forMOf_ :: Monad m => Getting ( Sequenced r m) s a -> s -> (a -> m r) -> m () Source #
forMOf_
is
mapMOf_
with two of its arguments flipped.
>>>
forMOf_ both ("hello","world") putStrLn
hello world
forM_
≡forMOf_
folded
forMOf_
::Monad
m =>Getter
s a -> s -> (a -> m r) -> m ()forMOf_
::Monad
m =>Fold
s a -> s -> (a -> m r) -> m ()forMOf_
::Monad
m =>Lens'
s a -> s -> (a -> m r) -> m ()forMOf_
::Monad
m =>Iso'
s a -> s -> (a -> m r) -> m ()forMOf_
::Monad
m =>Traversal'
s a -> s -> (a -> m r) -> m ()forMOf_
::Monad
m =>Prism'
s a -> s -> (a -> m r) -> m ()
sequenceOf_ :: Monad m => Getting ( Sequenced a m) s (m a) -> s -> m () Source #
Evaluate each monadic action referenced by a
Fold
on the structure from left to right, and ignore the results.
>>>
sequenceOf_ both (putStrLn "hello",putStrLn "world")
hello world
sequence_
≡sequenceOf_
folded
sequenceOf_
::Monad
m =>Getter
s (m a) -> s -> m ()sequenceOf_
::Monad
m =>Fold
s (m a) -> s -> m ()sequenceOf_
::Monad
m =>Lens'
s (m a) -> s -> m ()sequenceOf_
::Monad
m =>Iso'
s (m a) -> s -> m ()sequenceOf_
::Monad
m =>Traversal'
s (m a) -> s -> m ()sequenceOf_
::Monad
m =>Prism'
s (m a) -> s -> m ()
asumOf :: Alternative f => Getting ( Endo (f a)) s (f a) -> s -> f a Source #
The sum of a collection of actions, generalizing
concatOf
.
>>>
asumOf both ("hello","world")
"helloworld"
>>>
asumOf each (Nothing, Just "hello", Nothing)
Just "hello"
asum
≡asumOf
folded
asumOf
::Alternative
f =>Getter
s (f a) -> s -> f aasumOf
::Alternative
f =>Fold
s (f a) -> s -> f aasumOf
::Alternative
f =>Lens'
s (f a) -> s -> f aasumOf
::Alternative
f =>Iso'
s (f a) -> s -> f aasumOf
::Alternative
f =>Traversal'
s (f a) -> s -> f aasumOf
::Alternative
f =>Prism'
s (f a) -> s -> f a
msumOf :: MonadPlus m => Getting ( Endo (m a)) s (m a) -> s -> m a Source #
The sum of a collection of actions, generalizing
concatOf
.
>>>
msumOf both ("hello","world")
"helloworld"
>>>
msumOf each (Nothing, Just "hello", Nothing)
Just "hello"
msum
≡msumOf
folded
msumOf
::MonadPlus
m =>Getter
s (m a) -> s -> m amsumOf
::MonadPlus
m =>Fold
s (m a) -> s -> m amsumOf
::MonadPlus
m =>Lens'
s (m a) -> s -> m amsumOf
::MonadPlus
m =>Iso'
s (m a) -> s -> m amsumOf
::MonadPlus
m =>Traversal'
s (m a) -> s -> m amsumOf
::MonadPlus
m =>Prism'
s (m a) -> s -> m a
elemOf :: Eq a => Getting Any s a -> a -> s -> Bool Source #
Does the element occur anywhere within a given
Fold
of the structure?
>>>
elemOf both "hello" ("hello","world")
True
elem
≡elemOf
folded
elemOf
::Eq
a =>Getter
s a -> a -> s ->Bool
elemOf
::Eq
a =>Fold
s a -> a -> s ->Bool
elemOf
::Eq
a =>Lens'
s a -> a -> s ->Bool
elemOf
::Eq
a =>Iso'
s a -> a -> s ->Bool
elemOf
::Eq
a =>Traversal'
s a -> a -> s ->Bool
elemOf
::Eq
a =>Prism'
s a -> a -> s ->Bool
notElemOf :: Eq a => Getting All s a -> a -> s -> Bool Source #
Does the element not occur anywhere within a given
Fold
of the structure?
>>>
notElemOf each 'd' ('a','b','c')
True
>>>
notElemOf each 'a' ('a','b','c')
False
notElem
≡notElemOf
folded
notElemOf
::Eq
a =>Getter
s a -> a -> s ->Bool
notElemOf
::Eq
a =>Fold
s a -> a -> s ->Bool
notElemOf
::Eq
a =>Iso'
s a -> a -> s ->Bool
notElemOf
::Eq
a =>Lens'
s a -> a -> s ->Bool
notElemOf
::Eq
a =>Traversal'
s a -> a -> s ->Bool
notElemOf
::Eq
a =>Prism'
s a -> a -> s ->Bool
concatMapOf :: Getting [r] s a -> (a -> [r]) -> s -> [r] Source #
Map a function over all the targets of a
Fold
of a container and concatenate the resulting lists.
>>>
concatMapOf both (\x -> [x, x + 1]) (1,3)
[1,2,3,4]
concatMap
≡concatMapOf
folded
concatMapOf
::Getter
s a -> (a -> [r]) -> s -> [r]concatMapOf
::Fold
s a -> (a -> [r]) -> s -> [r]concatMapOf
::Lens'
s a -> (a -> [r]) -> s -> [r]concatMapOf
::Iso'
s a -> (a -> [r]) -> s -> [r]concatMapOf
::Traversal'
s a -> (a -> [r]) -> s -> [r]
concatOf :: Getting [r] s [r] -> s -> [r] Source #
Concatenate all of the lists targeted by a
Fold
into a longer list.
>>>
concatOf both ("pan","ama")
"panama"
concat
≡concatOf
folded
concatOf
≡view
concatOf
::Getter
s [r] -> s -> [r]concatOf
::Fold
s [r] -> s -> [r]concatOf
::Iso'
s [r] -> s -> [r]concatOf
::Lens'
s [r] -> s -> [r]concatOf
::Traversal'
s [r] -> s -> [r]
lengthOf :: Getting ( Endo ( Endo Int )) s a -> s -> Int Source #
Calculate the number of targets there are for a
Fold
in a given container.
Note:
This can be rather inefficient for large containers and just like
length
,
this will not terminate for infinite folds.
length
≡lengthOf
folded
>>>
lengthOf _1 ("hello",())
1
>>>
lengthOf traverse [1..10]
10
>>>
lengthOf (traverse.traverse) [[1,2],[3,4],[5,6]]
6
lengthOf
(folded
.
folded
) :: (Foldable
f,Foldable
g) => f (g a) ->Int
lengthOf
::Getter
s a -> s ->Int
lengthOf
::Fold
s a -> s ->Int
lengthOf
::Lens'
s a -> s ->Int
lengthOf
::Iso'
s a -> s ->Int
lengthOf
::Traversal'
s a -> s ->Int
firstOf :: Getting ( Leftmost a) s a -> s -> Maybe a Source #
Retrieve the
First
entry of a
Fold
or
Traversal
or retrieve
Just
the result
from a
Getter
or
Lens
.
The answer is computed in a manner that leaks space less than
or
preview
^?'
and gives you back access to the outermost
Just
constructor more quickly, but does so
in a way that builds an intermediate structure, and thus may have worse
constant factors. This also means that it can not be used in any
MonadReader
,
but must instead have
s
passed as its last argument, unlike
preview
.
Note: this could been named
headOf
.
>>>
firstOf traverse [1..10]
Just 1
>>>
firstOf both (1,2)
Just 1
>>>
firstOf ignored ()
Nothing
firstOf
::Getter
s a -> s ->Maybe
afirstOf
::Fold
s a -> s ->Maybe
afirstOf
::Lens'
s a -> s ->Maybe
afirstOf
::Iso'
s a -> s ->Maybe
afirstOf
::Traversal'
s a -> s ->Maybe
a
first1Of :: Getting ( First a) s a -> s -> a Source #
Retrieve the
First
entry of a
Fold1
or
Traversal1
or the result from a
Getter
or
Lens
.
>>>
first1Of traverse1 (1 :| [2..10])
1
>>>
first1Of both1 (1,2)
1
Note:
this is different from
^.
.
>>>
first1Of traverse1 ([1,2] :| [[3,4],[5,6]])
[1,2]
>>>
([1,2] :| [[3,4],[5,6]]) ^. traverse1
[1,2,3,4,5,6]
first1Of
::Getter
s a -> s -> afirst1Of
::Fold1
s a -> s -> afirst1Of
::Lens'
s a -> s -> afirst1Of
::Iso'
s a -> s -> afirst1Of
::Traversal1'
s a -> s -> a
lastOf :: Getting ( Rightmost a) s a -> s -> Maybe a Source #
Retrieve the
Last
entry of a
Fold
or
Traversal
or retrieve
Just
the result
from a
Getter
or
Lens
.
The answer is computed in a manner that leaks space less than
and gives you back access to the outermost
ala
Last
.
foldMapOf
Just
constructor more quickly, but may have worse
constant factors.
>>>
lastOf traverse [1..10]
Just 10
>>>
lastOf both (1,2)
Just 2
>>>
lastOf ignored ()
Nothing
lastOf
::Getter
s a -> s ->Maybe
alastOf
::Fold
s a -> s ->Maybe
alastOf
::Lens'
s a -> s ->Maybe
alastOf
::Iso'
s a -> s ->Maybe
alastOf
::Traversal'
s a -> s ->Maybe
a
last1Of :: Getting ( Last a) s a -> s -> a Source #
Retrieve the
Last
entry of a
Fold1
or
Traversal1
or retrieve the result
from a
Getter
or
Lens
.o
>>>
last1Of traverse1 (1 :| [2..10])
10
>>>
last1Of both1 (1,2)
2
last1Of
::Getter
s a -> s ->Maybe
alast1Of
::Fold1
s a -> s ->Maybe
alast1Of
::Lens'
s a -> s ->Maybe
alast1Of
::Iso'
s a -> s ->Maybe
alast1Of
::Traversal1'
s a -> s ->Maybe
a
nullOf :: Getting All s a -> s -> Bool Source #
Returns
True
if this
Fold
or
Traversal
has no targets in the given container.
Note:
nullOf
on a valid
Iso
,
Lens
or
Getter
should always return
False
.
null
≡nullOf
folded
This may be rather inefficient compared to the
null
check of many containers.
>>>
nullOf _1 (1,2)
False
>>>
nullOf ignored ()
True
>>>
nullOf traverse []
True
>>>
nullOf (element 20) [1..10]
True
nullOf
(folded
.
_1
.
folded
) :: (Foldable
f,Foldable
g) => f (g a, b) ->Bool
nullOf
::Getter
s a -> s ->Bool
nullOf
::Fold
s a -> s ->Bool
nullOf
::Iso'
s a -> s ->Bool
nullOf
::Lens'
s a -> s ->Bool
nullOf
::Traversal'
s a -> s ->Bool
notNullOf :: Getting Any s a -> s -> Bool Source #
Returns
True
if this
Fold
or
Traversal
has any targets in the given container.
A more "conversational" alias for this combinator is
has
.
Note:
notNullOf
on a valid
Iso
,
Lens
or
Getter
should always return
True
.
not
.
null
≡notNullOf
folded
This may be rather inefficient compared to the
check of many containers.
not
.
null
>>>
notNullOf _1 (1,2)
True
>>>
notNullOf traverse [1..10]
True
>>>
notNullOf folded []
False
>>>
notNullOf (element 20) [1..10]
False
notNullOf
(folded
.
_1
.
folded
) :: (Foldable
f,Foldable
g) => f (g a, b) ->Bool
notNullOf
::Getter
s a -> s ->Bool
notNullOf
::Fold
s a -> s ->Bool
notNullOf
::Iso'
s a -> s ->Bool
notNullOf
::Lens'
s a -> s ->Bool
notNullOf
::Traversal'
s a -> s ->Bool
maximumOf :: Ord a => Getting ( Endo ( Endo ( Maybe a))) s a -> s -> Maybe a Source #
Obtain the maximum element (if any) targeted by a
Fold
or
Traversal
safely.
Note:
maximumOf
on a valid
Iso
,
Lens
or
Getter
will always return
Just
a value.
>>>
maximumOf traverse [1..10]
Just 10
>>>
maximumOf traverse []
Nothing
>>>
maximumOf (folded.filtered even) [1,4,3,6,7,9,2]
Just 6
maximum
≡fromMaybe
(error
"empty").
maximumOf
folded
In the interest of efficiency, This operation has semantics more strict than strictly necessary.
has lazier semantics but could leak memory.
rmap
getMax
(
foldMapOf
l
Max
)
maximumOf
::Ord
a =>Getter
s a -> s ->Maybe
amaximumOf
::Ord
a =>Fold
s a -> s ->Maybe
amaximumOf
::Ord
a =>Iso'
s a -> s ->Maybe
amaximumOf
::Ord
a =>Lens'
s a -> s ->Maybe
amaximumOf
::Ord
a =>Traversal'
s a -> s ->Maybe
a
maximum1Of :: Ord a => Getting ( Max a) s a -> s -> a Source #
Obtain the maximum element targeted by a
Fold1
or
Traversal1
.
>>>
maximum1Of traverse1 (1 :| [2..10])
10
maximum1Of
::Ord
a =>Getter
s a -> s -> amaximum1Of
::Ord
a =>Fold1
s a -> s -> amaximum1Of
::Ord
a =>Iso'
s a -> s -> amaximum1Of
::Ord
a =>Lens'
s a -> s -> amaximum1Of
::Ord
a =>Traversal1'
s a -> s -> a
minimumOf :: Ord a => Getting ( Endo ( Endo ( Maybe a))) s a -> s -> Maybe a Source #
Obtain the minimum element (if any) targeted by a
Fold
or
Traversal
safely.
Note:
minimumOf
on a valid
Iso
,
Lens
or
Getter
will always return
Just
a value.
>>>
minimumOf traverse [1..10]
Just 1
>>>
minimumOf traverse []
Nothing
>>>
minimumOf (folded.filtered even) [1,4,3,6,7,9,2]
Just 2
minimum
≡fromMaybe
(error
"empty").
minimumOf
folded
In the interest of efficiency, This operation has semantics more strict than strictly necessary.
has lazier semantics but could leak memory.
rmap
getMin
(
foldMapOf
l
Min
)
minimumOf
::Ord
a =>Getter
s a -> s ->Maybe
aminimumOf
::Ord
a =>Fold
s a -> s ->Maybe
aminimumOf
::Ord
a =>Iso'
s a -> s ->Maybe
aminimumOf
::Ord
a =>Lens'
s a -> s ->Maybe
aminimumOf
::Ord
a =>Traversal'
s a -> s ->Maybe
a
minimum1Of :: Ord a => Getting ( Min a) s a -> s -> a Source #
Obtain the minimum element targeted by a
Fold1
or
Traversal1
.
>>>
minimum1Of traverse1 (1 :| [2..10])
1
minimum1Of
::Ord
a =>Getter
s a -> s -> aminimum1Of
::Ord
a =>Fold1
s a -> s -> aminimum1Of
::Ord
a =>Iso'
s a -> s -> aminimum1Of
::Ord
a =>Lens'
s a -> s -> aminimum1Of
::Ord
a =>Traversal1'
s a -> s -> a
maximumByOf :: Getting ( Endo ( Endo ( Maybe a))) s a -> (a -> a -> Ordering ) -> s -> Maybe a Source #
Obtain the maximum element (if any) targeted by a
Fold
,
Traversal
,
Lens
,
Iso
,
or
Getter
according to a user supplied
Ordering
.
>>>
maximumByOf traverse (compare `on` length) ["mustard","relish","ham"]
Just "mustard"
In the interest of efficiency, This operation has semantics more strict than strictly necessary.
maximumBy
cmp ≡fromMaybe
(error
"empty").
maximumByOf
folded
cmp
maximumByOf
::Getter
s a -> (a -> a ->Ordering
) -> s ->Maybe
amaximumByOf
::Fold
s a -> (a -> a ->Ordering
) -> s ->Maybe
amaximumByOf
::Iso'
s a -> (a -> a ->Ordering
) -> s ->Maybe
amaximumByOf
::Lens'
s a -> (a -> a ->Ordering
) -> s ->Maybe
amaximumByOf
::Traversal'
s a -> (a -> a ->Ordering
) -> s ->Maybe
a
minimumByOf :: Getting ( Endo ( Endo ( Maybe a))) s a -> (a -> a -> Ordering ) -> s -> Maybe a Source #
Obtain the minimum element (if any) targeted by a
Fold
,
Traversal
,
Lens
,
Iso
or
Getter
according to a user supplied
Ordering
.
In the interest of efficiency, This operation has semantics more strict than strictly necessary.
>>>
minimumByOf traverse (compare `on` length) ["mustard","relish","ham"]
Just "ham"
minimumBy
cmp ≡fromMaybe
(error
"empty").
minimumByOf
folded
cmp
minimumByOf
::Getter
s a -> (a -> a ->Ordering
) -> s ->Maybe
aminimumByOf
::Fold
s a -> (a -> a ->Ordering
) -> s ->Maybe
aminimumByOf
::Iso'
s a -> (a -> a ->Ordering
) -> s ->Maybe
aminimumByOf
::Lens'
s a -> (a -> a ->Ordering
) -> s ->Maybe
aminimumByOf
::Traversal'
s a -> (a -> a ->Ordering
) -> s ->Maybe
a
findOf :: Getting ( Endo ( Maybe a)) s a -> (a -> Bool ) -> s -> Maybe a Source #
The
findOf
function takes a
Lens
(or
Getter
,
Iso
,
Fold
, or
Traversal
),
a predicate and a structure and returns the leftmost element of the structure
matching the predicate, or
Nothing
if there is no such element.
>>>
findOf each even (1,3,4,6)
Just 4
>>>
findOf folded even [1,3,5,7]
Nothing
findOf
::Getter
s a -> (a ->Bool
) -> s ->Maybe
afindOf
::Fold
s a -> (a ->Bool
) -> s ->Maybe
afindOf
::Iso'
s a -> (a ->Bool
) -> s ->Maybe
afindOf
::Lens'
s a -> (a ->Bool
) -> s ->Maybe
afindOf
::Traversal'
s a -> (a ->Bool
) -> s ->Maybe
a
find
≡findOf
folded
ifindOf
l ≡findOf
l.
Indexed
A simpler version that didn't permit indexing, would be:
findOf
::Getting
(Endo
(Maybe
a)) s a -> (a ->Bool
) -> s ->Maybe
afindOf
l p =foldrOf
l (a y -> if p a thenJust
a else y)Nothing
findMOf :: Monad m => Getting ( Endo (m ( Maybe a))) s a -> (a -> m Bool ) -> s -> m ( Maybe a) Source #
The
findMOf
function takes a
Lens
(or
Getter
,
Iso
,
Fold
, or
Traversal
),
a monadic predicate and a structure and returns in the monad the leftmost element of the structure
matching the predicate, or
Nothing
if there is no such element.
>>>
findMOf each ( \x -> print ("Checking " ++ show x) >> return (even x)) (1,3,4,6)
"Checking 1" "Checking 3" "Checking 4" Just 4
>>>
findMOf each ( \x -> print ("Checking " ++ show x) >> return (even x)) (1,3,5,7)
"Checking 1" "Checking 3" "Checking 5" "Checking 7" Nothing
findMOf
:: (Monad
m,Getter
s a) -> (a -> mBool
) -> s -> m (Maybe
a)findMOf
:: (Monad
m,Fold
s a) -> (a -> mBool
) -> s -> m (Maybe
a)findMOf
:: (Monad
m,Iso'
s a) -> (a -> mBool
) -> s -> m (Maybe
a)findMOf
:: (Monad
m,Lens'
s a) -> (a -> mBool
) -> s -> m (Maybe
a)findMOf
:: (Monad
m,Traversal'
s a) -> (a -> mBool
) -> s -> m (Maybe
a)
findMOf
folded
:: (Monad m, Foldable f) => (a -> m Bool) -> f a -> m (Maybe a)ifindMOf
l ≡findMOf
l.
Indexed
A simpler version that didn't permit indexing, would be:
findMOf
:: Monad m =>Getting
(Endo
(m (Maybe
a))) s a -> (a -> mBool
) -> s -> m (Maybe
a)findMOf
l p =foldrOf
l (a y -> p a >>= x -> if x then return (Just
a) else y) $ returnNothing
lookupOf :: Eq k => Getting ( Endo ( Maybe v)) s (k, v) -> k -> s -> Maybe v Source #
The
lookupOf
function takes a
Fold
(or
Getter
,
Traversal
,
Lens
,
Iso
, etc.), a key, and a structure containing key/value pairs.
It returns the first value corresponding to the given key. This function
generalizes
lookup
to work on an arbitrary
Fold
instead of lists.
>>>
lookupOf folded 4 [(2, 'a'), (4, 'b'), (4, 'c')]
Just 'b'
>>>
lookupOf each 2 [(2, 'a'), (4, 'b'), (4, 'c')]
Just 'a'
lookupOf
::Eq
k =>Fold
s (k,v) -> k -> s ->Maybe
v
foldr1Of :: HasCallStack => Getting ( Endo ( Maybe a)) s a -> (a -> a -> a) -> s -> a Source #
A variant of
foldrOf
that has no base case and thus may only be applied
to lenses and structures such that the
Lens
views at least one element of
the structure.
>>>
foldr1Of each (+) (1,2,3,4)
10
foldr1Of
l f ≡foldr1
f.
toListOf
lfoldr1
≡foldr1Of
folded
foldr1Of
::Getter
s a -> (a -> a -> a) -> s -> afoldr1Of
::Fold
s a -> (a -> a -> a) -> s -> afoldr1Of
::Iso'
s a -> (a -> a -> a) -> s -> afoldr1Of
::Lens'
s a -> (a -> a -> a) -> s -> afoldr1Of
::Traversal'
s a -> (a -> a -> a) -> s -> a
foldl1Of :: HasCallStack => Getting ( Dual ( Endo ( Maybe a))) s a -> (a -> a -> a) -> s -> a Source #
A variant of
foldlOf
that has no base case and thus may only be applied to lenses and structures such
that the
Lens
views at least one element of the structure.
>>>
foldl1Of each (+) (1,2,3,4)
10
foldl1Of
l f ≡foldl1
f.
toListOf
lfoldl1
≡foldl1Of
folded
foldl1Of
::Getter
s a -> (a -> a -> a) -> s -> afoldl1Of
::Fold
s a -> (a -> a -> a) -> s -> afoldl1Of
::Iso'
s a -> (a -> a -> a) -> s -> afoldl1Of
::Lens'
s a -> (a -> a -> a) -> s -> afoldl1Of
::Traversal'
s a -> (a -> a -> a) -> s -> a
foldrOf' :: Getting ( Dual ( Endo ( Endo r))) s a -> (a -> r -> r) -> r -> s -> r Source #
Strictly fold right over the elements of a structure.
foldr'
≡foldrOf'
folded
foldrOf'
::Getter
s a -> (a -> r -> r) -> r -> s -> rfoldrOf'
::Fold
s a -> (a -> r -> r) -> r -> s -> rfoldrOf'
::Iso'
s a -> (a -> r -> r) -> r -> s -> rfoldrOf'
::Lens'
s a -> (a -> r -> r) -> r -> s -> rfoldrOf'
::Traversal'
s a -> (a -> r -> r) -> r -> s -> r
foldlOf' :: Getting ( Endo ( Endo r)) s a -> (r -> a -> r) -> r -> s -> r Source #
Fold over the elements of a structure, associating to the left, but strictly.
foldl'
≡foldlOf'
folded
foldlOf'
::Getter
s a -> (r -> a -> r) -> r -> s -> rfoldlOf'
::Fold
s a -> (r -> a -> r) -> r -> s -> rfoldlOf'
::Iso'
s a -> (r -> a -> r) -> r -> s -> rfoldlOf'
::Lens'
s a -> (r -> a -> r) -> r -> s -> rfoldlOf'
::Traversal'
s a -> (r -> a -> r) -> r -> s -> r
foldr1Of' :: HasCallStack => Getting ( Dual ( Endo ( Endo ( Maybe a)))) s a -> (a -> a -> a) -> s -> a Source #
A variant of
foldrOf'
that has no base case and thus may only be applied
to folds and structures such that the fold views at least one element of the
structure.
foldr1Of
l f ≡foldr1
f.
toListOf
l
foldr1Of'
::Getter
s a -> (a -> a -> a) -> s -> afoldr1Of'
::Fold
s a -> (a -> a -> a) -> s -> afoldr1Of'
::Iso'
s a -> (a -> a -> a) -> s -> afoldr1Of'
::Lens'
s a -> (a -> a -> a) -> s -> afoldr1Of'
::Traversal'
s a -> (a -> a -> a) -> s -> a
foldl1Of' :: HasCallStack => Getting ( Endo ( Endo ( Maybe a))) s a -> (a -> a -> a) -> s -> a Source #
A variant of
foldlOf'
that has no base case and thus may only be applied
to folds and structures such that the fold views at least one element of
the structure.
foldl1Of'
l f ≡foldl1'
f.
toListOf
l
foldl1Of'
::Getter
s a -> (a -> a -> a) -> s -> afoldl1Of'
::Fold
s a -> (a -> a -> a) -> s -> afoldl1Of'
::Iso'
s a -> (a -> a -> a) -> s -> afoldl1Of'
::Lens'
s a -> (a -> a -> a) -> s -> afoldl1Of'
::Traversal'
s a -> (a -> a -> a) -> s -> a
foldrMOf :: Monad m => Getting ( Dual ( Endo (r -> m r))) s a -> (a -> r -> m r) -> r -> s -> m r Source #
Monadic fold over the elements of a structure, associating to the right, i.e. from right to left.
foldrM
≡foldrMOf
folded
foldrMOf
::Monad
m =>Getter
s a -> (a -> r -> m r) -> r -> s -> m rfoldrMOf
::Monad
m =>Fold
s a -> (a -> r -> m r) -> r -> s -> m rfoldrMOf
::Monad
m =>Iso'
s a -> (a -> r -> m r) -> r -> s -> m rfoldrMOf
::Monad
m =>Lens'
s a -> (a -> r -> m r) -> r -> s -> m rfoldrMOf
::Monad
m =>Traversal'
s a -> (a -> r -> m r) -> r -> s -> m r
foldlMOf :: Monad m => Getting ( Endo (r -> m r)) s a -> (r -> a -> m r) -> r -> s -> m r Source #
Monadic fold over the elements of a structure, associating to the left, i.e. from left to right.
foldlM
≡foldlMOf
folded
foldlMOf
::Monad
m =>Getter
s a -> (r -> a -> m r) -> r -> s -> m rfoldlMOf
::Monad
m =>Fold
s a -> (r -> a -> m r) -> r -> s -> m rfoldlMOf
::Monad
m =>Iso'
s a -> (r -> a -> m r) -> r -> s -> m rfoldlMOf
::Monad
m =>Lens'
s a -> (r -> a -> m r) -> r -> s -> m rfoldlMOf
::Monad
m =>Traversal'
s a -> (r -> a -> m r) -> r -> s -> m r
has :: Getting Any s a -> s -> Bool Source #
Check to see if this
Fold
or
Traversal
matches 1 or more entries.
>>>
has (element 0) []
False
>>>
has _Left (Left 12)
True
>>>
has _Right (Left 12)
False
This will always return
True
for a
Lens
or
Getter
.
>>>
has _1 ("hello","world")
True
has
::Getter
s a -> s ->Bool
has
::Fold
s a -> s ->Bool
has
::Iso'
s a -> s ->Bool
has
::Lens'
s a -> s ->Bool
has
::Traversal'
s a -> s ->Bool
pre :: Getting ( First a) s a -> IndexPreservingGetter s ( Maybe a) Source #
This converts a
Fold
to a
IndexPreservingGetter
that returns the first element, if it
exists, as a
Maybe
.
pre
::Getter
s a ->IndexPreservingGetter
s (Maybe
a)pre
::Fold
s a ->IndexPreservingGetter
s (Maybe
a)pre
::Traversal'
s a ->IndexPreservingGetter
s (Maybe
a)pre
::Lens'
s a ->IndexPreservingGetter
s (Maybe
a)pre
::Iso'
s a ->IndexPreservingGetter
s (Maybe
a)pre
::Prism'
s a ->IndexPreservingGetter
s (Maybe
a)
ipre :: IndexedGetting i ( First (i, a)) s a -> IndexPreservingGetter s ( Maybe (i, a)) Source #
This converts an
IndexedFold
to an
IndexPreservingGetter
that returns the first index
and element, if they exist, as a
Maybe
.
ipre
::IndexedGetter
i s a ->IndexPreservingGetter
s (Maybe
(i, a))ipre
::IndexedFold
i s a ->IndexPreservingGetter
s (Maybe
(i, a))ipre
::IndexedTraversal'
i s a ->IndexPreservingGetter
s (Maybe
(i, a))ipre
::IndexedLens'
i s a ->IndexPreservingGetter
s (Maybe
(i, a))
preview :: MonadReader s m => Getting ( First a) s a -> m ( Maybe a) Source #
Retrieve the first value targeted by a
Fold
or
Traversal
(or
Just
the result
from a
Getter
or
Lens
). See also
firstOf
and
^?
, which are similar with
some subtle differences (explained below).
listToMaybe
.
toList
≡preview
folded
preview
=view
.
pre
Unlike
^?
, this function uses a
MonadReader
to read the value to be focused in on.
This allows one to pass the value as the last argument by using the
MonadReader
instance for
(->) s
However, it may also be used as part of some deeply nested transformer stack.
preview
uses a monoidal value to obtain the result.
This means that it generally has good performance, but can occasionally cause space leaks
or even stack overflows on some data types.
There is another function,
firstOf
, which avoids these issues at the cost of
a slight constant performance cost and a little less flexibility.
It may be helpful to think of
preview
as having one of the following
more specialized types:
preview
::Getter
s a -> s ->Maybe
apreview
::Fold
s a -> s ->Maybe
apreview
::Lens'
s a -> s ->Maybe
apreview
::Iso'
s a -> s ->Maybe
apreview
::Traversal'
s a -> s ->Maybe
a
preview
::MonadReader
s m =>Getter
s a -> m (Maybe
a)preview
::MonadReader
s m =>Fold
s a -> m (Maybe
a)preview
::MonadReader
s m =>Lens'
s a -> m (Maybe
a)preview
::MonadReader
s m =>Iso'
s a -> m (Maybe
a)preview
::MonadReader
s m =>Traversal'
s a -> m (Maybe
a)
ipreview :: MonadReader s m => IndexedGetting i ( First (i, a)) s a -> m ( Maybe (i, a)) Source #
Retrieve the first index and value targeted by a
Fold
or
Traversal
(or
Just
the result
from a
Getter
or
Lens
). See also (
^@?
).
ipreview
=view
.
ipre
This is usually applied in the
Reader
Monad
(->) s
.
ipreview
::IndexedGetter
i s a -> s ->Maybe
(i, a)ipreview
::IndexedFold
i s a -> s ->Maybe
(i, a)ipreview
::IndexedLens'
i s a -> s ->Maybe
(i, a)ipreview
::IndexedTraversal'
i s a -> s ->Maybe
(i, a)
However, it may be useful to think of its full generality when working with
a
Monad
transformer stack:
ipreview
::MonadReader
s m =>IndexedGetter
s a -> m (Maybe
(i, a))ipreview
::MonadReader
s m =>IndexedFold
s a -> m (Maybe
(i, a))ipreview
::MonadReader
s m =>IndexedLens'
s a -> m (Maybe
(i, a))ipreview
::MonadReader
s m =>IndexedTraversal'
s a -> m (Maybe
(i, a))
ipreviews :: MonadReader s m => IndexedGetting i ( First r) s a -> (i -> a -> r) -> m ( Maybe r) Source #
Retrieve a function of the first index and value targeted by an
IndexedFold
or
IndexedTraversal
(or
Just
the result from an
IndexedGetter
or
IndexedLens
).
See also (
^@?
).
ipreviews
=views
.
ipre
This is usually applied in the
Reader
Monad
(->) s
.
ipreviews
::IndexedGetter
i s a -> (i -> a -> r) -> s ->Maybe
ripreviews
::IndexedFold
i s a -> (i -> a -> r) -> s ->Maybe
ripreviews
::IndexedLens'
i s a -> (i -> a -> r) -> s ->Maybe
ripreviews
::IndexedTraversal'
i s a -> (i -> a -> r) -> s ->Maybe
r
However, it may be useful to think of its full generality when working with
a
Monad
transformer stack:
ipreviews
::MonadReader
s m =>IndexedGetter
i s a -> (i -> a -> r) -> m (Maybe
r)ipreviews
::MonadReader
s m =>IndexedFold
i s a -> (i -> a -> r) -> m (Maybe
r)ipreviews
::MonadReader
s m =>IndexedLens'
i s a -> (i -> a -> r) -> m (Maybe
r)ipreviews
::MonadReader
s m =>IndexedTraversal'
i s a -> (i -> a -> r) -> m (Maybe
r)
preuse :: MonadState s m => Getting ( First a) s a -> m ( Maybe a) Source #
Retrieve the first value targeted by a
Fold
or
Traversal
(or
Just
the result
from a
Getter
or
Lens
) into the current state.
preuse
=use
.
pre
preuse
::MonadState
s m =>Getter
s a -> m (Maybe
a)preuse
::MonadState
s m =>Fold
s a -> m (Maybe
a)preuse
::MonadState
s m =>Lens'
s a -> m (Maybe
a)preuse
::MonadState
s m =>Iso'
s a -> m (Maybe
a)preuse
::MonadState
s m =>Traversal'
s a -> m (Maybe
a)
ipreuse :: MonadState s m => IndexedGetting i ( First (i, a)) s a -> m ( Maybe (i, a)) Source #
Retrieve the first index and value targeted by an
IndexedFold
or
IndexedTraversal
(or
Just
the index
and result from an
IndexedGetter
or
IndexedLens
) into the current state.
ipreuse
=use
.
ipre
ipreuse
::MonadState
s m =>IndexedGetter
i s a -> m (Maybe
(i, a))ipreuse
::MonadState
s m =>IndexedFold
i s a -> m (Maybe
(i, a))ipreuse
::MonadState
s m =>IndexedLens'
i s a -> m (Maybe
(i, a))ipreuse
::MonadState
s m =>IndexedTraversal'
i s a -> m (Maybe
(i, a))
preuses :: MonadState s m => Getting ( First r) s a -> (a -> r) -> m ( Maybe r) Source #
Retrieve a function of the first value targeted by a
Fold
or
Traversal
(or
Just
the result from a
Getter
or
Lens
) into the current state.
preuses
=uses
.
pre
preuses
::MonadState
s m =>Getter
s a -> (a -> r) -> m (Maybe
r)preuses
::MonadState
s m =>Fold
s a -> (a -> r) -> m (Maybe
r)preuses
::MonadState
s m =>Lens'
s a -> (a -> r) -> m (Maybe
r)preuses
::MonadState
s m =>Iso'
s a -> (a -> r) -> m (Maybe
r)preuses
::MonadState
s m =>Traversal'
s a -> (a -> r) -> m (Maybe
r)
ipreuses :: MonadState s m => IndexedGetting i ( First r) s a -> (i -> a -> r) -> m ( Maybe r) Source #
Retrieve a function of the first index and value targeted by an
IndexedFold
or
IndexedTraversal
(or a function of
Just
the index and result from an
IndexedGetter
or
IndexedLens
) into the current state.
ipreuses
=uses
.
ipre
ipreuses
::MonadState
s m =>IndexedGetter
i s a -> (i -> a -> r) -> m (Maybe
r)ipreuses
::MonadState
s m =>IndexedFold
i s a -> (i -> a -> r) -> m (Maybe
r)ipreuses
::MonadState
s m =>IndexedLens'
i s a -> (i -> a -> r) -> m (Maybe
r)ipreuses
::MonadState
s m =>IndexedTraversal'
i s a -> (i -> a -> r) -> m (Maybe
r)
backwards :: ( Profunctor p, Profunctor q) => Optical p q ( Backwards f) s t a b -> Optical p q f s t a b Source #
This allows you to
traverse
the elements of a pretty much any
LensLike
construction in the opposite order.
This will preserve indexes on
Indexed
types and will give you the elements of a (finite)
Fold
or
Traversal
in the opposite order.
This has no practical impact on a
Getter
,
Setter
,
Lens
or
Iso
.
NB:
To write back through an
Iso
, you want to use
from
.
Similarly, to write back through an
Prism
, you want to use
re
.
ifoldMapOf :: IndexedGetting i m s a -> (i -> a -> m) -> s -> m Source #
Fold an
IndexedFold
or
IndexedTraversal
by mapping indices and values to an arbitrary
Monoid
with access
to the
i
.
When you don't need access to the index then
foldMapOf
is more flexible in what it accepts.
foldMapOf
l ≡ifoldMapOf
l.
const
ifoldMapOf
::IndexedGetter
i s a -> (i -> a -> m) -> s -> mifoldMapOf
::Monoid
m =>IndexedFold
i s a -> (i -> a -> m) -> s -> mifoldMapOf
::IndexedLens'
i s a -> (i -> a -> m) -> s -> mifoldMapOf
::Monoid
m =>IndexedTraversal'
i s a -> (i -> a -> m) -> s -> m
ifoldrOf :: IndexedGetting i ( Endo r) s a -> (i -> a -> r -> r) -> r -> s -> r Source #
Right-associative fold of parts of a structure that are viewed through an
IndexedFold
or
IndexedTraversal
with
access to the
i
.
When you don't need access to the index then
foldrOf
is more flexible in what it accepts.
foldrOf
l ≡ifoldrOf
l.
const
ifoldrOf
::IndexedGetter
i s a -> (i -> a -> r -> r) -> r -> s -> rifoldrOf
::IndexedFold
i s a -> (i -> a -> r -> r) -> r -> s -> rifoldrOf
::IndexedLens'
i s a -> (i -> a -> r -> r) -> r -> s -> rifoldrOf
::IndexedTraversal'
i s a -> (i -> a -> r -> r) -> r -> s -> r
ifoldlOf :: IndexedGetting i ( Dual ( Endo r)) s a -> (i -> r -> a -> r) -> r -> s -> r Source #
Left-associative fold of the parts of a structure that are viewed through an
IndexedFold
or
IndexedTraversal
with
access to the
i
.
When you don't need access to the index then
foldlOf
is more flexible in what it accepts.
foldlOf
l ≡ifoldlOf
l.
const
ifoldlOf
::IndexedGetter
i s a -> (i -> r -> a -> r) -> r -> s -> rifoldlOf
::IndexedFold
i s a -> (i -> r -> a -> r) -> r -> s -> rifoldlOf
::IndexedLens'
i s a -> (i -> r -> a -> r) -> r -> s -> rifoldlOf
::IndexedTraversal'
i s a -> (i -> r -> a -> r) -> r -> s -> r
ianyOf :: IndexedGetting i Any s a -> (i -> a -> Bool ) -> s -> Bool Source #
Return whether or not any element viewed through an
IndexedFold
or
IndexedTraversal
satisfy a predicate, with access to the
i
.
When you don't need access to the index then
anyOf
is more flexible in what it accepts.
anyOf
l ≡ianyOf
l.
const
ianyOf
::IndexedGetter
i s a -> (i -> a ->Bool
) -> s ->Bool
ianyOf
::IndexedFold
i s a -> (i -> a ->Bool
) -> s ->Bool
ianyOf
::IndexedLens'
i s a -> (i -> a ->Bool
) -> s ->Bool
ianyOf
::IndexedTraversal'
i s a -> (i -> a ->Bool
) -> s ->Bool
iallOf :: IndexedGetting i All s a -> (i -> a -> Bool ) -> s -> Bool Source #
Return whether or not all elements viewed through an
IndexedFold
or
IndexedTraversal
satisfy a predicate, with access to the
i
.
When you don't need access to the index then
allOf
is more flexible in what it accepts.
allOf
l ≡iallOf
l.
const
iallOf
::IndexedGetter
i s a -> (i -> a ->Bool
) -> s ->Bool
iallOf
::IndexedFold
i s a -> (i -> a ->Bool
) -> s ->Bool
iallOf
::IndexedLens'
i s a -> (i -> a ->Bool
) -> s ->Bool
iallOf
::IndexedTraversal'
i s a -> (i -> a ->Bool
) -> s ->Bool
inoneOf :: IndexedGetting i Any s a -> (i -> a -> Bool ) -> s -> Bool Source #
Return whether or not none of the elements viewed through an
IndexedFold
or
IndexedTraversal
satisfy a predicate, with access to the
i
.
When you don't need access to the index then
noneOf
is more flexible in what it accepts.
noneOf
l ≡inoneOf
l.
const
inoneOf
::IndexedGetter
i s a -> (i -> a ->Bool
) -> s ->Bool
inoneOf
::IndexedFold
i s a -> (i -> a ->Bool
) -> s ->Bool
inoneOf
::IndexedLens'
i s a -> (i -> a ->Bool
) -> s ->Bool
inoneOf
::IndexedTraversal'
i s a -> (i -> a ->Bool
) -> s ->Bool
itraverseOf_ :: Functor f => IndexedGetting i ( Traversed r f) s a -> (i -> a -> f r) -> s -> f () Source #
Traverse the targets of an
IndexedFold
or
IndexedTraversal
with access to the
i
, discarding the results.
When you don't need access to the index then
traverseOf_
is more flexible in what it accepts.
traverseOf_
l ≡itraverseOf
l.
const
itraverseOf_
::Functor
f =>IndexedGetter
i s a -> (i -> a -> f r) -> s -> f ()itraverseOf_
::Applicative
f =>IndexedFold
i s a -> (i -> a -> f r) -> s -> f ()itraverseOf_
::Functor
f =>IndexedLens'
i s a -> (i -> a -> f r) -> s -> f ()itraverseOf_
::Applicative
f =>IndexedTraversal'
i s a -> (i -> a -> f r) -> s -> f ()
iforOf_ :: Functor f => IndexedGetting i ( Traversed r f) s a -> s -> (i -> a -> f r) -> f () Source #
Traverse the targets of an
IndexedFold
or
IndexedTraversal
with access to the index, discarding the results
(with the arguments flipped).
iforOf_
≡flip
.
itraverseOf_
When you don't need access to the index then
forOf_
is more flexible in what it accepts.
forOf_
l a ≡iforOf_
l a.
const
iforOf_
::Functor
f =>IndexedGetter
i s a -> s -> (i -> a -> f r) -> f ()iforOf_
::Applicative
f =>IndexedFold
i s a -> s -> (i -> a -> f r) -> f ()iforOf_
::Functor
f =>IndexedLens'
i s a -> s -> (i -> a -> f r) -> f ()iforOf_
::Applicative
f =>IndexedTraversal'
i s a -> s -> (i -> a -> f r) -> f ()
imapMOf_ :: Monad m => IndexedGetting i ( Sequenced r m) s a -> (i -> a -> m r) -> s -> m () Source #
Run monadic actions for each target of an
IndexedFold
or
IndexedTraversal
with access to the index,
discarding the results.
When you don't need access to the index then
mapMOf_
is more flexible in what it accepts.
mapMOf_
l ≡imapMOf
l.
const
imapMOf_
::Monad
m =>IndexedGetter
i s a -> (i -> a -> m r) -> s -> m ()imapMOf_
::Monad
m =>IndexedFold
i s a -> (i -> a -> m r) -> s -> m ()imapMOf_
::Monad
m =>IndexedLens'
i s a -> (i -> a -> m r) -> s -> m ()imapMOf_
::Monad
m =>IndexedTraversal'
i s a -> (i -> a -> m r) -> s -> m ()
iforMOf_ :: Monad m => IndexedGetting i ( Sequenced r m) s a -> s -> (i -> a -> m r) -> m () Source #
Run monadic actions for each target of an
IndexedFold
or
IndexedTraversal
with access to the index,
discarding the results (with the arguments flipped).
iforMOf_
≡flip
.
imapMOf_
When you don't need access to the index then
forMOf_
is more flexible in what it accepts.
forMOf_
l a ≡iforMOf
l a.
const
iforMOf_
::Monad
m =>IndexedGetter
i s a -> s -> (i -> a -> m r) -> m ()iforMOf_
::Monad
m =>IndexedFold
i s a -> s -> (i -> a -> m r) -> m ()iforMOf_
::Monad
m =>IndexedLens'
i s a -> s -> (i -> a -> m r) -> m ()iforMOf_
::Monad
m =>IndexedTraversal'
i s a -> s -> (i -> a -> m r) -> m ()
iconcatMapOf :: IndexedGetting i [r] s a -> (i -> a -> [r]) -> s -> [r] Source #
Concatenate the results of a function of the elements of an
IndexedFold
or
IndexedTraversal
with access to the index.
When you don't need access to the index then
concatMapOf
is more flexible in what it accepts.
concatMapOf
l ≡iconcatMapOf
l.
const
iconcatMapOf
≡ifoldMapOf
iconcatMapOf
::IndexedGetter
i s a -> (i -> a -> [r]) -> s -> [r]iconcatMapOf
::IndexedFold
i s a -> (i -> a -> [r]) -> s -> [r]iconcatMapOf
::IndexedLens'
i s a -> (i -> a -> [r]) -> s -> [r]iconcatMapOf
::IndexedTraversal'
i s a -> (i -> a -> [r]) -> s -> [r]
ifindOf :: IndexedGetting i ( Endo ( Maybe a)) s a -> (i -> a -> Bool ) -> s -> Maybe a Source #
The
ifindOf
function takes an
IndexedFold
or
IndexedTraversal
, a predicate that is also
supplied the index, a structure and returns the left-most element of the structure
matching the predicate, or
Nothing
if there is no such element.
When you don't need access to the index then
findOf
is more flexible in what it accepts.
findOf
l ≡ifindOf
l.
const
ifindOf
::IndexedGetter
i s a -> (i -> a ->Bool
) -> s ->Maybe
aifindOf
::IndexedFold
i s a -> (i -> a ->Bool
) -> s ->Maybe
aifindOf
::IndexedLens'
i s a -> (i -> a ->Bool
) -> s ->Maybe
aifindOf
::IndexedTraversal'
i s a -> (i -> a ->Bool
) -> s ->Maybe
a
ifindMOf :: Monad m => IndexedGetting i ( Endo (m ( Maybe a))) s a -> (i -> a -> m Bool ) -> s -> m ( Maybe a) Source #
The
ifindMOf
function takes an
IndexedFold
or
IndexedTraversal
, a monadic predicate that is also
supplied the index, a structure and returns in the monad the left-most element of the structure
matching the predicate, or
Nothing
if there is no such element.
When you don't need access to the index then
findMOf
is more flexible in what it accepts.
findMOf
l ≡ifindMOf
l.
const
ifindMOf
::Monad
m =>IndexedGetter
i s a -> (i -> a -> mBool
) -> s -> m (Maybe
a)ifindMOf
::Monad
m =>IndexedFold
i s a -> (i -> a -> mBool
) -> s -> m (Maybe
a)ifindMOf
::Monad
m =>IndexedLens'
i s a -> (i -> a -> mBool
) -> s -> m (Maybe
a)ifindMOf
::Monad
m =>IndexedTraversal'
i s a -> (i -> a -> mBool
) -> s -> m (Maybe
a)
ifoldrOf' :: IndexedGetting i ( Dual ( Endo (r -> r))) s a -> (i -> a -> r -> r) -> r -> s -> r Source #
Strictly fold right over the elements of a structure with an index.
When you don't need access to the index then
foldrOf'
is more flexible in what it accepts.
foldrOf'
l ≡ifoldrOf'
l.
const
ifoldrOf'
::IndexedGetter
i s a -> (i -> a -> r -> r) -> r -> s -> rifoldrOf'
::IndexedFold
i s a -> (i -> a -> r -> r) -> r -> s -> rifoldrOf'
::IndexedLens'
i s a -> (i -> a -> r -> r) -> r -> s -> rifoldrOf'
::IndexedTraversal'
i s a -> (i -> a -> r -> r) -> r -> s -> r
ifoldlOf' :: IndexedGetting i ( Endo (r -> r)) s a -> (i -> r -> a -> r) -> r -> s -> r Source #
Fold over the elements of a structure with an index, associating to the left, but strictly .
When you don't need access to the index then
foldlOf'
is more flexible in what it accepts.
foldlOf'
l ≡ifoldlOf'
l.
const
ifoldlOf'
::IndexedGetter
i s a -> (i -> r -> a -> r) -> r -> s -> rifoldlOf'
::IndexedFold
i s a -> (i -> r -> a -> r) -> r -> s -> rifoldlOf'
::IndexedLens'
i s a -> (i -> r -> a -> r) -> r -> s -> rifoldlOf'
::IndexedTraversal'
i s a -> (i -> r -> a -> r) -> r -> s -> r
ifoldrMOf :: Monad m => IndexedGetting i ( Dual ( Endo (r -> m r))) s a -> (i -> a -> r -> m r) -> r -> s -> m r Source #
Monadic fold right over the elements of a structure with an index.
When you don't need access to the index then
foldrMOf
is more flexible in what it accepts.
foldrMOf
l ≡ifoldrMOf
l.
const
ifoldrMOf
::Monad
m =>IndexedGetter
i s a -> (i -> a -> r -> m r) -> r -> s -> m rifoldrMOf
::Monad
m =>IndexedFold
i s a -> (i -> a -> r -> m r) -> r -> s -> m rifoldrMOf
::Monad
m =>IndexedLens'
i s a -> (i -> a -> r -> m r) -> r -> s -> m rifoldrMOf
::Monad
m =>IndexedTraversal'
i s a -> (i -> a -> r -> m r) -> r -> s -> m r
ifoldlMOf :: Monad m => IndexedGetting i ( Endo (r -> m r)) s a -> (i -> r -> a -> m r) -> r -> s -> m r Source #
Monadic fold over the elements of a structure with an index, associating to the left.
When you don't need access to the index then
foldlMOf
is more flexible in what it accepts.
foldlMOf
l ≡ifoldlMOf
l.
const
ifoldlMOf
::Monad
m =>IndexedGetter
i s a -> (i -> r -> a -> m r) -> r -> s -> m rifoldlMOf
::Monad
m =>IndexedFold
i s a -> (i -> r -> a -> m r) -> r -> s -> m rifoldlMOf
::Monad
m =>IndexedLens'
i s a -> (i -> r -> a -> m r) -> r -> s -> m rifoldlMOf
::Monad
m =>IndexedTraversal'
i s a -> (i -> r -> a -> m r) -> r -> s -> m r
itoListOf :: IndexedGetting i ( Endo [(i, a)]) s a -> s -> [(i, a)] Source #
Extract the key-value pairs from a structure.
When you don't need access to the indices in the result, then
toListOf
is more flexible in what it accepts.
toListOf
l ≡map
snd
.
itoListOf
l
itoListOf
::IndexedGetter
i s a -> s -> [(i,a)]itoListOf
::IndexedFold
i s a -> s -> [(i,a)]itoListOf
::IndexedLens'
i s a -> s -> [(i,a)]itoListOf
::IndexedTraversal'
i s a -> s -> [(i,a)]
elemIndexOf :: Eq a => IndexedGetting i ( First i) s a -> a -> s -> Maybe i Source #
Retrieve the index of the first value targeted by a
IndexedFold
or
IndexedTraversal
which is equal to a given value.
elemIndex
≡elemIndexOf
folded
elemIndexOf
::Eq
a =>IndexedFold
i s a -> a -> s ->Maybe
ielemIndexOf
::Eq
a =>IndexedTraversal'
i s a -> a -> s ->Maybe
i
elemIndicesOf :: Eq a => IndexedGetting i ( Endo [i]) s a -> a -> s -> [i] Source #
Retrieve the indices of the values targeted by a
IndexedFold
or
IndexedTraversal
which are equal to a given value.
elemIndices
≡elemIndicesOf
folded
elemIndicesOf
::Eq
a =>IndexedFold
i s a -> a -> s -> [i]elemIndicesOf
::Eq
a =>IndexedTraversal'
i s a -> a -> s -> [i]
findIndexOf :: IndexedGetting i ( First i) s a -> (a -> Bool ) -> s -> Maybe i Source #
Retrieve the index of the first value targeted by a
IndexedFold
or
IndexedTraversal
which satisfies a predicate.
findIndex
≡findIndexOf
folded
findIndexOf
::IndexedFold
i s a -> (a ->Bool
) -> s ->Maybe
ifindIndexOf
::IndexedTraversal'
i s a -> (a ->Bool
) -> s ->Maybe
i
findIndicesOf :: IndexedGetting i ( Endo [i]) s a -> (a -> Bool ) -> s -> [i] Source #
Retrieve the indices of the values targeted by a
IndexedFold
or
IndexedTraversal
which satisfy a predicate.
findIndices
≡findIndicesOf
folded
findIndicesOf
::IndexedFold
i s a -> (a ->Bool
) -> s -> [i]findIndicesOf
::IndexedTraversal'
i s a -> (a ->Bool
) -> s -> [i]
ifiltered :: ( Indexable i p, Applicative f) => (i -> a -> Bool ) -> Optical' p ( Indexed i) f a a Source #
Filter an
IndexedFold
or
IndexedGetter
, obtaining an
IndexedFold
.
>>>
[0,0,0,5,5,5]^..traversed.ifiltered (\i a -> i <= a)
[0,5,5,5]
Compose with
ifiltered
to filter another
IndexedLens
,
IndexedIso
,
IndexedGetter
,
IndexedFold
(or
IndexedTraversal
) with
access to both the value and the index.
Note: As with
filtered
, this is
not
a legal
IndexedTraversal
, unless you are very careful not to invalidate the predicate on the target!
itakingWhile :: ( Indexable i p, Profunctor q, Contravariant f, Applicative f) => (i -> a -> Bool ) -> Optical' ( Indexed i) q ( Const ( Endo (f s))) s a -> Optical' p q f s a Source #
Obtain an
IndexedFold
by taking elements from another
IndexedFold
,
IndexedLens
,
IndexedGetter
or
IndexedTraversal
while a predicate holds.
itakingWhile
:: (i -> a ->Bool
) ->IndexedFold
i s a ->IndexedFold
i s aitakingWhile
:: (i -> a ->Bool
) ->IndexedTraversal'
i s a ->IndexedFold
i s aitakingWhile
:: (i -> a ->Bool
) ->IndexedLens'
i s a ->IndexedFold
i s aitakingWhile
:: (i -> a ->Bool
) ->IndexedGetter
i s a ->IndexedFold
i s a
Note: Applying
itakingWhile
to an
IndexedLens
or
IndexedTraversal
will still allow you to use it as a
pseudo-
IndexedTraversal
, but if you change the value of any target to one where the predicate returns
False
, then you will break the
Traversal
laws and
Traversal
fusion will no longer be sound.
idroppingWhile :: ( Indexable i p, Profunctor q, Applicative f) => (i -> a -> Bool ) -> Optical ( Indexed i) q ( Compose ( State Bool ) f) s t a a -> Optical p q f s t a a Source #
Obtain an
IndexedFold
by dropping elements from another
IndexedFold
,
IndexedLens
,
IndexedGetter
or
IndexedTraversal
while a predicate holds.
idroppingWhile
:: (i -> a ->Bool
) ->IndexedFold
i s a ->IndexedFold
i s aidroppingWhile
:: (i -> a ->Bool
) ->IndexedTraversal'
i s a ->IndexedFold
i s a -- see notesidroppingWhile
:: (i -> a ->Bool
) ->IndexedLens'
i s a ->IndexedFold
i s a -- see notesidroppingWhile
:: (i -> a ->Bool
) ->IndexedGetter
i s a ->IndexedFold
i s a
Note: As with
droppingWhile
applying
idroppingWhile
to an
IndexedLens
or
IndexedTraversal
will still
allow you to use it as a pseudo-
IndexedTraversal
, but if you change the value of the first target to one
where the predicate returns
True
, then you will break the
Traversal
laws and
Traversal
fusion will
no longer be sound.
foldByOf :: Fold s a -> (a -> a -> a) -> a -> s -> a Source #
Fold a value using a specified
Fold
and
Monoid
operations.
This is like
foldBy
where the
Foldable
instance can be
manually specified.
foldByOf
folded
≡foldBy
foldByOf
::Getter
s a -> (a -> a -> a) -> a -> s -> afoldByOf
::Fold
s a -> (a -> a -> a) -> a -> s -> afoldByOf
::Lens'
s a -> (a -> a -> a) -> a -> s -> afoldByOf
::Traversal'
s a -> (a -> a -> a) -> a -> s -> afoldByOf
::Iso'
s a -> (a -> a -> a) -> a -> s -> a
>>>
foldByOf both (++) [] ("hello","world")
"helloworld"
foldMapByOf :: Fold s a -> (r -> r -> r) -> r -> (a -> r) -> s -> r Source #
Fold a value using a specified
Fold
and
Monoid
operations.
This is like
foldMapBy
where the
Foldable
instance can be
manually specified.
foldMapByOf
folded
≡foldMapBy
foldMapByOf
::Getter
s a -> (r -> r -> r) -> r -> (a -> r) -> s -> rfoldMapByOf
::Fold
s a -> (r -> r -> r) -> r -> (a -> r) -> s -> rfoldMapByOf
::Traversal'
s a -> (r -> r -> r) -> r -> (a -> r) -> s -> rfoldMapByOf
::Lens'
s a -> (r -> r -> r) -> r -> (a -> r) -> s -> rfoldMapByOf
::Iso'
s a -> (r -> r -> r) -> r -> (a -> r) -> s -> r
>>>
foldMapByOf both (+) 0 length ("hello","world")
10
class Ord k => TraverseMax k m | m -> k where Source #
Allows
IndexedTraversal
of the value at the largest index.
traverseMax :: IndexedTraversal' k (m v) v Source #
IndexedTraversal
of the element at the largest index.
Instances
TraverseMax Int IntMap Source # | |
Defined in Control.Lens.Traversal traverseMax :: IndexedTraversal' Int ( IntMap v) v Source # |
|
Ord k => TraverseMax k ( Map k) Source # | |
Defined in Control.Lens.Traversal traverseMax :: IndexedTraversal' k ( Map k v) v Source # |
class Ord k => TraverseMin k m | m -> k where Source #
Allows
IndexedTraversal
the value at the smallest index.
traverseMin :: IndexedTraversal' k (m v) v Source #
IndexedTraversal
of the element with the smallest index.
Instances
TraverseMin Int IntMap Source # | |
Defined in Control.Lens.Traversal traverseMin :: IndexedTraversal' Int ( IntMap v) v Source # |
|
Ord k => TraverseMin k ( Map k) Source # | |
Defined in Control.Lens.Traversal traverseMin :: IndexedTraversal' k ( Map k v) v Source # |
type Traversing1' p f s a = Traversing1 p f s s a a Source #
type Traversing' p f s a = Traversing p f s s a a Source #
typeTraversing'
f =Simple
(Traversing
f)
type Traversing1 p f s t a b = Over p ( BazaarT1 p f a b) s t a b Source #
type Traversing p f s t a b = Over p ( BazaarT p f a b) s t a b Source #
When you see this as an argument to a function, it expects
-
to be indexed if
p
is an instance ofIndexed
i, -
to be unindexed if
p
is(->)
, -
a
Traversal
iff
isApplicative
, -
a
Getter
iff
is only aFunctor
andContravariant
, -
a
Lens
iff
is only aFunctor
, -
a
Fold
iff
isApplicative
andContravariant
.
type AnIndexedTraversal1' i s a = AnIndexedTraversal1 i s s a a Source #
typeAnIndexedTraversal1'
=Simple
(AnIndexedTraversal1
i)
type AnIndexedTraversal' i s a = AnIndexedTraversal i s s a a Source #
typeAnIndexedTraversal'
=Simple
(AnIndexedTraversal
i)
type AnIndexedTraversal1 i s t a b = Over ( Indexed i) ( Bazaar1 ( Indexed i) a b) s t a b Source #
When you see this as an argument to a function, it expects an
IndexedTraversal1
.
type AnIndexedTraversal i s t a b = Over ( Indexed i) ( Bazaar ( Indexed i) a b) s t a b Source #
When you see this as an argument to a function, it expects an
IndexedTraversal
.
type ATraversal1' s a = ATraversal1 s s a a Source #
typeATraversal1'
=Simple
ATraversal1
type ATraversal1 s t a b = LensLike ( Bazaar1 (->) a b) s t a b Source #
When you see this as an argument to a function, it expects a
Traversal1
.
type ATraversal' s a = ATraversal s s a a Source #
typeATraversal'
=Simple
ATraversal
type ATraversal s t a b = LensLike ( Bazaar (->) a b) s t a b Source #
When you see this as an argument to a function, it expects a
Traversal
.
traverseOf :: LensLike f s t a b -> (a -> f b) -> s -> f t Source #
Map each element of a structure targeted by a
Lens
or
Traversal
,
evaluate these actions from left to right, and collect the results.
This function is only provided for consistency,
id
is strictly more general.
>>>
traverseOf each print (1,2,3)
1 2 3 ((),(),())
traverseOf
≡id
itraverseOf
l ≡traverseOf
l.
Indexed
itraverseOf
itraversed
≡itraverse
This yields the obvious law:
traverse
≡traverseOf
traverse
traverseOf
::Functor
f =>Iso
s t a b -> (a -> f b) -> s -> f ttraverseOf
::Functor
f =>Lens
s t a b -> (a -> f b) -> s -> f ttraverseOf
::Apply
f =>Traversal1
s t a b -> (a -> f b) -> s -> f ttraverseOf
::Applicative
f =>Traversal
s t a b -> (a -> f b) -> s -> f t
forOf :: LensLike f s t a b -> s -> (a -> f b) -> f t Source #
A version of
traverseOf
with the arguments flipped, such that:
>>>
forOf each (1,2,3) print
1 2 3 ((),(),())
This function is only provided for consistency,
flip
is strictly more general.
forOf
≡flip
forOf
≡flip
.traverseOf
for
≡forOf
traverse
ifor
l s ≡for
l s.
Indexed
forOf
::Functor
f =>Iso
s t a b -> s -> (a -> f b) -> f tforOf
::Functor
f =>Lens
s t a b -> s -> (a -> f b) -> f tforOf
::Applicative
f =>Traversal
s t a b -> s -> (a -> f b) -> f t
sequenceAOf :: LensLike f s t (f b) b -> s -> f t Source #
Evaluate each action in the structure from left to right, and collect the results.
>>>
sequenceAOf both ([1,2],[3,4])
[(1,3),(1,4),(2,3),(2,4)]
sequenceA
≡sequenceAOf
traverse
≡traverse
id
sequenceAOf
l ≡traverseOf
lid
≡ lid
sequenceAOf
::Functor
f =>Iso
s t (f b) b -> s -> f tsequenceAOf
::Functor
f =>Lens
s t (f b) b -> s -> f tsequenceAOf
::Applicative
f =>Traversal
s t (f b) b -> s -> f t
mapMOf :: LensLike ( WrappedMonad m) s t a b -> (a -> m b) -> s -> m t Source #
Map each element of a structure targeted by a
Lens
to a monadic action,
evaluate these actions from left to right, and collect the results.
>>>
mapMOf both (\x -> [x, x + 1]) (1,3)
[(1,3),(1,4),(2,3),(2,4)]
mapM
≡mapMOf
traverse
imapMOf
l ≡forM
l.
Indexed
mapMOf
::Monad
m =>Iso
s t a b -> (a -> m b) -> s -> m tmapMOf
::Monad
m =>Lens
s t a b -> (a -> m b) -> s -> m tmapMOf
::Monad
m =>Traversal
s t a b -> (a -> m b) -> s -> m t
forMOf :: LensLike ( WrappedMonad m) s t a b -> s -> (a -> m b) -> m t Source #
forMOf
is a flipped version of
mapMOf
, consistent with the definition of
forM
.
>>>
forMOf both (1,3) $ \x -> [x, x + 1]
[(1,3),(1,4),(2,3),(2,4)]
forM
≡forMOf
traverse
forMOf
l ≡flip
(mapMOf
l)iforMOf
l s ≡forM
l s.
Indexed
forMOf
::Monad
m =>Iso
s t a b -> s -> (a -> m b) -> m tforMOf
::Monad
m =>Lens
s t a b -> s -> (a -> m b) -> m tforMOf
::Monad
m =>Traversal
s t a b -> s -> (a -> m b) -> m t
sequenceOf :: LensLike ( WrappedMonad m) s t (m b) b -> s -> m t Source #
Sequence the (monadic) effects targeted by a
Lens
in a container from left to right.
>>>
sequenceOf each ([1,2],[3,4],[5,6])
[(1,3,5),(1,3,6),(1,4,5),(1,4,6),(2,3,5),(2,3,6),(2,4,5),(2,4,6)]
sequence
≡sequenceOf
traverse
sequenceOf
l ≡mapMOf
lid
sequenceOf
l ≡unwrapMonad
.
lWrapMonad
sequenceOf
::Monad
m =>Iso
s t (m b) b -> s -> m tsequenceOf
::Monad
m =>Lens
s t (m b) b -> s -> m tsequenceOf
::Monad
m =>Traversal
s t (m b) b -> s -> m t
transposeOf :: LensLike ZipList s t [a] a -> s -> [t] Source #
This generalizes
transpose
to an arbitrary
Traversal
.
Note:
transpose
handles ragged inputs more intelligently, but for non-ragged inputs:
>>>
transposeOf traverse [[1,2,3],[4,5,6]]
[[1,4],[2,5],[3,6]]
transpose
≡transposeOf
traverse
Since every
Lens
is a
Traversal
, we can use this as a form of
monadic strength as well:
transposeOf
_2
:: (b, [a]) -> [(b, a)]
mapAccumROf :: LensLike ( Backwards ( State acc)) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t) Source #
This generalizes
mapAccumR
to an arbitrary
Traversal
.
mapAccumR
≡mapAccumROf
traverse
mapAccumROf
accumulates
State
from right to left.
mapAccumROf
::Iso
s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)mapAccumROf
::Lens
s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)mapAccumROf
::Traversal
s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
mapAccumROf
::LensLike
(Backwards
(State
acc)) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
mapAccumLOf :: LensLike ( State acc) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t) Source #
This generalizes
mapAccumL
to an arbitrary
Traversal
.
mapAccumL
≡mapAccumLOf
traverse
mapAccumLOf
accumulates
State
from left to right.
mapAccumLOf
::Iso
s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)mapAccumLOf
::Lens
s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)mapAccumLOf
::Traversal
s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
mapAccumLOf
::LensLike
(State
acc) s t a b -> (acc -> a -> (acc, b)) -> acc -> s -> (acc, t)mapAccumLOf
l f acc0 s =swap
(runState
(l (a ->state
(acc ->swap
(f acc a))) s) acc0)
iloci :: IndexedTraversal i ( Bazaar ( Indexed i) a c s) ( Bazaar ( Indexed i) b c s) a b Source #
This
IndexedTraversal
allows you to
traverse
the individual stores in
a
Bazaar
with access to their indices.
partsOf :: Functor f => Traversing (->) f s t a a -> LensLike f s t [a] [a] Source #
partsOf
turns a
Traversal
into a
Lens
that resembles an early version of the
uniplate
(or
biplate
) type.
Note: You should really try to maintain the invariant of the number of children in the list.
>>>
(a,b,c) & partsOf each .~ [x,y,z]
(x,y,z)
Any extras will be lost. If you do not supply enough, then the remainder will come from the original structure.
>>>
(a,b,c) & partsOf each .~ [w,x,y,z]
(w,x,y)
>>>
(a,b,c) & partsOf each .~ [x,y]
(x,y,c)
>>>
('b', 'a', 'd', 'c') & partsOf each %~ sort
('a','b','c','d')
So technically, this is only a
Lens
if you do not change the number of results it returns.
When applied to a
Fold
the result is merely a
Getter
.
partsOf
::Iso'
s a ->Lens'
s [a]partsOf
::Lens'
s a ->Lens'
s [a]partsOf
::Traversal'
s a ->Lens'
s [a]partsOf
::Fold
s a ->Getter
s [a]partsOf
::Getter
s a ->Getter
s [a]
ipartsOf :: forall i p f s t a. ( Indexable [i] p, Functor f) => Traversing ( Indexed i) f s t a a -> Over p f s t [a] [a] Source #
An indexed version of
partsOf
that receives the entire list of indices as its index.
partsOf' :: ATraversal s t a a -> Lens s t [a] [a] Source #
ipartsOf' :: forall i p f s t a. ( Indexable [i] p, Functor f) => Over ( Indexed i) ( Bazaar' ( Indexed i) a) s t a a -> Over p f s t [a] [a] Source #
A type-restricted version of
ipartsOf
that can only be used with an
IndexedTraversal
.
unsafePartsOf :: Functor f => Traversing (->) f s t a b -> LensLike f s t [a] [b] Source #
unsafePartsOf
turns a
Traversal
into a
uniplate
(or
biplate
) family.
If you do not need the types of
s
and
t
to be different, it is recommended that
you use
partsOf
.
It is generally safer to traverse with the
Bazaar
rather than use this
combinator. However, it is sometimes convenient.
This is unsafe because if you don't supply at least as many
b
's as you were
given
a
's, then the reconstruction of
t
will
result in an error!
When applied to a
Fold
the result is merely a
Getter
(and becomes safe).
unsafePartsOf
::Iso
s t a b ->Lens
s t [a] [b]unsafePartsOf
::Lens
s t a b ->Lens
s t [a] [b]unsafePartsOf
::Traversal
s t a b ->Lens
s t [a] [b]unsafePartsOf
::Fold
s a ->Getter
s [a]unsafePartsOf
::Getter
s a ->Getter
s [a]
iunsafePartsOf :: forall i p f s t a b. ( Indexable [i] p, Functor f) => Traversing ( Indexed i) f s t a b -> Over p f s t [a] [b] Source #
An indexed version of
unsafePartsOf
that receives the entire list of indices as its index.
unsafePartsOf' :: ATraversal s t a b -> Lens s t [a] [b] Source #
iunsafePartsOf' :: forall i s t a b. Over ( Indexed i) ( Bazaar ( Indexed i) a b) s t a b -> IndexedLens [i] s t [a] [b] Source #
singular :: ( HasCallStack , Conjoined p, Functor f) => Traversing p f s t a a -> Over p f s t a a Source #
This converts a
Traversal
that you "know" will target one or more elements to a
Lens
. It can
also be used to transform a non-empty
Fold
into a
Getter
.
The resulting
Lens
or
Getter
will be partial if the supplied
Traversal
returns
no results.
>>>
[1,2,3] ^. singular _head
1
>>>
Left (ErrorCall "singular: empty traversal") <- try (evaluate ([] ^. singular _head)) :: IO (Either ErrorCall ())
>>>
Left 4 ^. singular _Left
4
>>>
[1..10] ^. singular (ix 7)
8
>>>
[] & singular traverse .~ 0
[]
singular
::Traversal
s t a a ->Lens
s t a asingular
::Fold
s a ->Getter
s asingular
::IndexedTraversal
i s t a a ->IndexedLens
i s t a asingular
::IndexedFold
i s a ->IndexedGetter
i s a
unsafeSingular :: ( HasCallStack , Conjoined p, Functor f) => Traversing p f s t a b -> Over p f s t a b Source #
This converts a
Traversal
that you "know" will target only one element to a
Lens
. It can also be
used to transform a
Fold
into a
Getter
.
The resulting
Lens
or
Getter
will be partial if the
Traversal
targets nothing
or more than one element.
>>>
Left (ErrorCall "unsafeSingular: empty traversal") <- try (evaluate ([] & unsafeSingular traverse .~ 0)) :: IO (Either ErrorCall [Integer])
unsafeSingular
::Traversal
s t a b ->Lens
s t a bunsafeSingular
::Fold
s a ->Getter
s aunsafeSingular
::IndexedTraversal
i s t a b ->IndexedLens
i s t a bunsafeSingular
::IndexedFold
i s a ->IndexedGetter
i s a
holesOf :: Conjoined p => Over p ( Bazaar p a a) s t a a -> s -> [ Pretext p a a t] Source #
The one-level version of
contextsOf
. This extracts a
list of the immediate children according to a given
Traversal
as editable
contexts.
Given a context you can use
pos
to see the
values,
peek
at what the structure would be
like with an edited result, or simply
extract
the original structure.
propChildren l x =toListOf
l x==
map
pos
(holesOf
l x) propId l x =all
(==
x) [extract
w | w <-holesOf
l x]
holesOf
::Iso'
s a -> s -> [Pretext'
(->) a s]holesOf
::Lens'
s a -> s -> [Pretext'
(->) a s]holesOf
::Traversal'
s a -> s -> [Pretext'
(->) a s]holesOf
::IndexedLens'
i s a -> s -> [Pretext'
(Indexed
i) a s]holesOf
::IndexedTraversal'
i s a -> s -> [Pretext'
(Indexed
i) a s]
holes1Of :: Conjoined p => Over p ( Bazaar1 p a a) s t a a -> s -> NonEmpty ( Pretext p a a t) Source #
The non-empty version of
holesOf
.
This extract a non-empty list of immediate children according to a given
Traversal1
as editable contexts.
>>>
let head1 f s = runPretext (NonEmpty.head $ holes1Of traversed1 s) f
>>>
('a' :| "bc") ^. head1
'a'
>>>
('a' :| "bc") & head1 %~ toUpper
'A' :| "bc"
holes1Of
::Iso'
s a -> s ->NonEmpty
(Pretext'
(->) a s)holes1Of
::Lens'
s a -> s ->NonEmpty
(Pretext'
(->) a s)holes1Of
::Traversal1'
s a -> s ->NonEmpty
(Pretext'
(->) a s)holes1Of
::IndexedLens'
i s a -> s ->NonEmpty
(Pretext'
(Indexed
i) a s)holes1Of
::IndexedTraversal1'
i s a -> s ->NonEmpty
(Pretext'
(Indexed
i) a s)
both :: Bitraversable r => Traversal (r a a) (r b b) a b Source #
Traverse both parts of a
Bitraversable
container with matching types.
Usually that type will be a pair. Use
each
to traverse
the elements of arbitrary homogeneous tuples.
>>>
(1,2) & both *~ 10
(10,20)
>>>
over both length ("hello","world")
(5,5)
>>>
("hello","world")^.both
"helloworld"
both
::Traversal
(a, a) (b, b) a bboth
::Traversal
(Either
a a) (Either
b b) a b
both1 :: Bitraversable1 r => Traversal1 (r a a) (r b b) a b Source #
Traverse both parts of a
Bitraversable1
container with matching types.
Usually that type will be a pair.
both1
::Traversal1
(a, a) (b, b) a bboth1
::Traversal1
(Either
a a) (Either
b b) a b
beside :: ( Representable q, Applicative ( Rep q), Applicative f, Bitraversable r) => Optical p q f s t a b -> Optical p q f s' t' a b -> Optical p q f (r s s') (r t t') a b Source #
Apply a different
Traversal
or
Fold
to each side of a
Bitraversable
container.
beside
::Traversal
s t a b ->Traversal
s' t' a b ->Traversal
(r s s') (r t t') a bbeside
::IndexedTraversal
i s t a b ->IndexedTraversal
i s' t' a b ->IndexedTraversal
i (r s s') (r t t') a bbeside
::IndexPreservingTraversal
s t a b ->IndexPreservingTraversal
s' t' a b ->IndexPreservingTraversal
(r s s') (r t t') a b
beside
::Traversal
s t a b ->Traversal
s' t' a b ->Traversal
(s,s') (t,t') a bbeside
::Lens
s t a b ->Lens
s' t' a b ->Traversal
(s,s') (t,t') a bbeside
::Fold
s a ->Fold
s' a ->Fold
(s,s') abeside
::Getter
s a ->Getter
s' a ->Fold
(s,s') a
beside
::IndexedTraversal
i s t a b ->IndexedTraversal
i s' t' a b ->IndexedTraversal
i (s,s') (t,t') a bbeside
::IndexedLens
i s t a b ->IndexedLens
i s' t' a b ->IndexedTraversal
i (s,s') (t,t') a bbeside
::IndexedFold
i s a ->IndexedFold
i s' a ->IndexedFold
i (s,s') abeside
::IndexedGetter
i s a ->IndexedGetter
i s' a ->IndexedFold
i (s,s') a
beside
::IndexPreservingTraversal
s t a b ->IndexPreservingTraversal
s' t' a b ->IndexPreservingTraversal
(s,s') (t,t') a bbeside
::IndexPreservingLens
s t a b ->IndexPreservingLens
s' t' a b ->IndexPreservingTraversal
(s,s') (t,t') a bbeside
::IndexPreservingFold
s a ->IndexPreservingFold
s' a ->IndexPreservingFold
(s,s') abeside
::IndexPreservingGetter
s a ->IndexPreservingGetter
s' a ->IndexPreservingFold
(s,s') a
>>>
("hello",["world","!!!"])^..beside id traverse
["hello","world","!!!"]
taking :: ( Conjoined p, Applicative f) => Int -> Traversing p f s t a a -> Over p f s t a a Source #
Visit the first
n
targets of a
Traversal
,
Fold
,
Getter
or
Lens
.
>>>
[("hello","world"),("!!!","!!!")]^.. taking 2 (traverse.both)
["hello","world"]
>>>
timingOut $ [1..] ^.. taking 3 traverse
[1,2,3]
>>>
over (taking 5 traverse) succ "hello world"
"ifmmp world"
taking
::Int
->Traversal'
s a ->Traversal'
s ataking
::Int
->Lens'
s a ->Traversal'
s ataking
::Int
->Iso'
s a ->Traversal'
s ataking
::Int
->Prism'
s a ->Traversal'
s ataking
::Int
->Getter
s a ->Fold
s ataking
::Int
->Fold
s a ->Fold
s ataking
::Int
->IndexedTraversal'
i s a ->IndexedTraversal'
i s ataking
::Int
->IndexedLens'
i s a ->IndexedTraversal'
i s ataking
::Int
->IndexedGetter
i s a ->IndexedFold
i s ataking
::Int
->IndexedFold
i s a ->IndexedFold
i s a
dropping :: ( Conjoined p, Applicative f) => Int -> Over p ( Indexing f) s t a a -> Over p f s t a a Source #
Visit all but the first
n
targets of a
Traversal
,
Fold
,
Getter
or
Lens
.
>>>
("hello","world") ^? dropping 1 both
Just "world"
Dropping works on infinite traversals as well:
>>>
[1..] ^? dropping 1 folded
Just 2
dropping
::Int
->Traversal'
s a ->Traversal'
s adropping
::Int
->Lens'
s a ->Traversal'
s adropping
::Int
->Iso'
s a ->Traversal'
s adropping
::Int
->Prism'
s a ->Traversal'
s adropping
::Int
->Getter
s a ->Fold
s adropping
::Int
->Fold
s a ->Fold
s adropping
::Int
->IndexedTraversal'
i s a ->IndexedTraversal'
i s adropping
::Int
->IndexedLens'
i s a ->IndexedTraversal'
i s adropping
::Int
->IndexedGetter
i s a ->IndexedFold
i s adropping
::Int
->IndexedFold
i s a ->IndexedFold
i s a
cloneTraversal :: ATraversal s t a b -> Traversal s t a b Source #
A
Traversal
is completely characterized by its behavior on a
Bazaar
.
Cloning a
Traversal
is one way to make sure you aren't given
something weaker, such as a
Fold
and can be
used as a way to pass around traversals that have to be monomorphic in
f
.
Note: This only accepts a proper
Traversal
(or
Lens
). To clone a
Lens
as such, use
cloneLens
.
Note: It is usually better to use
ReifiedTraversal
and
runTraversal
than to
cloneTraversal
. The
former can execute at full speed, while the latter needs to round trip through
the
Bazaar
.
>>>
let foo l a = (view (getting (cloneTraversal l)) a, set (cloneTraversal l) 10 a)
>>>
foo both ("hello","world")
("helloworld",(10,10))
cloneTraversal
::LensLike
(Bazaar
(->) a b) s t a b ->Traversal
s t a b
cloneIndexPreservingTraversal :: ATraversal s t a b -> IndexPreservingTraversal s t a b Source #
Clone a
Traversal
yielding an
IndexPreservingTraversal
that passes through
whatever index it is composed with.
cloneIndexedTraversal :: AnIndexedTraversal i s t a b -> IndexedTraversal i s t a b Source #
Clone an
IndexedTraversal
yielding an
IndexedTraversal
with the same index.
cloneTraversal1 :: ATraversal1 s t a b -> Traversal1 s t a b Source #
A
Traversal1
is completely characterized by its behavior on a
Bazaar1
.
cloneIndexPreservingTraversal1 :: ATraversal1 s t a b -> IndexPreservingTraversal1 s t a b Source #
Clone a
Traversal1
yielding an
IndexPreservingTraversal1
that passes through
whatever index it is composed with.
cloneIndexedTraversal1 :: AnIndexedTraversal1 i s t a b -> IndexedTraversal1 i s t a b Source #
Clone an
IndexedTraversal1
yielding an
IndexedTraversal1
with the same index.
itraverseOf :: ( Indexed i a (f b) -> s -> f t) -> (i -> a -> f b) -> s -> f t Source #
Traversal with an index.
NB:
When you don't need access to the index then you can just apply your
IndexedTraversal
directly as a function!
itraverseOf
≡withIndex
traverseOf
l =itraverseOf
l.
const
=id
itraverseOf
::Functor
f =>IndexedLens
i s t a b -> (i -> a -> f b) -> s -> f titraverseOf
::Applicative
f =>IndexedTraversal
i s t a b -> (i -> a -> f b) -> s -> f titraverseOf
::Apply
f =>IndexedTraversal1
i s t a b -> (i -> a -> f b) -> s -> f t
iforOf :: ( Indexed i a (f b) -> s -> f t) -> s -> (i -> a -> f b) -> f t Source #
Traverse with an index (and the arguments flipped).
forOf
l a ≡iforOf
l a.
const
iforOf
≡flip
.
itraverseOf
iforOf
::Functor
f =>IndexedLens
i s t a b -> s -> (i -> a -> f b) -> f tiforOf
::Applicative
f =>IndexedTraversal
i s t a b -> s -> (i -> a -> f b) -> f tiforOf
::Apply
f =>IndexedTraversal1
i s t a b -> s -> (i -> a -> f b) -> f t
imapMOf :: Over ( Indexed i) ( WrappedMonad m) s t a b -> (i -> a -> m b) -> s -> m t Source #
Map each element of a structure targeted by a
Lens
to a monadic action,
evaluate these actions from left to right, and collect the results, with access
its position.
When you don't need access to the index
mapMOf
is more liberal in what it can accept.
mapMOf
l ≡imapMOf
l.
const
imapMOf
::Monad
m =>IndexedLens
i s t a b -> (i -> a -> m b) -> s -> m timapMOf
::Monad
m =>IndexedTraversal
i s t a b -> (i -> a -> m b) -> s -> m timapMOf
::Bind
m =>IndexedTraversal1
i s t a b -> (i -> a -> m b) -> s -> m t
iforMOf :: ( Indexed i a ( WrappedMonad m b) -> s -> WrappedMonad m t) -> s -> (i -> a -> m b) -> m t Source #
Map each element of a structure targeted by a
Lens
to a monadic action,
evaluate these actions from left to right, and collect the results, with access
its position (and the arguments flipped).
forMOf
l a ≡iforMOf
l a.
const
iforMOf
≡flip
.
imapMOf
iforMOf
::Monad
m =>IndexedLens
i s t a b -> s -> (i -> a -> m b) -> m tiforMOf
::Monad
m =>IndexedTraversal
i s t a b -> s -> (i -> a -> m b) -> m t
imapAccumROf :: Over ( Indexed i) ( Backwards ( State acc)) s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t) Source #
Generalizes
mapAccumR
to an arbitrary
IndexedTraversal
with access to the index.
imapAccumROf
accumulates state from right to left.
mapAccumROf
l ≡imapAccumROf
l.
const
imapAccumROf
::IndexedLens
i s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)imapAccumROf
::IndexedTraversal
i s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
imapAccumLOf :: Over ( Indexed i) ( State acc) s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t) Source #
Generalizes
mapAccumL
to an arbitrary
IndexedTraversal
with access to the index.
imapAccumLOf
accumulates state from left to right.
mapAccumLOf
l ≡imapAccumLOf
l.
const
imapAccumLOf
::IndexedLens
i s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)imapAccumLOf
::IndexedTraversal
i s t a b -> (i -> acc -> a -> (acc, b)) -> acc -> s -> (acc, t)
traversed :: Traversable f => IndexedTraversal Int (f a) (f b) a b Source #
Traverse any
Traversable
container. This is an
IndexedTraversal
that is indexed by ordinal position.
traversed1 :: Traversable1 f => IndexedTraversal1 Int (f a) (f b) a b Source #
Traverse any
Traversable1
container. This is an
IndexedTraversal1
that is indexed by ordinal position.
traversed64 :: Traversable f => IndexedTraversal Int64 (f a) (f b) a b Source #
Traverse any
Traversable
container. This is an
IndexedTraversal
that is indexed by ordinal position.
ignored :: Applicative f => pafb -> s -> f s Source #
elementOf :: Applicative f => LensLike ( Indexing f) s t a a -> Int -> IndexedLensLike Int f s t a a Source #
Traverse the
nth
elementOf
a
Traversal
,
Lens
or
Iso
if it exists.
>>>
[[1],[3,4]] & elementOf (traverse.traverse) 1 .~ 5
[[1],[5,4]]
>>>
[[1],[3,4]] ^? elementOf (folded.folded) 1
Just 3
>>>
timingOut $ ['a'..] ^?! elementOf folded 5
'f'
>>>
timingOut $ take 10 $ elementOf traverse 3 .~ 16 $ [0..]
[0,1,2,16,4,5,6,7,8,9]
elementOf
::Traversal'
s a ->Int
->IndexedTraversal'
Int
s aelementOf
::Fold
s a ->Int
->IndexedFold
Int
s a
element :: Traversable t => Int -> IndexedTraversal' Int (t a) a Source #
Traverse the
nth
element of a
Traversable
container.
element
≡elementOf
traverse
elementsOf :: Applicative f => LensLike ( Indexing f) s t a a -> ( Int -> Bool ) -> IndexedLensLike Int f s t a a Source #
Traverse (or fold) selected elements of a
Traversal
(or
Fold
) where their ordinal positions match a predicate.
elementsOf
::Traversal'
s a -> (Int
->Bool
) ->IndexedTraversal'
Int
s aelementsOf
::Fold
s a -> (Int
->Bool
) ->IndexedFold
Int
s a
elements :: Traversable t => ( Int -> Bool ) -> IndexedTraversal' Int (t a) a Source #
Traverse elements of a
Traversable
container where their ordinal positions match a predicate.
elements
≡elementsOf
traverse
failover :: Alternative m => LensLike ( (,) Any ) s t a b -> (a -> b) -> s -> m t Source #
Try to map a function over this
Traversal
, failing if the
Traversal
has no targets.
>>>
failover (element 3) (*2) [1,2] :: Maybe [Int]
Nothing
>>>
failover _Left (*2) (Right 4) :: Maybe (Either Int Int)
Nothing
>>>
failover _Right (*2) (Right 4) :: Maybe (Either Int Int)
Just (Right 8)
failover
:: Alternative m => Traversal s t a b -> (a -> b) -> s -> m t
ifailover :: Alternative m => Over ( Indexed i) ( (,) Any ) s t a b -> (i -> a -> b) -> s -> m t Source #
Try to map a function which uses the index over this
IndexedTraversal
, failing if the
IndexedTraversal
has no targets.
ifailover
:: Alternative m => IndexedTraversal i s t a b -> (i -> a -> b) -> s -> m t
failing :: ( Conjoined p, Applicative f) => Traversing p f s t a b -> Over p f s t a b -> Over p f s t a b infixl 5 Source #
Try the first
Traversal
(or
Fold
), falling back on the second
Traversal
(or
Fold
) if it returns no entries.
This is only a valid
Traversal
if the second
Traversal
is disjoint from the result of the first or returns
exactly the same results. These conditions are trivially met when given a
Lens
,
Iso
,
Getter
,
Prism
or "affine" Traversal -- one that
has 0 or 1 target.
Mutatis mutandis for
Fold
.
>>>
[0,1,2,3] ^? failing (ix 1) (ix 2)
Just 1
>>>
[0,1,2,3] ^? failing (ix 42) (ix 2)
Just 2
failing
::Traversal
s t a b ->Traversal
s t a b ->Traversal
s t a bfailing
::Prism
s t a b ->Prism
s t a b ->Traversal
s t a bfailing
::Fold
s a ->Fold
s a ->Fold
s a
These cases are also supported, trivially, but are boring, because the left hand side always succeeds.
failing
::Lens
s t a b ->Traversal
s t a b ->Traversal
s t a bfailing
::Iso
s t a b ->Traversal
s t a b ->Traversal
s t a bfailing
::Equality
s t a b ->Traversal
s t a b ->Traversal
s t a bfailing
::Getter
s a ->Fold
s a ->Fold
s a
If both of the inputs are indexed, the result is also indexed, so you can apply this to a pair of indexed traversals or indexed folds, obtaining an indexed traversal or indexed fold.
failing
::IndexedTraversal
i s t a b ->IndexedTraversal
i s t a b ->IndexedTraversal
i s t a bfailing
::IndexedFold
i s a ->IndexedFold
i s a ->IndexedFold
i s a
These cases are also supported, trivially, but are boring, because the left hand side always succeeds.
failing
::IndexedLens
i s t a b ->IndexedTraversal
i s t a b ->IndexedTraversal
i s t a bfailing
::IndexedGetter
i s a ->IndexedGetter
i s a ->IndexedFold
i s a
deepOf :: ( Conjoined p, Applicative f) => LensLike f s t s t -> Traversing p f s t a b -> Over p f s t a b Source #
Try the second traversal. If it returns no entries, try again with all entries from the first traversal, recursively.
deepOf
::Fold
s s ->Fold
s a ->Fold
s adeepOf
::Traversal'
s s ->Traversal'
s a ->Traversal'
s adeepOf
::Traversal
s t s t ->Traversal
s t a b ->Traversal
s t a bdeepOf
::Fold
s s ->IndexedFold
i s a ->IndexedFold
i s adeepOf
::Traversal
s t s t ->IndexedTraversal
i s t a b ->IndexedTraversal
i s t a b
confusing :: Applicative f => LensLike ( Curried ( Yoneda f) ( Yoneda f)) s t a b -> LensLike f s t a b Source #
Fuse
a
Traversal
by reassociating all of the
(
operations to the
left and fusing all of the
<*>
)
fmap
calls into one. This is particularly
useful when constructing a
Traversal
using operations from
GHC.Generics
.
Given a pair of
Traversal
s
foo
and
bar
,
confusing
(foo.bar) = foo.bar
However,
foo
and
bar
are each going to use the
Applicative
they are given.
confusing
exploits the
Yoneda
lemma to merge their separate uses of
fmap
into a single
fmap
.
and it further exploits an interesting property of the right Kan lift (or
Curried
) to left associate
all of the uses of
(
to make it possible to fuse together more fmaps.
<*>
)
This is particularly effective when the choice of functor
f
is unknown at compile
time or when the
Traversal
foo.bar
in the above description is recursive or complex
enough to prevent inlining.
fusing
is a version of this combinator suitable for fusing lenses.
confusing
::Traversal
s t a b ->Traversal
s t a b
traverseByOf :: Traversal s t a b -> ( forall x. x -> f x) -> ( forall x y. f (x -> y) -> f x -> f y) -> (a -> f b) -> s -> f t Source #
Traverse a container using a specified
Applicative
.
This is like
traverseBy
where the
Traversable
instance can be specified by any
Traversal
traverseByOf
traverse
≡traverseBy
sequenceByOf :: Traversal s t (f b) b -> ( forall x. x -> f x) -> ( forall x y. f (x -> y) -> f x -> f y) -> s -> f t Source #
Sequence a container using a specified
Applicative
.
This is like
traverseBy
where the
Traversable
instance can be specified by any
Traversal
sequenceByOf
traverse
≡sequenceBy
levels :: Applicative f => Traversing (->) f s t a b -> IndexedLensLike Int f s t ( Level () a) ( Level () b) Source #
This provides a breadth-first
Traversal
or
Fold
of the individual
levels
of any other
Traversal
or
Fold
via iterative deepening
depth-first search. The levels are returned to you in a compressed format.
This can permit us to extract the
levels
directly:
>>>
["hello","world"]^..levels (traverse.traverse)
[Zero,Zero,One () 'h',Two 0 (One () 'e') (One () 'w'),Two 0 (One () 'l') (One () 'o'),Two 0 (One () 'l') (One () 'r'),Two 0 (One () 'o') (One () 'l'),One () 'd']
But we can also traverse them in turn:
>>>
["hello","world"]^..levels (traverse.traverse).traverse
"hewlolrold"
We can use this to traverse to a fixed depth in the tree of (
<*>
) used in the
Traversal
:
>>>
["hello","world"] & taking 4 (levels (traverse.traverse)).traverse %~ toUpper
["HEllo","World"]
Or we can use it to traverse the first
n
elements in found in that
Traversal
regardless of the depth
at which they were found.
>>>
["hello","world"] & taking 4 (levels (traverse.traverse).traverse) %~ toUpper
["HELlo","World"]
The resulting
Traversal
of the
levels
which is indexed by the depth of each
Level
.
>>>
["dog","cat"]^@..levels (traverse.traverse) <. traverse
[(2,'d'),(3,'o'),(3,'c'),(4,'g'),(4,'a'),(5,'t')]
levels
::Traversal
s t a b ->IndexedTraversal
Int
s t (Level
() a) (Level
() b)levels
::Fold
s a ->IndexedFold
Int
s (Level
() a)
Note:
Internally this is implemented by using an illegal
Applicative
, as it extracts information
in an order that violates the
Applicative
laws.
ilevels :: Applicative f => Traversing ( Indexed i) f s t a b -> IndexedLensLike Int f s t ( Level i a) ( Level j b) Source #
This provides a breadth-first
Traversal
or
Fold
of the individual
levels of any other
Traversal
or
Fold
via iterative deepening depth-first
search. The levels are returned to you in a compressed format.
This is similar to
levels
, but retains the index of the original
IndexedTraversal
, so you can
access it when traversing the levels later on.
>>>
["dog","cat"]^@..ilevels (traversed<.>traversed).itraversed
[((0,0),'d'),((0,1),'o'),((1,0),'c'),((0,2),'g'),((1,1),'a'),((1,2),'t')]
The resulting
Traversal
of the levels which is indexed by the depth of each
Level
.
>>>
["dog","cat"]^@..ilevels (traversed<.>traversed)<.>itraversed
[((2,(0,0)),'d'),((3,(0,1)),'o'),((3,(1,0)),'c'),((4,(0,2)),'g'),((4,(1,1)),'a'),((5,(1,2)),'t')]
ilevels
::IndexedTraversal
i s t a b ->IndexedTraversal
Int
s t (Level
i a) (Level
i b)ilevels
::IndexedFold
i s a ->IndexedFold
Int
s (Level
i a)
Note:
Internally this is implemented by using an illegal
Applicative
, as it extracts information
in an order that violates the
Applicative
laws.
type ReifiedPrism' s a = ReifiedPrism s s a a Source #
typeReifiedPrism'
=Simple
ReifiedPrism
newtype ReifiedPrism s t a b Source #
Reify a
Prism
so it can be stored safely in a container.
type ReifiedIso' s a = ReifiedIso s s a a Source #
typeReifiedIso'
=Simple
ReifiedIso
newtype ReifiedIso s t a b Source #
Reify an
Iso
so it can be stored safely in a container.
type ReifiedIndexedSetter' i s a = ReifiedIndexedSetter i s s a a Source #
typeReifiedIndexedSetter'
i =Simple
(ReifiedIndexedSetter
i)
newtype ReifiedIndexedSetter i s t a b Source #
Reify an
IndexedSetter
so it can be stored safely in a container.
IndexedSetter | |
|
type ReifiedSetter' s a = ReifiedSetter s s a a Source #
typeReifiedSetter'
=Simple
ReifiedSetter
newtype ReifiedSetter s t a b Source #
Reify a
Setter
so it can be stored safely in a container.
newtype ReifiedIndexedFold i s a Source #
IndexedFold | |
|
Instances
newtype ReifiedFold s a Source #
Reify a
Fold
so it can be stored safely in a container.
This can also be useful for creatively combining folds as
is isomorphic to
ReifiedFold
s
ReaderT s []
and provides similar
instances.
>>>
("hello","world")^..runFold ((,) <$> Fold _2 <*> Fold both)
[("world","hello"),("world","world")]
Instances
newtype ReifiedIndexedGetter i s a Source #
Reify an
IndexedGetter
so it can be stored safely in a container.
IndexedGetter | |
|
Instances
newtype ReifiedGetter s a Source #
Reify a
Getter
so it can be stored safely in a container.
This can also be useful when combining getters in novel ways, as
ReifiedGetter
is isomorphic to
(->)
and provides similar instances.
>>>
("hello","world","!!!")^.runGetter ((,) <$> Getter _2 <*> Getter (_1.to length))
("world",5)
Instances
type ReifiedTraversal' s a = ReifiedTraversal s s a a Source #
newtype ReifiedTraversal s t a b Source #
A form of
Traversal
that can be stored monomorphically in a container.
Traversal | |
|
type ReifiedIndexedTraversal' i s a = ReifiedIndexedTraversal i s s a a Source #
typeReifiedIndexedTraversal'
i =Simple
(ReifiedIndexedTraversal
i)
newtype ReifiedIndexedTraversal i s t a b Source #
Reify an
IndexedTraversal
so it can be stored safely in a container.
IndexedTraversal | |
|
type ReifiedIndexedLens' i s a = ReifiedIndexedLens i s s a a Source #
typeReifiedIndexedLens'
i =Simple
(ReifiedIndexedLens
i)
newtype ReifiedIndexedLens i s t a b Source #
Reify an
IndexedLens
so it can be stored safely in a container.
IndexedLens | |
|
type ReifiedLens' s a = ReifiedLens s s a a Source #
typeReifiedLens'
=Simple
ReifiedLens
newtype ReifiedLens s t a b Source #
Reify a
Lens
so it can be stored safely in a container.
selfIndex :: Indexable a p => p a fb -> a -> fb Source #
Use a value itself as its own index. This is essentially an indexed version of
id
.
Note: When used to modify the value, this can break the index requirements assumed by
indices
and similar,
so this is only properly an
IndexedGetter
, but it can be used as more.
selfIndex
::ÂIndexedGetter
a a b
reindexed :: Indexable j p => (i -> j) -> ( Indexed i a b -> r) -> p a b -> r Source #
Remap the index.
icompose :: Indexable p c => (i -> j -> p) -> ( Indexed i s t -> r) -> ( Indexed j a b -> s -> t) -> c a b -> r Source #
Composition of
Indexed
functions with a user supplied function for combining indices.
indices :: ( Indexable i p, Applicative f) => (i -> Bool ) -> Optical' p ( Indexed i) f a a Source #
This allows you to filter an
IndexedFold
,
IndexedGetter
,
IndexedTraversal
or
IndexedLens
based on a predicate
on the indices.
>>>
["hello","the","world","!!!"]^..traversed.indices even
["hello","world"]
>>>
over (traversed.indices (>0)) Prelude.reverse $ ["He","was","stressed","o_O"]
["He","saw","desserts","O_o"]
index :: ( Indexable i p, Eq i, Applicative f) => i -> Optical' p ( Indexed i) f a a Source #
This allows you to filter an
IndexedFold
,
IndexedGetter
,
IndexedTraversal
or
IndexedLens
based on an index.
>>>
["hello","the","world","!!!"]^?traversed.index 2
Just "world"
imapped :: FunctorWithIndex i f => IndexedSetter i (f a) (f b) a b Source #
The
IndexedSetter
for a
FunctorWithIndex
.
If you don't need access to the index, then
mapped
is more flexible in what it accepts.
ifolded :: FoldableWithIndex i f => IndexedFold i (f a) a Source #
The
IndexedFold
of a
FoldableWithIndex
container.
is a fold over the keys of a
ifolded
.
asIndex
FoldableWithIndex
.
>>>
Data.Map.fromList [(2, "hello"), (1, "world")]^..ifolded.asIndex
[1,2]
itraversed :: TraversableWithIndex i t => IndexedTraversal i (t a) (t b) a b Source #
The
IndexedTraversal
of a
TraversableWithIndex
container.
ifoldMapBy :: FoldableWithIndex i t => (r -> r -> r) -> r -> (i -> a -> r) -> t a -> r Source #
ifoldMapByOf :: IndexedFold i t a -> (r -> r -> r) -> r -> (i -> a -> r) -> t -> r Source #
itraverseBy :: TraversableWithIndex i t => ( forall x. x -> f x) -> ( forall x y. f (x -> y) -> f x -> f y) -> (i -> a -> f b) -> t a -> f (t b) Source #
itraverseByOf :: IndexedTraversal i s t a b -> ( forall x. x -> f x) -> ( forall x y. f (x -> y) -> f x -> f y) -> (i -> a -> f b) -> s -> f t Source #
type AnEquality' s a = AnEquality s s a a Source #
A
Simple
AnEquality
.
type AnEquality s t a b = Identical a ( Proxy b) a ( Proxy b) -> Identical a ( Proxy b) s ( Proxy t) Source #
When you see this as an argument to a function, it expects an
Equality
.
substEq :: forall s t a b rep (r :: TYPE rep). AnEquality s t a b -> ((s ~ a, t ~ b) => r) -> r Source #
Substituting types with
Equality
.
mapEq :: forall k1 k2 (s :: k1) (t :: k2) (a :: k1) (b :: k2) (f :: k1 -> Type ). AnEquality s t a b -> f s -> f a Source #
We can use
Equality
to do substitution into anything.
simply :: forall p f s a rep (r :: TYPE rep). ( Optic' p f s a -> r) -> Optic' p f s a -> r Source #
This is an adverb that can be used to modify many other
Lens
combinators to make them require
simple lenses, simple traversals, simple prisms or simple isos as input.
cloneEquality :: AnEquality s t a b -> Equality s t a b Source #
equality :: (s :~: a) -> (b :~: t) -> Equality s t a b Source #
Construct an
Equality
from explicit equality evidence.
overEquality :: AnEquality s t a b -> p a b -> p s t Source #
Recover a "profunctor lens" form of equality. Reverses
fromLeibniz
.
underEquality :: AnEquality s t a b -> p t s -> p b a Source #
The opposite of working
overEquality
is working
underEquality
.
fromLeibniz :: ( Identical a b a b -> Identical a b s t) -> Equality s t a b Source #
Convert a "profunctor lens" form of equality to an equality. Reverses
overEquality
.
The type should be understood as
fromLeibniz :: (forall p. p a b -> p s t) -> Equality s t a b
withEquality :: forall s t a b rep (r :: TYPE rep). AnEquality s t a b -> ((s :~: a) -> (b :~: t) -> r) -> r Source #
A version of
substEq
that provides explicit, rather than implicit,
equality evidence.
type AnIso s t a b = Exchange a b a ( Identity b) -> Exchange a b s ( Identity t) Source #
When you see this as an argument to a function, it expects an
Iso
.
withIso :: forall s t a b rep (r :: TYPE rep). AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r Source #
Extract the two functions, one from
s -> a
and
one from
b -> t
that characterize an
Iso
.
cloneIso :: AnIso s t a b -> Iso s t a b Source #
Convert from
AnIso
back to any
Iso
.
This is useful when you need to store an isomorphism as a data type inside a container and later reconstitute it as an overloaded function.
See
cloneLens
or
cloneTraversal
for more information on why you might want to do this.
au :: Functor f => AnIso s t a b -> ((b -> t) -> f s) -> f a Source #
Based on
ala
from Conor McBride's work on Epigram.
This version is generalized to accept any
Iso
, not just a
newtype
.
>>>
au (_Wrapping Sum) foldMap [1,2,3,4]
10
You may want to think of this combinator as having the following, simpler type:
au :: AnIso s t a b -> ((b -> t) -> e -> s) -> e -> a
au = xplat . from
auf :: ( Functor f, Functor g) => AnIso s t a b -> (f t -> g s) -> f b -> g a Source #
Based on
ala'
from Conor McBride's work on Epigram.
This version is generalized to accept any
Iso
, not just a
newtype
.
For a version you pass the name of the
newtype
constructor to, see
alaf
.
>>>
auf (_Wrapping Sum) (foldMapOf both) Prelude.length ("hello","world")
10
Mnemonically, the German
auf
plays a similar role to
à la
, and the combinator
is
au
with an extra function argument:
auf
::Iso
s t a b -> ((r -> t) -> e -> s) -> (r -> b) -> e -> a
but the signature is general.
Note: The direction of the
Iso
required for this function changed in
lens
4.18 to match up
with the behavior of
au
. For the old behavior use
xplatf
or for a version that is compatible
across both old and new versions of
lens
you can just use
coerce
!
enum :: Enum a => Iso' Int a Source #
This isomorphism can be used to convert to or from an instance of
Enum
.
>>>
LT^.from enum
0
>>>
97^.enum :: Char
'a'
Note: this is only an isomorphism from the numeric range actually used
and it is a bit of a pleasant fiction, since there are questionable
Enum
instances for
Double
, and
Float
that exist solely for
[1.0 .. 4.0]
sugar and the instances for those and
Integer
don't
cover all values in their range.
non :: Eq a => a -> Iso' ( Maybe a) a Source #
If
v
is an element of a type
a
, and
a'
is
a
sans the element
v
, then
is an isomorphism from
non
v
to
Maybe
a'
a
.
non
≡non'
.
only
Keep in mind this is only a real isomorphism if you treat the domain as being
.
Maybe
(a sans v)
This is practically quite useful when you want to have a
Map
where all the entries should have non-zero values.
>>>
Map.fromList [("hello",1)] & at "hello" . non 0 +~ 2
fromList [("hello",3)]
>>>
Map.fromList [("hello",1)] & at "hello" . non 0 -~ 1
fromList []
>>>
Map.fromList [("hello",1)] ^. at "hello" . non 0
1
>>>
Map.fromList [] ^. at "hello" . non 0
0
This combinator is also particularly useful when working with nested maps.
e.g.
When you want to create the nested
Map
when it is missing:
>>>
Map.empty & at "hello" . non Map.empty . at "world" ?~ "!!!"
fromList [("hello",fromList [("world","!!!")])]
and when have deleting the last entry from the nested
Map
mean that we
should delete its entry from the surrounding one:
>>>
Map.fromList [("hello",Map.fromList [("world","!!!")])] & at "hello" . non Map.empty . at "world" .~ Nothing
fromList []
It can also be used in reverse to exclude a given value:
>>>
non 0 # rem 10 4
Just 2
>>>
non 0 # rem 10 5
Nothing
non' :: APrism' a () -> Iso' ( Maybe a) a Source #
generalizes
non'
p
to take any unit
non
(p # ())
Prism
This function generates an isomorphism between
and
Maybe
(a |
isn't
p a)
a
.
>>>
Map.singleton "hello" Map.empty & at "hello" . non' _Empty . at "world" ?~ "!!!"
fromList [("hello",fromList [("world","!!!")])]
>>>
Map.fromList [("hello",Map.fromList [("world","!!!")])] & at "hello" . non' _Empty . at "world" .~ Nothing
fromList []
anon :: a -> (a -> Bool ) -> Iso' ( Maybe a) a Source #
generalizes
anon
a p
to take any value and a predicate.
non
a
This function assumes that
p a
holds
and generates an isomorphism between
True
and
Maybe
(a |
not
(p a))
a
.
>>>
Map.empty & at "hello" . anon Map.empty Map.null . at "world" ?~ "!!!"
fromList [("hello",fromList [("world","!!!")])]
>>>
Map.fromList [("hello",Map.fromList [("world","!!!")])] & at "hello" . anon Map.empty Map.null . at "world" .~ Nothing
fromList []
flipped :: Iso (a -> b -> c) (a' -> b' -> c') (b -> a -> c) (b' -> a' -> c') Source #
The isomorphism for flipping a function.
>>>
((,)^.flipped) 1 2
(2,1)
reversed :: Reversing a => Iso' a a Source #
An
Iso
between a list,
ByteString
,
Text
fragment, etc. and its reversal.
>>>
"live" ^. reversed
"evil"
>>>
"live" & reversed %~ ('d':)
"lived"
imagma :: Over ( Indexed i) ( Molten i a b) s t a b -> Iso s t' ( Magma i t b a) ( Magma j t' c c) Source #
This isomorphism can be used to inspect an
IndexedTraversal
to see how it associates
the structure and it can also be used to bake the
IndexedTraversal
into a
Magma
so
that you can traverse over it multiple times with access to the original indices.
contramapping :: Contravariant f => AnIso s t a b -> Iso (f a) (f b) (f s) (f t) Source #
Lift an
Iso
into a
Contravariant
functor.
contramapping ::Contravariant
f =>Iso
s t a b ->Iso
(f a) (f b) (f s) (f t) contramapping ::Contravariant
f =>Iso'
s a ->Iso'
(f a) (f s)
dimapping :: ( Profunctor p, Profunctor q) => AnIso s t a b -> AnIso s' t' a' b' -> Iso (p a s') (q b t') (p s a') (q t b') Source #
Lift two
Iso
s into both arguments of a
Profunctor
simultaneously.
dimapping ::Profunctor
p =>Iso
s t a b ->Iso
s' t' a' b' ->Iso
(p a s') (p b t') (p s a') (p t b') dimapping ::Profunctor
p =>Iso'
s a ->Iso'
s' a' ->Iso'
(p a s') (p s a')
lmapping :: ( Profunctor p, Profunctor q) => AnIso s t a b -> Iso (p a x) (q b y) (p s x) (q t y) Source #
Lift an
Iso
contravariantly into the left argument of a
Profunctor
.
lmapping ::Profunctor
p =>Iso
s t a b ->Iso
(p a x) (p b y) (p s x) (p t y) lmapping ::Profunctor
p =>Iso'
s a ->Iso'
(p a x) (p s x)
rmapping :: ( Profunctor p, Profunctor q) => AnIso s t a b -> Iso (p x s) (q y t) (p x a) (q y b) Source #
Lift an
Iso
covariantly into the right argument of a
Profunctor
.
rmapping ::Profunctor
p =>Iso
s t a b ->Iso
(p x s) (p y t) (p x a) (p y b) rmapping ::Profunctor
p =>Iso'
s a ->Iso'
(p x s) (p x a)
bimapping :: ( Bifunctor f, Bifunctor g) => AnIso s t a b -> AnIso s' t' a' b' -> Iso (f s s') (g t t') (f a a') (g b b') Source #
firsting :: ( Bifunctor f, Bifunctor g) => AnIso s t a b -> Iso (f s x) (g t y) (f a x) (g b y) Source #
seconding :: ( Bifunctor f, Bifunctor g) => AnIso s t a b -> Iso (f x s) (g y t) (f x a) (g y b) Source #
Lift an
Iso
into the second argument of a
Bifunctor
. This is
essentially the same as
mapping
, but it takes a 'Bifunctor p'
constraint instead of a 'Functor (p a)' one.
seconding ::Bifunctor
p =>Iso
s t a b ->Iso
(p x s) (p y t) (p x a) (p y b) seconding ::Bifunctor
p =>Iso'
s a ->Iso'
(p x s) (p x a)
coerced :: forall s t a b. ( Coercible s a, Coercible t b) => Iso s t a b Source #
Data types that are representationally equal are isomorphic.
This is only available on GHC 7.8+
Since: 4.13
class AsEmpty a where Source #
Nothing
Instances
class Snoc s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
This class provides a way to attach or detach elements on the right side of a structure in a flexible manner.
Instances
Snoc ByteString ByteString Word8 Word8 Source # | |
Defined in Control.Lens.Cons _Snoc :: Prism ByteString ByteString ( ByteString , Word8 ) ( ByteString , Word8 ) Source # |
|
Snoc ByteString ByteString Word8 Word8 Source # | |
Defined in Control.Lens.Cons _Snoc :: Prism ByteString ByteString ( ByteString , Word8 ) ( ByteString , Word8 ) Source # |
|
Snoc Text Text Char Char Source # | |
Snoc Text Text Char Char Source # | |
Snoc [a] [b] a b Source # | |
Defined in Control.Lens.Cons |
|
Snoc ( ZipList a) ( ZipList b) a b Source # | |
Snoc ( Seq a) ( Seq b) a b Source # | |
( Unbox a, Unbox b) => Snoc ( Vector a) ( Vector b) a b Source # | |
( Storable a, Storable b) => Snoc ( Vector a) ( Vector b) a b Source # | |
( Prim a, Prim b) => Snoc ( Vector a) ( Vector b) a b Source # | |
Snoc ( Vector a) ( Vector b) a b Source # | |
Snoc ( Deque a) ( Deque b) a b Source # | |
class Cons s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
This class provides a way to attach or detach elements on the left side of a structure in a flexible manner.
Instances
Cons ByteString ByteString Word8 Word8 Source # | |
Defined in Control.Lens.Cons _Cons :: Prism ByteString ByteString ( Word8 , ByteString ) ( Word8 , ByteString ) Source # |
|
Cons ByteString ByteString Word8 Word8 Source # | |
Defined in Control.Lens.Cons _Cons :: Prism ByteString ByteString ( Word8 , ByteString ) ( Word8 , ByteString ) Source # |
|
Cons Text Text Char Char Source # | |
Cons Text Text Char Char Source # | |
Cons [a] [b] a b Source # | |
Defined in Control.Lens.Cons |
|
Cons ( ZipList a) ( ZipList b) a b Source # | |
Cons ( Seq a) ( Seq b) a b Source # | |
( Unbox a, Unbox b) => Cons ( Vector a) ( Vector b) a b Source # | |
( Storable a, Storable b) => Cons ( Vector a) ( Vector b) a b Source # | |
( Prim a, Prim b) => Cons ( Vector a) ( Vector b) a b Source # | |
Cons ( Vector a) ( Vector b) a b Source # | |
Cons ( Deque a) ( Deque b) a b Source # | |
cons :: Cons s s a a => a -> s -> s infixr 5 Source #
cons
an element onto a container.
>>>
cons a []
[a]
>>>
cons a [b, c]
[a,b,c]
>>>
cons a (Seq.fromList [])
fromList [a]
>>>
cons a (Seq.fromList [b, c])
fromList [a,b,c]
uncons :: Cons s s a a => s -> Maybe (a, s) Source #
Attempt to extract the left-most element from a container, and a version of the container without that element.
>>>
uncons []
Nothing
>>>
uncons [a, b, c]
Just (a,[b,c])
_head :: Cons s s a a => Traversal' s a Source #
A
Traversal
reading and writing to the
head
of a
non-empty
container.
>>>
[a,b,c]^? _head
Just a
>>>
[a,b,c] & _head .~ d
[d,b,c]
>>>
[a,b,c] & _head %~ f
[f a,b,c]
>>>
[] & _head %~ f
[]
>>>
[1,2,3]^?!_head
1
>>>
[]^?_head
Nothing
>>>
[1,2]^?_head
Just 1
>>>
[] & _head .~ 1
[]
>>>
[0] & _head .~ 2
[2]
>>>
[0,1] & _head .~ 2
[2,1]
This isn't limited to lists.
For instance you can also
traverse
the head of a
Seq
:
>>>
Seq.fromList [a,b,c,d] & _head %~ f
fromList [f a,b,c,d]
>>>
Seq.fromList [] ^? _head
Nothing
>>>
Seq.fromList [a,b,c,d] ^? _head
Just a
_head
::Traversal'
[a] a_head
::Traversal'
(Seq
a) a_head
::Traversal'
(Vector
a) a
_tail :: Cons s s a a => Traversal' s s Source #
A
Traversal
reading and writing to the
tail
of a
non-empty
container.
>>>
[a,b] & _tail .~ [c,d,e]
[a,c,d,e]
>>>
[] & _tail .~ [a,b]
[]
>>>
[a,b,c,d,e] & _tail.traverse %~ f
[a,f b,f c,f d,f e]
>>>
[1,2] & _tail .~ [3,4,5]
[1,3,4,5]
>>>
[] & _tail .~ [1,2]
[]
>>>
[a,b,c]^?_tail
Just [b,c]
>>>
[1,2]^?!_tail
[2]
>>>
"hello"^._tail
"ello"
>>>
""^._tail
""
This isn't limited to lists. For instance you can also
traverse
the tail of a
Seq
.
>>>
Seq.fromList [a,b] & _tail .~ Seq.fromList [c,d,e]
fromList [a,c,d,e]
>>>
Seq.fromList [a,b,c] ^? _tail
Just (fromList [b,c])
>>>
Seq.fromList [] ^? _tail
Nothing
_tail
::Traversal'
[a] [a]_tail
::Traversal'
(Seq
a) (Seq
a)_tail
::Traversal'
(Vector
a) (Vector
a)
_init :: Snoc s s a a => Traversal' s s Source #
A
Traversal
reading and replacing all but the a last element of a
non-empty
container.
>>>
[a,b,c,d]^?_init
Just [a,b,c]
>>>
[]^?_init
Nothing
>>>
[a,b] & _init .~ [c,d,e]
[c,d,e,b]
>>>
[] & _init .~ [a,b]
[]
>>>
[a,b,c,d] & _init.traverse %~ f
[f a,f b,f c,d]
>>>
[1,2,3]^?_init
Just [1,2]
>>>
[1,2,3,4]^?!_init
[1,2,3]
>>>
"hello"^._init
"hell"
>>>
""^._init
""
_init
::Traversal'
[a] [a]_init
::Traversal'
(Seq
a) (Seq
a)_init
::Traversal'
(Vector
a) (Vector
a)
_last :: Snoc s s a a => Traversal' s a Source #
A
Traversal
reading and writing to the last element of a
non-empty
container.
>>>
[a,b,c]^?!_last
c
>>>
[]^?_last
Nothing
>>>
[a,b,c] & _last %~ f
[a,b,f c]
>>>
[1,2]^?_last
Just 2
>>>
[] & _last .~ 1
[]
>>>
[0] & _last .~ 2
[2]
>>>
[0,1] & _last .~ 2
[0,2]
This
Traversal
is not limited to lists, however. We can also work with other containers, such as a
Vector
.
>>>
Vector.fromList "abcde" ^? _last
Just 'e'
>>>
Vector.empty ^? _last
Nothing
>>>
(Vector.fromList "abcde" & _last .~ 'Q') == Vector.fromList "abcdQ"
True
_last
::Traversal'
[a] a_last
::Traversal'
(Seq
a) a_last
::Traversal'
(Vector
a) a
snoc :: Snoc s s a a => s -> a -> s infixl 5 Source #
snoc
an element onto the end of a container.
>>>
snoc (Seq.fromList []) a
fromList [a]
>>>
snoc (Seq.fromList [b, c]) a
fromList [b,c,a]
>>>
snoc (LazyT.pack "hello") '!'
"hello!"
unsnoc :: Snoc s s a a => s -> Maybe (s, a) Source #
Attempt to extract the right-most element from a container, and a version of the container without that element.
>>>
unsnoc (LazyT.pack "hello!")
Just ("hello",'!')
>>>
unsnoc (LazyT.pack "")
Nothing
>>>
unsnoc (Seq.fromList [b,c,a])
Just (fromList [b,c],a)
>>>
unsnoc (Seq.fromList [])
Nothing
class ( Rewrapped s t, Rewrapped t s) => Rewrapping s t Source #
Instances
( Rewrapped s t, Rewrapped t s) => Rewrapping s t Source # | |
Defined in Control.Lens.Wrapped |
class Wrapped s => Rewrapped (s :: *) (t :: *) Source #
Instances
class Wrapped s where Source #
Wrapped
provides isomorphisms to wrap and unwrap newtypes or
data types with one constructor.
Nothing
_Wrapped' :: Iso' s ( Unwrapped s) Source #
An isomorphism between
s
and
a
.
If your type has a
Generic
instance,
_Wrapped'
will default to
_GWrapped'
,
and you can choose to not override it with your own definition.
Instances
_GWrapped' :: ( Generic s, D1 d ( C1 c ( S1 s' ( Rec0 a))) ~ Rep s, Unwrapped s ~ GUnwrapped ( Rep s)) => Iso' s ( Unwrapped s) Source #
_Wrapped :: Rewrapping s t => Iso s t ( Unwrapped s) ( Unwrapped t) Source #
Work under a newtype wrapper.
>>>
Const "hello" & _Wrapped %~ Prelude.length & getConst
5
_Wrapped
≡from
_Unwrapped
_Unwrapped
≡from
_Wrapped
_Unwrapped :: Rewrapping s t => Iso ( Unwrapped t) ( Unwrapped s) t s Source #
_Wrapping' :: Wrapped s => ( Unwrapped s -> s) -> Iso' s ( Unwrapped s) Source #
This is a convenient version of
_Wrapped
with an argument that's ignored.
The user supplied function is ignored , merely its type is used.
_Unwrapping' :: Wrapped s => ( Unwrapped s -> s) -> Iso' ( Unwrapped s) s Source #
This is a convenient version of
_Wrapped
with an argument that's ignored.
The user supplied function is ignored , merely its type is used.
_Wrapping :: Rewrapping s t => ( Unwrapped s -> s) -> Iso s t ( Unwrapped s) ( Unwrapped t) Source #
This is a convenient version of
_Wrapped
with an argument that's ignored.
The user supplied function is ignored , merely its types are used.
_Unwrapping :: Rewrapping s t => ( Unwrapped s -> s) -> Iso ( Unwrapped t) ( Unwrapped s) t s Source #
This is a convenient version of
_Unwrapped
with an argument that's ignored.
The user supplied function is ignored , merely its types are used.
ala :: ( Functor f, Rewrapping s t) => ( Unwrapped s -> s) -> (( Unwrapped t -> t) -> f s) -> f ( Unwrapped s) Source #
This combinator is based on
ala
from Conor McBride's work on Epigram.
As with
_Wrapping
, the user supplied function for the newtype is
ignored
.
>>>
ala Sum foldMap [1,2,3,4]
10
>>>
ala All foldMap [True,True]
True
>>>
ala All foldMap [True,False]
False
>>>
ala Any foldMap [False,False]
False
>>>
ala Any foldMap [True,False]
True
>>>
ala Product foldMap [1,2,3,4]
24
You may want to think of this combinator as having the following, simpler, type.
ala :: Rewrapping s t => (Unwrapped s -> s) -> ((Unwrapped t -> t) -> e -> s) -> e -> Unwrapped s
alaf :: ( Functor f, Functor g, Rewrapping s t) => ( Unwrapped s -> s) -> (f t -> g s) -> f ( Unwrapped t) -> g ( Unwrapped s) Source #
This combinator is based on
ala'
from Conor McBride's work on Epigram.
As with
_Wrapping
, the user supplied function for the newtype is
ignored
.
alaf :: Rewrapping s t => (Unwrapped s -> s) -> ((r -> t) -> e -> s) -> (r -> Unwrapped t) -> e -> Unwrapped s
>>>
alaf Sum foldMap Prelude.length ["hello","world"]
10
class ( Magnified m ~ Magnified n, MonadReader b m, MonadReader a n) => Magnify m n b a | m -> b, n -> a, m a -> n, n b -> m where Source #
This class allows us to use
magnify
part of the environment, changing the environment supplied by
many different
Monad
transformers. Unlike
zoom
this can change the environment of a deeply nested
Monad
transformer.
Also, unlike
zoom
, this can be used with any valid
Getter
, but cannot be used with a
Traversal
or
Fold
.
magnify :: (( Functor ( Magnified m c), Contravariant ( Magnified m c)) => LensLike' ( Magnified m c) a b) -> m c -> n c infixr 2 Source #
Run a monadic action in a larger environment than it was defined in, using a
Getter
.
This acts like
local
, but can in many cases change the type of the environment as well.
This is commonly used to lift actions in a simpler
Reader
Monad
into a
Monad
with a larger environment type.
This can be used to edit pretty much any
Monad
transformer stack with an environment in it:
>>>
(1,2) & magnify _2 (+1)
3
>>>
flip Reader.runReader (1,2) $ magnify _1 Reader.ask
1
>>>
flip Reader.runReader (1,2,[10..20]) $ magnify (_3._tail) Reader.ask
[11,12,13,14,15,16,17,18,19,20]
The type can be read as
magnify :: LensLike' (Magnified m c) a b -> m c -> n c
but the higher-rank constraints make it easier to apply
magnify
to a
Getter
in highly-polymorphic code.
magnify
::Getter
s a -> (a -> r) -> s -> rmagnify
::Monoid
r =>Fold
s a -> (a -> r) -> s -> r
magnify
::Monoid
w =>Getter
s t ->RWS
t w st c ->RWS
s w st cmagnify
:: (Monoid
w,Monoid
c) =>Fold
s a ->RWS
a w st c ->RWS
s w st c ...
Instances
Magnify m n b a => Magnify ( IdentityT m) ( IdentityT n) b a Source # | |
Monad m => Magnify ( ReaderT b m) ( ReaderT a m) b a Source # | |
Magnify ((->) b :: Type -> Type ) ((->) a :: Type -> Type ) b a Source # |
|
Defined in Control.Lens.Zoom |
|
( Monad m, Monoid w) => Magnify ( RWST b w s m) ( RWST a w s m) b a Source # | |
( Monad m, Monoid w) => Magnify ( RWST b w s m) ( RWST a w s m) b a Source # | |
class ( MonadState s m, MonadState t n) => Zoom m n s t | m -> s, n -> t, m t -> n, n s -> m where Source #
This class allows us to use
zoom
in, changing the
State
supplied by
many different
Monad
transformers, potentially quite
deep in a
Monad
transformer stack.
zoom :: LensLike' ( Zoomed m c) t s -> m c -> n c infixr 2 Source #
Run a monadic action in a larger
State
than it was defined in,
using a
Lens'
or
Traversal'
.
This is commonly used to lift actions in a simpler
State
Monad
into a
State
Monad
with a larger
State
type.
When applied to a
Traversal'
over
multiple values, the actions for each target are executed sequentially
and the results are aggregated.
This can be used to edit pretty much any
Monad
transformer stack with a
State
in it!
>>>
flip State.evalState (a,b) $ zoom _1 $ use id
a
>>>
flip State.execState (a,b) $ zoom _1 $ id .= c
(c,b)
>>>
flip State.execState [(a,b),(c,d)] $ zoom traverse $ _2 %= f
[(a,f b),(c,f d)]
>>>
flip State.runState [(a,b),(c,d)] $ zoom traverse $ _2 <%= f
(f b <> f d <> mempty,[(a,f b),(c,f d)])
>>>
flip State.evalState (a,b) $ zoom both (use id)
a <> b
zoom
::Monad
m =>Lens'
s t ->StateT
t m a ->StateT
s m azoom
:: (Monad
m,Monoid
c) =>Traversal'
s t ->StateT
t m c ->StateT
s m czoom
:: (Monad
m,Monoid
w) =>Lens'
s t ->RWST
r w t m c ->RWST
r w s m czoom
:: (Monad
m,Monoid
w,Monoid
c) =>Traversal'
s t ->RWST
r w t m c ->RWST
r w s m czoom
:: (Monad
m,Monoid
w,Error
e) =>Lens'
s t ->ErrorT
e (RWST
r w t m) c ->ErrorT
e (RWST
r w s m) czoom
:: (Monad
m,Monoid
w,Monoid
c,Error
e) =>Traversal'
s t ->ErrorT
e (RWST
r w t m) c ->ErrorT
e (RWST
r w s m) c ...
Instances
Zoom m n s t => Zoom ( MaybeT m) ( MaybeT n) s t Source # | |
Zoom m n s t => Zoom ( ListT m) ( ListT n) s t Source # | |
Zoom m n s t => Zoom ( IdentityT m) ( IdentityT n) s t Source # | |
Zoom m n s t => Zoom ( ExceptT e m) ( ExceptT e n) s t Source # | |
( Functor f, Zoom m n s t) => Zoom ( FreeT f m) ( FreeT f n) s t Source # | |
( Error e, Zoom m n s t) => Zoom ( ErrorT e m) ( ErrorT e n) s t Source # | |
Zoom m n s t => Zoom ( ReaderT e m) ( ReaderT e n) s t Source # | |
Monad z => Zoom ( StateT s z) ( StateT t z) s t Source # | |
Monad z => Zoom ( StateT s z) ( StateT t z) s t Source # | |
( Monoid w, Zoom m n s t) => Zoom ( WriterT w m) ( WriterT w n) s t Source # | |
( Monoid w, Zoom m n s t) => Zoom ( WriterT w m) ( WriterT w n) s t Source # | |
( Monoid w, Monad z) => Zoom ( RWST r w s z) ( RWST r w t z) s t Source # | |
( Monoid w, Monad z) => Zoom ( RWST r w s z) ( RWST r w t z) s t Source # | |
type family Magnified (m :: * -> *) :: * -> * -> * Source #
This type family is used by
Magnify
to describe the common effect type.
Instances
type Magnified ( IdentityT m) Source # | |
Defined in Control.Lens.Zoom |
|
type Magnified ( ReaderT b m) Source # | |
Defined in Control.Lens.Zoom |
|
type Magnified ((->) b :: Type -> Type ) Source # | |
type Magnified ( RWST a w s m) Source # | |
Defined in Control.Lens.Zoom |
|
type Magnified ( RWST a w s m) Source # | |
Defined in Control.Lens.Zoom |
type family Zoomed (m :: * -> *) :: * -> * -> * Source #
This type family is used by
Zoom
to describe the common effect type.
Instances
type Zoomed ( MaybeT m) Source # | |
Defined in Control.Lens.Zoom |
|
type Zoomed ( ListT m) Source # | |
Defined in Control.Lens.Zoom |
|
type Zoomed ( IdentityT m) Source # | |
Defined in Control.Lens.Zoom |
|
type Zoomed ( ExceptT e m) Source # | |
Defined in Control.Lens.Zoom |
|
type Zoomed ( FreeT f m) Source # | |
Defined in Control.Lens.Zoom |
|
type Zoomed ( ErrorT e m) Source # | |
Defined in Control.Lens.Zoom |
|
type Zoomed ( ReaderT e m) Source # | |
Defined in Control.Lens.Zoom |
|
type Zoomed ( StateT s z) Source # | |
Defined in Control.Lens.Zoom |
|
type Zoomed ( StateT s z) Source # | |
Defined in Control.Lens.Zoom |
|
type Zoomed ( WriterT w m) Source # | |
Defined in Control.Lens.Zoom |
|
type Zoomed ( WriterT w m) Source # | |
Defined in Control.Lens.Zoom |
|
type Zoomed ( RWST r w s z) Source # | |
Defined in Control.Lens.Zoom |
|
type Zoomed ( RWST r w s z) Source # | |
Defined in Control.Lens.Zoom |
gplate1'
Instances
GPlated1 (f :: k -> Type ) ( V1 :: k -> Type ) Source # |
ignored |
Defined in Control.Lens.Plated gplate1' :: forall (a :: k0). Traversal' ( V1 a) (f a) |
|
GPlated1 (f :: k -> Type ) ( U1 :: k -> Type ) Source # |
ignored |
Defined in Control.Lens.Plated gplate1' :: forall (a :: k0). Traversal' ( U1 a) (f a) |
|
GPlated1 (f :: k -> Type ) ( URec a :: k -> Type ) Source # |
ignored |
Defined in Control.Lens.Plated gplate1' :: forall (a0 :: k0). Traversal' ( URec a a0) (f a0) |
|
GPlated1 (f :: k -> Type ) ( Rec1 g :: k -> Type ) Source # |
ignored |
Defined in Control.Lens.Plated gplate1' :: forall (a :: k0). Traversal' ( Rec1 g a) (f a) |
|
GPlated1 (f :: k -> Type ) ( Rec1 f :: k -> Type ) Source # |
match |
Defined in Control.Lens.Plated gplate1' :: forall (a :: k0). Traversal' ( Rec1 f a) (f a) |
|
GPlated1 (f :: k -> Type ) ( K1 i a :: k -> Type ) Source # |
ignored |
Defined in Control.Lens.Plated gplate1' :: forall (a0 :: k0). Traversal' ( K1 i a a0) (f a0) |
|
( GPlated1 f g, GPlated1 f h) => GPlated1 (f :: k -> Type ) (g :*: h :: k -> Type ) Source # |
recursive match |
Defined in Control.Lens.Plated gplate1' :: forall (a :: k0). Traversal' ((g :*: h) a) (f a) |
|
( GPlated1 f g, GPlated1 f h) => GPlated1 (f :: k -> Type ) (g :+: h :: k -> Type ) Source # |
recursive match |
Defined in Control.Lens.Plated gplate1' :: forall (a :: k0). Traversal' ((g :+: h) a) (f a) |
|
( Traversable t, GPlated1 f g) => GPlated1 (f :: k1 -> Type ) (t :.: g :: k1 -> Type ) Source # |
recursive match under outer
|
Defined in Control.Lens.Plated gplate1' :: forall (a :: k). Traversal' ((t :.: g) a) (f a) |
|
GPlated1 f g => GPlated1 (f :: k -> Type ) ( M1 i c g :: k -> Type ) Source # |
recursive match |
Defined in Control.Lens.Plated gplate1' :: forall (a :: k0). Traversal' ( M1 i c g a) (f a) |
|
GPlated1 (f :: Type -> Type ) Par1 Source # |
ignored |
Defined in Control.Lens.Plated gplate1' :: forall (a :: k). Traversal' ( Par1 a) (f a) |
gplate'
Instances
GPlated a ( V1 :: k -> Type ) Source # | |
Defined in Control.Lens.Plated gplate' :: forall (p :: k0). Traversal' ( V1 p) a |
|
GPlated a ( U1 :: k -> Type ) Source # | |
Defined in Control.Lens.Plated gplate' :: forall (p :: k0). Traversal' ( U1 p) a |
|
GPlated a ( URec b :: k -> Type ) Source # | |
Defined in Control.Lens.Plated gplate' :: forall (p :: k0). Traversal' ( URec b p) a |
|
GPlated a ( K1 i b :: k -> Type ) Source # | |
Defined in Control.Lens.Plated gplate' :: forall (p :: k0). Traversal' ( K1 i b p) a |
|
GPlated a ( K1 i a :: k -> Type ) Source # | |
Defined in Control.Lens.Plated gplate' :: forall (p :: k0). Traversal' ( K1 i a p) a |
|
( GPlated a f, GPlated a g) => GPlated a (f :*: g :: k -> Type ) Source # | |
Defined in Control.Lens.Plated gplate' :: forall (p :: k0). Traversal' ((f :*: g) p) a |
|
( GPlated a f, GPlated a g) => GPlated a (f :+: g :: k -> Type ) Source # | |
Defined in Control.Lens.Plated gplate' :: forall (p :: k0). Traversal' ((f :+: g) p) a |
|
GPlated a f => GPlated a ( M1 i c f :: k -> Type ) Source # | |
Defined in Control.Lens.Plated gplate' :: forall (p :: k0). Traversal' ( M1 i c f p) a |
A
Plated
type is one where we know how to extract its immediate self-similar children.
Example 1 :
import Control.Applicative
import Control.Lens
import Control.Lens.Plated
import Data.Data
import Data.Data.Lens (uniplate
)
data Expr = ValInt
| Neg Expr | Add Expr Expr deriving (Eq
,Ord
,Show
,Read
,Data
,Typeable
)
instancePlated
Expr whereplate
f (Neg e) = Neg<$>
f eplate
f (Add a b) = Add<$>
f a<*>
f bplate
_ a =pure
a
or
instancePlated
Expr whereplate
=uniplate
Example 2 :
import Control.Applicative
import Control.Lens
import Control.Lens.Plated
import Data.Data
import Data.Data.Lens (uniplate
)
data Tree a = Bin (Tree a) (Tree a) | Tip a deriving (Eq
,Ord
,Show
,Read
,Data
,Typeable
)
instancePlated
(Tree a) whereplate
f (Bin l r) = Bin<$>
f l<*>
f rplate
_ t =pure
t
or
instanceData
a =>Plated
(Tree a) whereplate
=uniplate
Note the big distinction between these two implementations.
The former will only treat children directly in this tree as descendents, the latter will treat trees contained in the values under the tips also as descendants!
When in doubt, pick a
Traversal
and just use the various
...Of
combinators
rather than pollute
Plated
with orphan instances!
If you want to find something unplated and non-recursive with
biplate
use the
...OnOf
variant with
ignored
, though those usecases are much better served
in most cases by using the existing
Lens
combinators! e.g.
toListOf
biplate
≡universeOnOf
biplate
ignored
This same ability to explicitly pass the
Traversal
in question is why there is no
analogue to uniplate's
Biplate
.
Moreover, since we can allow custom traversals, we implement reasonable defaults for
polymorphic data types, that only
traverse
into themselves, and
not
their
polymorphic arguments.
Nothing
plate :: Traversal' a a Source #
Traversal
of the immediate children of this structure.
If you're using GHC 7.2 or newer and your type has a
Data
instance,
plate
will default to
uniplate
and you can choose to not override
it with your own definition.
default plate :: Data a => Traversal' a a Source #
Instances
Plated Exp Source # | |
Defined in Control.Lens.Plated |
|
Plated Pat Source # | |
Defined in Control.Lens.Plated |
|
Plated Type Source # | |
Defined in Control.Lens.Plated |
|
Plated Dec Source # | |
Defined in Control.Lens.Plated |
|
Plated Stmt Source # | |
Defined in Control.Lens.Plated |
|
Plated Con Source # | |
Defined in Control.Lens.Plated |
|
Plated [a] Source # | |
Defined in Control.Lens.Plated plate :: Traversal' [a] [a] Source # |
|
Plated ( Tree a) Source # | |
Defined in Control.Lens.Plated |
|
Traversable f => Plated ( Cofree f a) Source # | |
Defined in Control.Lens.Plated |
|
Traversable f => Plated ( F f a) Source # | |
Defined in Control.Lens.Plated |
|
Traversable f => Plated ( Free f a) Source # | |
Defined in Control.Lens.Plated |
|
( Traversable f, Traversable m) => Plated ( FreeT f m a) Source # | |
Defined in Control.Lens.Plated |
|
( Traversable f, Traversable w) => Plated ( CofreeT f w a) Source # | |
Defined in Control.Lens.Plated |
deep :: ( Conjoined p, Applicative f, Plated s) => Traversing p f s s a b -> Over p f s s a b Source #
Try to apply a traversal to all transitive descendants of a
Plated
container, but
do not recurse through matching descendants.
deep
::Plated
s =>Fold
s a ->Fold
s adeep
::Plated
s =>IndexedFold
s a ->IndexedFold
s adeep
::Plated
s =>Traversal
s s a b ->Traversal
s s a bdeep
::Plated
s =>IndexedTraversal
s s a b ->IndexedTraversal
s s a b
rewrite :: Plated a => (a -> Maybe a) -> a -> a Source #
Rewrite by applying a rule everywhere you can. Ensures that the rule cannot be applied anywhere in the result:
propRewrite r x =all
(isNothing
.
r) (universe
(rewrite
r x))
Usually
transform
is more appropriate, but
rewrite
can give better
compositionality. Given two single transformations
f
and
g
, you can
construct
\a -> f a
which performs both rewrites until a fixed point.
<|>
g a
rewriteOf :: ASetter a b a b -> (b -> Maybe a) -> a -> b Source #
Rewrite by applying a rule everywhere you can. Ensures that the rule cannot be applied anywhere in the result:
propRewriteOf l r x =all
(isNothing
.
r) (universeOf
l (rewriteOf
l r x))
Usually
transformOf
is more appropriate, but
rewriteOf
can give better
compositionality. Given two single transformations
f
and
g
, you can
construct
\a -> f a
which performs both rewrites until a fixed point.
<|>
g a
rewriteOf
::Iso'
a a -> (a ->Maybe
a) -> a -> arewriteOf
::Lens'
a a -> (a ->Maybe
a) -> a -> arewriteOf
::Traversal'
a a -> (a ->Maybe
a) -> a -> arewriteOf
::Setter'
a a -> (a ->Maybe
a) -> a -> a
rewriteOn :: Plated a => ASetter s t a a -> (a -> Maybe a) -> s -> t Source #
Rewrite recursively over part of a larger structure.
rewriteOn
::Plated
a =>Iso'
s a -> (a ->Maybe
a) -> s -> srewriteOn
::Plated
a =>Lens'
s a -> (a ->Maybe
a) -> s -> srewriteOn
::Plated
a =>Traversal'
s a -> (a ->Maybe
a) -> s -> srewriteOn
::Plated
a =>ASetter'
s a -> (a ->Maybe
a) -> s -> s
rewriteOnOf :: ASetter s t a b -> ASetter a b a b -> (b -> Maybe a) -> s -> t Source #
Rewrite recursively over part of a larger structure using a specified
Setter
.
rewriteOnOf
::Iso'
s a ->Iso'
a a -> (a ->Maybe
a) -> s -> srewriteOnOf
::Lens'
s a ->Lens'
a a -> (a ->Maybe
a) -> s -> srewriteOnOf
::Traversal'
s a ->Traversal'
a a -> (a ->Maybe
a) -> s -> srewriteOnOf
::Setter'
s a ->Setter'
a a -> (a ->Maybe
a) -> s -> s
rewriteM :: ( Monad m, Plated a) => (a -> m ( Maybe a)) -> a -> m a Source #
Rewrite by applying a monadic rule everywhere you can. Ensures that the rule cannot be applied anywhere in the result.
rewriteMOf :: Monad m => LensLike ( WrappedMonad m) a b a b -> (b -> m ( Maybe a)) -> a -> m b Source #
Rewrite by applying a monadic rule everywhere you recursing with a user-specified
Traversal
.
Ensures that the rule cannot be applied anywhere in the result.
rewriteMOn :: ( Monad m, Plated a) => LensLike ( WrappedMonad m) s t a a -> (a -> m ( Maybe a)) -> s -> m t Source #
Rewrite by applying a monadic rule everywhere inside of a structure located by a user-specified
Traversal
.
Ensures that the rule cannot be applied anywhere in the result.
rewriteMOnOf :: Monad m => LensLike ( WrappedMonad m) s t a b -> LensLike ( WrappedMonad m) a b a b -> (b -> m ( Maybe a)) -> s -> m t Source #
universe :: Plated a => a -> [a] Source #
Retrieve all of the transitive descendants of a
Plated
container, including itself.
universeOf :: Getting [a] a a -> a -> [a] Source #
Given a
Fold
that knows how to locate immediate children, retrieve all of the transitive descendants of a node, including itself.
universeOf
::Fold
a a -> a -> [a]
universeOn :: Plated a => Getting [a] s a -> s -> [a] Source #
universeOnOf :: Getting [a] s a -> Getting [a] a a -> s -> [a] Source #
Given a
Fold
that knows how to locate immediate children, retrieve all of the transitive descendants of a node, including itself that lie
in a region indicated by another
Fold
.
toListOf
l ≡universeOnOf
lignored
cosmos :: Plated a => Fold a a Source #
Fold over all transitive descendants of a
Plated
container, including itself.
cosmosOf :: ( Applicative f, Contravariant f) => LensLike' f a a -> LensLike' f a a Source #
cosmosOn :: ( Applicative f, Contravariant f, Plated a) => LensLike' f s a -> LensLike' f s a Source #
cosmosOnOf :: ( Applicative f, Contravariant f) => LensLike' f s a -> LensLike' f a a -> LensLike' f s a Source #
transformOn :: Plated a => ASetter s t a a -> (a -> a) -> s -> t Source #
Transform every element in the tree in a bottom-up manner over a region indicated by a
Setter
.
transformOn
::Plated
a =>Traversal'
s a -> (a -> a) -> s -> stransformOn
::Plated
a =>Setter'
s a -> (a -> a) -> s -> s
transformOf :: ASetter a b a b -> (b -> b) -> a -> b Source #
Transform every element by recursively applying a given
Setter
in a bottom-up manner.
transformOf
::Traversal'
a a -> (a -> a) -> a -> atransformOf
::Setter'
a a -> (a -> a) -> a -> a
transformOnOf :: ASetter s t a b -> ASetter a b a b -> (b -> b) -> s -> t Source #
Transform every element in a region indicated by a
Setter
by recursively applying another
Setter
in a bottom-up manner.
transformOnOf
::Setter'
s a ->Traversal'
a a -> (a -> a) -> s -> stransformOnOf
::Setter'
s a ->Setter'
a a -> (a -> a) -> s -> s
transformM :: ( Monad m, Plated a) => (a -> m a) -> a -> m a Source #
Transform every element in the tree, in a bottom-up manner, monadically.
transformMOn :: ( Monad m, Plated a) => LensLike ( WrappedMonad m) s t a a -> (a -> m a) -> s -> m t Source #
Transform every element in the tree in a region indicated by a supplied
Traversal
, in a bottom-up manner, monadically.
transformMOn
:: (Monad
m,Plated
a) =>Traversal'
s a -> (a -> m a) -> s -> m s
transformMOf :: Monad m => LensLike ( WrappedMonad m) a b a b -> (b -> m b) -> a -> m b Source #
Transform every element in a tree using a user supplied
Traversal
in a bottom-up manner with a monadic effect.
transformMOf
::Monad
m =>Traversal'
a a -> (a -> m a) -> a -> m a
transformMOnOf :: Monad m => LensLike ( WrappedMonad m) s t a b -> LensLike ( WrappedMonad m) a b a b -> (b -> m b) -> s -> m t Source #
Transform every element in a tree that lies in a region indicated by a supplied
Traversal
, walking with a user supplied
Traversal
in
a bottom-up manner with a monadic effect.
transformMOnOf
::Monad
m =>Traversal'
s a ->Traversal'
a a -> (a -> m a) -> s -> m s
contextsOf :: ATraversal' a a -> a -> [ Context a a a] Source #
Return a list of all of the editable contexts for every location in the structure, recursively, using a user-specified
Traversal
to walk each layer.
propUniverse l x =universeOf
l x==
map
pos
(contextsOf
l x) propId l x =all
(==
x) [extract
w | w <-contextsOf
l x]
contextsOf
::Traversal'
a a -> a -> [Context
a a a]
contextsOn :: Plated a => ATraversal s t a a -> s -> [ Context a a t] Source #
Return a list of all of the editable contexts for every location in the structure in an areas indicated by a user supplied
Traversal
, recursively using
plate
.
contextsOn
b ≡contextsOnOf
bplate
contextsOn
::Plated
a =>Traversal'
s a -> s -> [Context
a a s]
contextsOnOf :: ATraversal s t a a -> ATraversal' a a -> s -> [ Context a a t] Source #
Return a list of all of the editable contexts for every location in the structure in an areas indicated by a user supplied
Traversal
, recursively using
another user-supplied
Traversal
to walk each layer.
contextsOnOf
::Traversal'
s a ->Traversal'
a a -> s -> [Context
a a s]
holes :: Plated a => a -> [ Pretext (->) a a a] Source #
The one-level version of
context
. This extracts a list of the immediate children as editable contexts.
Given a context you can use
pos
to see the values,
peek
at what the structure would be like with an edited result, or simply
extract
the original structure.
propChildren x =children
l x==
map
pos
(holes
l x) propId x =all
(==
x) [extract
w | w <-holes
l x]
holes
=holesOf
plate
holesOn :: Conjoined p => Over p ( Bazaar p a a) s t a a -> s -> [ Pretext p a a t] Source #
An alias for
holesOf
, provided for consistency with the other combinators.
holesOn
≡holesOf
holesOn
::Iso'
s a -> s -> [Pretext
(->) a a s]holesOn
::Lens'
s a -> s -> [Pretext
(->) a a s]holesOn
::Traversal'
s a -> s -> [Pretext
(->) a a s]holesOn
::IndexedLens'
i s a -> s -> [Pretext
(Indexed
i) a a s]holesOn
::IndexedTraversal'
i s a -> s -> [Pretext
(Indexed
i) a a s]
holesOnOf :: Conjoined p => LensLike ( Bazaar p r r) s t a b -> Over p ( Bazaar p r r) a b r r -> s -> [ Pretext p r r t] Source #
Extract one level of
holes
from a container in a region specified by one
Traversal
, using another.
holesOnOf
b l ≡holesOf
(b.
l)
holesOnOf
::Iso'
s a ->Iso'
a a -> s -> [Pretext
(->) a a s]holesOnOf
::Lens'
s a ->Lens'
a a -> s -> [Pretext
(->) a a s]holesOnOf
::Traversal'
s a ->Traversal'
a a -> s -> [Pretext
(->) a a s]holesOnOf
::Lens'
s a ->IndexedLens'
i a a -> s -> [Pretext
(Indexed
i) a a s]holesOnOf
::Traversal'
s a ->IndexedTraversal'
i a a -> s -> [Pretext
(Indexed
i) a a s]
composOpFold :: Plated a => b -> (b -> b -> b) -> (a -> b) -> a -> b Source #
Fold the immediate children of a
Plated
container.
composOpFold
z c f =foldrOf
plate
(c.
f) z
gplate :: ( Generic a, GPlated a ( Rep a)) => Traversal' a a Source #
Implement
plate
operation for a type using its
Generic
instance.
Note: the behavior may be different than with
uniplate
in some special cases.
gplate
doesn't look through other types in a group of mutually
recursive types.
For example consider mutually recursive even and odd natural numbers:
>>>
data Even = Z | E Odd deriving (Show, Generic, Typeable, Data); data Odd = O Even deriving (Show, Generic, Typeable, Data)
Then
uniplate
, which is based on
Data
, finds
all even numbers less or equal than four:
>>>
import Data.Data.Lens (uniplate)
>>>
universeOf uniplate (E (O (E (O Z))))
[E (O (E (O Z))),E (O Z),Z]
but
gplate
doesn't see through
Odd
.
>>>
universeOf gplate (E (O (E (O Z))))
[E (O (E (O Z)))]
If using
Data
is not an option, you can still write the traversal manually.
It is sometimes useful to use helper traversals
>>>
:{
let oddeven :: Traversal' Odd Even oddeven f (O n) = O <$> f n evenplate :: Traversal' Even Even evenplate f Z = pure Z evenplate f (E n) = E <$> oddeven f n :}
>>>
universeOf evenplate (E (O (E (O Z))))
[E (O (E (O Z))),E (O Z),Z]
class Each s t a b | s -> a, t -> b, s b -> t, t a -> s where Source #
Extract
each
element of a (potentially monomorphic) container.
Notably, when applied to a tuple, this generalizes
both
to arbitrary homogeneous tuples.
>>>
(1,2,3) & each *~ 10
(10,20,30)
It can also be used on monomorphic containers like
Text
or
ByteString
.
>>>
over each Char.toUpper ("hello"^.Text.packed)
"HELLO"
>>>
("hello","world") & each.each %~ Char.toUpper
("HELLO","WORLD")
Nothing
each :: Traversal s t a b Source #
default each :: ( Traversable g, s ~ g a, t ~ g b) => Traversal s t a b Source #
Instances
(a ~ Word8 , b ~ Word8 ) => Each ByteString ByteString a b Source # |
|
Defined in Control.Lens.Each each :: Traversal ByteString ByteString a b Source # |
|
(a ~ Word8 , b ~ Word8 ) => Each ByteString ByteString a b Source # |
|
Defined in Control.Lens.Each each :: Traversal ByteString ByteString a b Source # |
|
(a ~ Char , b ~ Char ) => Each Text Text a b Source # |
|
(a ~ Char , b ~ Char ) => Each Text Text a b Source # |
|
Each [a] [b] a b Source # |
|
Defined in Control.Lens.Each |
|
Each ( Maybe a) ( Maybe b) a b Source # |
|
Each ( Complex a) ( Complex b) a b Source # |
|
Each ( Identity a) ( Identity b) a b Source # |
|
Each ( NonEmpty a) ( NonEmpty b) a b Source # |
|
Each ( IntMap a) ( IntMap b) a b Source # |
|
Each ( Tree a) ( Tree b) a b Source # |
|
Each ( Seq a) ( Seq b) a b Source # |
|
Each ( Maybe a) ( Maybe b) a b Source # |
Since: 4.20 |
( Unbox a, Unbox b) => Each ( Vector a) ( Vector b) a b Source # |
|
( Storable a, Storable b) => Each ( Vector a) ( Vector b) a b Source # |
|
( Prim a, Prim b) => Each ( Vector a) ( Vector b) a b Source # |
|
Each ( Vector a) ( Vector b) a b Source # |
|
(a ~ a', b ~ b') => Each ( Either a a') ( Either b b') a b Source # |
Since: 4.18 |
(a ~ a', b ~ b') => Each (a, a') (b, b') a b Source # |
|
Defined in Control.Lens.Each |
|
( Ix i, IArray UArray a, IArray UArray b, i ~ j) => Each ( UArray i a) ( UArray j b) a b Source # |
|
( Ix i, i ~ j) => Each ( Array i a) ( Array j b) a b Source # |
|
c ~ d => Each ( Map c a) ( Map d b) a b Source # |
|
(a ~ a', b ~ b') => Each ( Pair a a') ( Pair b b') a b Source # |
Since: 4.20 |
(a ~ a', b ~ b') => Each ( These a a') ( These b b') a b Source # |
Since: 4.20 |
(a ~ a', b ~ b') => Each ( Either a a') ( Either b b') a b Source # |
Since: 4.20 |
(a ~ a', b ~ b') => Each ( These a a') ( These b b') a b Source # |
Since: 4.20 |
c ~ d => Each ( HashMap c a) ( HashMap d b) a b Source # |
|
(a ~ a2, a ~ a3, b ~ b2, b ~ b3) => Each (a, a2, a3) (b, b2, b3) a b Source # |
|
Defined in Control.Lens.Each |
|
(a ~ a2, a ~ a3, a ~ a4, b ~ b2, b ~ b3, b ~ b4) => Each (a, a2, a3, a4) (b, b2, b3, b4) a b Source # |
|
Defined in Control.Lens.Each |
|
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, b ~ b2, b ~ b3, b ~ b4, b ~ b5) => Each (a, a2, a3, a4, a5) (b, b2, b3, b4, b5) a b Source # |
|
Defined in Control.Lens.Each |
|
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, b ~ b2, b ~ b3, b ~ b4, b ~ b5, b ~ b6) => Each (a, a2, a3, a4, a5, a6) (b, b2, b3, b4, b5, b6) a b Source # |
|
Defined in Control.Lens.Each |
|
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, a ~ a7, b ~ b2, b ~ b3, b ~ b4, b ~ b5, b ~ b6, b ~ b7) => Each (a, a2, a3, a4, a5, a6, a7) (b, b2, b3, b4, b5, b6, b7) a b Source # |
|
Defined in Control.Lens.Each |
|
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, a ~ a7, a ~ a8, b ~ b2, b ~ b3, b ~ b4, b ~ b5, b ~ b6, b ~ b7, b ~ b8) => Each (a, a2, a3, a4, a5, a6, a7, a8) (b, b2, b3, b4, b5, b6, b7, b8) a b Source # |
|
Defined in Control.Lens.Each |
|
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, a ~ a7, a ~ a8, a ~ a9, b ~ b2, b ~ b3, b ~ b4, b ~ b5, b ~ b6, b ~ b7, b ~ b8, b ~ b9) => Each (a, a2, a3, a4, a5, a6, a7, a8, a9) (b, b2, b3, b4, b5, b6, b7, b8, b9) a b Source # |
|
Defined in Control.Lens.Each |
class Ixed m => At m where Source #
At
provides a
Lens
that can be used to read,
write or delete the value associated with a key in a
Map
-like
container on an ad hoc basis.
An instance of
At
should satisfy:
ix
k ≡at
k.
traverse
Provides a simple
Traversal
lets you
traverse
the value at a given
key in a
Map
or element at an ordinal position in a list or
Seq
.
Nothing
ix :: Index m -> Traversal' m ( IxValue m) Source #
NB:
Setting the value of this
Traversal
will only set the value in
at
if it is already present.
If you want to be able to insert
missing
values, you want
at
.
>>>
Seq.fromList [a,b,c,d] & ix 2 %~ f
fromList [a,b,f c,d]
>>>
Seq.fromList [a,b,c,d] & ix 2 .~ e
fromList [a,b,e,d]
>>>
Seq.fromList [a,b,c,d] ^? ix 2
Just c
>>>
Seq.fromList [] ^? ix 2
Nothing
Instances
Ixed ByteString Source # | |
Defined in Control.Lens.At ix :: Index ByteString -> Traversal' ByteString ( IxValue ByteString ) Source # |
|
Ixed ByteString Source # | |
Defined in Control.Lens.At ix :: Index ByteString -> Traversal' ByteString ( IxValue ByteString ) Source # |
|
Ixed IntSet Source # | |
Defined in Control.Lens.At |
|
Ixed Text Source # | |
Defined in Control.Lens.At |
|
Ixed Text Source # | |
Defined in Control.Lens.At |
|
Ixed [a] Source # | |
Defined in Control.Lens.At |
|
Ixed ( Maybe a) Source # | |
Defined in Control.Lens.At |
|
Ixed ( Identity a) Source # | |
Defined in Control.Lens.At |
|
Ixed ( NonEmpty a) Source # | |
Defined in Control.Lens.At |
|
Ixed ( IntMap a) Source # | |
Defined in Control.Lens.At |
|
Ixed ( Tree a) Source # | |
Defined in Control.Lens.At |
|
Ixed ( Seq a) Source # | |
Defined in Control.Lens.At |
|
Ord k => Ixed ( Set k) Source # | |
Defined in Control.Lens.At |
|
( Eq k, Hashable k) => Ixed ( HashSet k) Source # | |
Defined in Control.Lens.At |
|
Unbox a => Ixed ( Vector a) Source # | |
Defined in Control.Lens.At |
|
Storable a => Ixed ( Vector a) Source # | |
Defined in Control.Lens.At |
|
Prim a => Ixed ( Vector a) Source # | |
Defined in Control.Lens.At |
|
Ixed ( Vector a) Source # | |
Defined in Control.Lens.At |
|
Eq e => Ixed (e -> a) Source # | |
Defined in Control.Lens.At |
|
a ~ a2 => Ixed (a, a2) Source # | |
Defined in Control.Lens.At |
|
( IArray UArray e, Ix i) => Ixed ( UArray i e) Source # |
arr |
Defined in Control.Lens.At |
|
Ix i => Ixed ( Array i e) Source # |
arr |
Defined in Control.Lens.At |
|
Ord k => Ixed ( Map k a) Source # | |
Defined in Control.Lens.At |
|
( Eq k, Hashable k) => Ixed ( HashMap k a) Source # | |
Defined in Control.Lens.At |
|
(a ~ a2, a ~ a3) => Ixed (a, a2, a3) Source # | |
Defined in Control.Lens.At |
|
(a ~ a2, a ~ a3, a ~ a4) => Ixed (a, a2, a3, a4) Source # | |
Defined in Control.Lens.At |
|
(a ~ a2, a ~ a3, a ~ a4, a ~ a5) => Ixed (a, a2, a3, a4, a5) Source # | |
Defined in Control.Lens.At |
|
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6) => Ixed (a, a2, a3, a4, a5, a6) Source # | |
Defined in Control.Lens.At |
|
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, a ~ a7) => Ixed (a, a2, a3, a4, a5, a6, a7) Source # | |
Defined in Control.Lens.At |
|
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, a ~ a7, a ~ a8) => Ixed (a, a2, a3, a4, a5, a6, a7, a8) Source # | |
Defined in Control.Lens.At |
|
(a ~ a2, a ~ a3, a ~ a4, a ~ a5, a ~ a6, a ~ a7, a ~ a8, a ~ a9) => Ixed (a, a2, a3, a4, a5, a6, a7, a8, a9) Source # | |
Defined in Control.Lens.At |
type family IxValue (m :: *) :: * Source #
Instances
type IxValue ByteString Source # | |
Defined in Control.Lens.At |
|
type IxValue ByteString Source # | |
Defined in Control.Lens.At |
|
type IxValue IntSet Source # | |
Defined in Control.Lens.At |
|
type IxValue Text Source # | |
Defined in Control.Lens.At |
|
type IxValue Text Source # | |
Defined in Control.Lens.At |
|
type IxValue [a] Source # | |
Defined in Control.Lens.At
type
IxValue
[a] = a
|
|
type IxValue ( Maybe a) Source # | |
Defined in Control.Lens.At |
|
type IxValue ( Identity a) Source # | |
Defined in Control.Lens.At |
|
type IxValue ( NonEmpty a) Source # | |
Defined in Control.Lens.At |
|
type IxValue ( IntMap a) Source # | |
Defined in Control.Lens.At |
|
type IxValue ( Tree a) Source # | |
Defined in Control.Lens.At |
|
type IxValue ( Seq a) Source # | |
Defined in Control.Lens.At |
|
type IxValue ( Set k) Source # | |
Defined in Control.Lens.At |
|
type IxValue ( HashSet k) Source # | |
Defined in Control.Lens.At |
|
type IxValue ( Vector a) Source # | |
Defined in Control.Lens.At |
|
type IxValue ( Vector a) Source # | |
Defined in Control.Lens.At |
|
type IxValue ( Vector a) Source # | |
Defined in Control.Lens.At |
|
type IxValue ( Vector a) Source # | |
Defined in Control.Lens.At |
|
type IxValue (e -> a) Source # | |
Defined in Control.Lens.At
type
IxValue
(e -> a) = a
|
|
type IxValue (a, a2) Source # |
|
Defined in Control.Lens.At
type
IxValue
(a, a2) = a
|
|
type IxValue ( UArray i e) Source # | |
Defined in Control.Lens.At |
|
type IxValue ( Array i e) Source # | |
Defined in Control.Lens.At |
|
type IxValue ( Map k a) Source # | |
Defined in Control.Lens.At |
|
type IxValue ( HashMap k a) Source # | |
Defined in Control.Lens.At |
|
type IxValue (a, a2, a3) Source # |
|
Defined in Control.Lens.At
type
IxValue
(a, a2, a3) = a
|
|
type IxValue (a, a2, a3, a4) Source # |
|
Defined in Control.Lens.At
type
IxValue
(a, a2, a3, a4) = a
|
|
type IxValue (a, a2, a3, a4, a5) Source # |
|
Defined in Control.Lens.At
type
IxValue
(a, a2, a3, a4, a5) = a
|
|
type IxValue (a, a2, a3, a4, a5, a6) Source # |
|
Defined in Control.Lens.At
type
IxValue
(a, a2, a3, a4, a5, a6) = a
|
|
type IxValue (a, a2, a3, a4, a5, a6, a7) Source # |
|
Defined in Control.Lens.At
type
IxValue
(a, a2, a3, a4, a5, a6, a7) = a
|
|
type IxValue (a, a2, a3, a4, a5, a6, a7, a8) Source # |
|
Defined in Control.Lens.At
type
IxValue
(a, a2, a3, a4, a5, a6, a7, a8) = a
|
|
type IxValue (a, a2, a3, a4, a5, a6, a7, a8, a9) Source # |
|
Defined in Control.Lens.At
type
IxValue
(a, a2, a3, a4, a5, a6, a7, a8, a9) = a
|
class Contains m where Source #
This class provides a simple
Lens
that lets you view (and modify)
information about whether or not a container contains a given
Index
.
contains :: Index m -> Lens' m Bool Source #
>>>
IntSet.fromList [1,2,3,4] ^. contains 3
True
>>>
IntSet.fromList [1,2,3,4] ^. contains 5
False
>>>
IntSet.fromList [1,2,3,4] & contains 3 .~ False
fromList [1,2,4]
type family Index (s :: *) :: * Source #
Instances
icontains :: Contains m => Index m -> IndexedLens' ( Index m) m Bool Source #
An indexed version of
contains
.
>>>
IntSet.fromList [1,2,3,4] ^@. icontains 3
(3,True)
>>>
IntSet.fromList [1,2,3,4] ^@. icontains 5
(5,False)
>>>
IntSet.fromList [1,2,3,4] & icontains 3 %@~ \i x -> if odd i then not x else x
fromList [1,2,4]
>>>
IntSet.fromList [1,2,3,4] & icontains 3 %@~ \i x -> if even i then not x else x
fromList [1,2,3,4]
iix :: Ixed m => Index m -> IndexedTraversal' ( Index m) m ( IxValue m) Source #
An indexed version of
ix
.
>>>
Seq.fromList [a,b,c,d] & iix 2 %@~ f'
fromList [a,b,f' 2 c,d]
>>>
Seq.fromList [a,b,c,d] & iix 2 .@~ h
fromList [a,b,h 2,d]
>>>
Seq.fromList [a,b,c,d] ^@? iix 2
Just (2,c)
>>>
Seq.fromList [] ^@? iix 2
Nothing
iat :: At m => Index m -> IndexedLens' ( Index m) m ( Maybe ( IxValue m)) Source #
An indexed version of
at
.
>>>
Map.fromList [(1,"world")] ^@. iat 1
(1,Just "world")
>>>
iat 1 %@~ (\i x -> if odd i then Just "hello" else Nothing) $ Map.empty
fromList [(1,"hello")]
>>>
iat 2 %@~ (\i x -> if odd i then Just "hello" else Nothing) $ Map.empty
fromList []
Generate a
Prism
for each constructor of a data type.
Isos generated when possible.
Reviews are created for constructors with existentially
quantified constructors and GADTs.
e.g.
data FooBarBaz a = Foo Int | Bar a | Baz Int Char makePrisms ''FooBarBaz
will create
_Foo :: Prism' (FooBarBaz a) Int _Bar :: Prism (FooBarBaz a) (FooBarBaz b) a b _Baz :: Prism' (FooBarBaz a) (Int, Char)
Generate a
Prism
for each constructor of a data type
and combine them into a single class. No Isos are created.
Reviews are created for constructors with existentially
quantified constructors and GADTs.
e.g.
data FooBarBaz a = Foo Int | Bar a | Baz Int Char makeClassyPrisms ''FooBarBaz
will create
class AsFooBarBaz s a | s -> a where _FooBarBaz :: Prism' s (FooBarBaz a) _Foo :: Prism' s Int _Bar :: Prism' s a _Baz :: Prism' s (Int,Char) _Foo = _FooBarBaz . _Foo _Bar = _FooBarBaz . _Bar _Baz = _FooBarBaz . _Baz instance AsFooBarBaz (FooBarBaz a) a
Generate an As class of prisms. Names are selected by prefixing the constructor name with an underscore. Constructors with multiple fields will construct Prisms to tuples of those fields.
In the event that the name of a data type is also the name of one of its
constructors, the name of the
Prism
generated for the data type will be
prefixed with an extra
_
(if the data type name is prefix) or
.
(if the
name is infix) to disambiguate it from the
Prism
for the corresponding
constructor. For example, this code:
data Quux = Quux Int | Fred Bool makeClassyPrisms ''Quux
will create:
class AsQuux s where __Quux :: Prism' s Quux -- Data type prism _Quux :: Prism' s Int -- Constructor prism _Fred :: Prism' s Bool _Quux = __Quux . _Quux _Fred = __Quux . _Fred instance AsQuux Quux
type ClassyNamer Source #
= Name |
Name of the data type that lenses are being generated for. |
-> Maybe ( Name , Name ) |
Names of the class and the main method it generates, respectively. |
The optional rule to create a class and method around a monomorphic data type. If this naming convention is provided, it generates a "classy" lens.
Name to give to generated field optics.
TopName Name |
Simple top-level definition name |
MethodName Name Name |
makeFields-style class name and method name |
Instances
Eq DefName Source # | |
Ord DefName Source # | |
Defined in Control.Lens.Internal.FieldTH |
|
Show DefName Source # | |
type FieldNamer Source #
= Name |
Name of the data type that lenses are being generated for. |
-> [ Name ] |
Names of all fields (including the field being named) in the data type. |
-> Name |
Name of the field being named. |
-> [ DefName ] |
Name(s) of the lens functions. If empty, no lens is created for that field. |
The rule to create function names of lenses for data fields.
Although it's sometimes useful, you won't need the first two arguments most of the time.
generateSignatures :: Lens' LensRules Bool Source #
Indicate whether or not to supply the signatures for the generated lenses.
Disabling this can be useful if you want to provide a more restricted type signature or if you want to supply hand-written haddocks.
generateLazyPatterns :: Lens' LensRules Bool Source #
Generate optics using lazy pattern matches. This can allow fields of an undefined value to be initialized with lenses:
data Foo = Foo {_x :: Int, _y :: Bool} deriving ShowmakeLensesWith
(lensRules
&generateLazyPatterns
.~ True) ''Foo
> undefined & x .~ 8 & y .~ True Foo {_x = 8, _y = True}
The downside of this flag is that it can lead to space-leaks and code-size/compile-time increases when generated for large records. By default this flag is turned off, and strict optics are generated.
When using lazy optics the strict optic can be recovered by composing
with
$!
:
strictOptic = ($!) . lazyOptic
lensClass :: Lens' LensRules ClassyNamer Source #
Lens'
to access the option for naming "classy" lenses.
lensRules :: LensRules Source #
Rules for making fairly simple partial lenses, ignoring the special cases
for isomorphisms and traversals, and not making any classes.
It uses
underscoreNoPrefixNamer
.
underscoreNoPrefixNamer :: FieldNamer Source #
A
FieldNamer
that strips the _ off of the field name,
lowercases the name, and skips the field if it doesn't start with
an '_'.
Construct a
LensRules
value for generating top-level definitions
using the given map from field names to definition names.
lookingupNamer :: [( String , String )] -> FieldNamer Source #
Create a
FieldNamer
from explicit pairings of
(fieldName, lensName)
.
:: ( String -> [ String ]) |
A function that maps a
|
-> FieldNamer |
Create a
FieldNamer
from a mapping function. If the function
returns
[]
, it creates no lens for the field.
classyRules :: LensRules Source #
Rules for making lenses and traversals that precompose another
Lens
.
classyRules_ :: LensRules Source #
A
LensRules
used by
makeClassy_
.
makeLenses :: Name -> DecsQ Source #
Build lenses (and traversals) with a sensible default configuration.
e.g.
data FooBar = Foo { _x, _y ::Int
} | Bar { _x ::Int
}makeLenses
''FooBar
will create
x ::Lens'
FooBarInt
x f (Foo a b) = (\a' -> Foo a' b) <$> f a x f (Bar a) = Bar <$> f a y ::Traversal'
FooBarInt
y f (Foo a b) = (\b' -> Foo a b') <$> f b y _ c@(Bar _) = pure c
makeLenses
=makeLensesWith
lensRules
makeClassy :: Name -> DecsQ Source #
Make lenses and traversals for a type, and create a class when the type has no arguments.
e.g.
data Foo = Foo { _fooX, _fooY ::Int
}makeClassy
''Foo
will create
class HasFoo t where foo ::Lens'
t Foo fooX ::Lens'
tInt
fooX = foo . go where go f (Foo x y) = (\x' -> Foo x' y) <$> f x fooY ::Lens'
tInt
fooY = foo . go where go f (Foo x y) = (\y' -> Foo x y') <$> f y instance HasFoo Foo where foo = id
makeClassy
=makeLensesWith
classyRules
makeClassy_ :: Name -> DecsQ Source #
Make lenses and traversals for a type, and create a class when the type
has no arguments. Works the same as
makeClassy
except that (a) it
expects that record field names do not begin with an underscore, (b) all
record fields are made into lenses, and (c) the resulting lens is prefixed
with an underscore.
makeLensesFor :: [( String , String )] -> Name -> DecsQ Source #
Derive lenses and traversals, specifying explicit pairings
of
(fieldName, lensName)
.
If you map multiple names to the same label, and it is present in the same
constructor then this will generate a
Traversal
.
e.g.
makeLensesFor
[("_foo", "fooLens"), ("baz", "lbaz")] ''FoomakeLensesFor
[("_barX", "bar"), ("_barY", "bar")] ''Bar
makeClassyFor :: String -> String -> [( String , String )] -> Name -> DecsQ Source #
Derive lenses and traversals, using a named wrapper class, and
specifying explicit pairings of
(fieldName, traversalName)
.
Example usage:
makeClassyFor
"HasFoo" "foo" [("_foo", "fooLens"), ("bar", "lbar")] ''Foo
declareLenses :: DecsQ -> DecsQ Source #
declareLensesFor :: [( String , String )] -> DecsQ -> DecsQ Source #
Similar to
makeLensesFor
, but takes a declaration quote.
declareClassy :: DecsQ -> DecsQ Source #
For each record in the declaration quote, make lenses and traversals for it, and create a class when the type has no arguments. All record syntax in the input will be stripped off.
e.g.
declareClassy [d| data Foo = Foo { fooX, fooY ::Int
} derivingShow
|]
will create
data Foo = FooInt
Int
derivingShow
class HasFoo t where foo ::Lens'
t Foo instance HasFoo Foo where foo =id
fooX, fooY :: HasFoo t =>Lens'
tInt
declareClassyFor :: [( String , ( String , String ))] -> [( String , String )] -> DecsQ -> DecsQ Source #
Similar to
makeClassyFor
, but takes a declaration quote.
declarePrisms :: DecsQ -> DecsQ Source #
Generate a
Prism
for each constructor of each data type.
e.g.
declarePrisms [d| data Exp = Lit Int | Var String | Lambda{ bound::String, body::Exp } |]
will create
data Exp = Lit Int | Var String | Lambda { bound::String, body::Exp } _Lit ::Prism'
Exp Int _Var ::Prism'
Exp String _Lambda ::Prism'
Exp (String, Exp)
declareFields :: DecsQ -> DecsQ Source #
declareFields =declareLensesWith
defaultFieldRules
declareLensesWith :: LensRules -> DecsQ -> DecsQ Source #
Declare lenses for each records in the given declarations, using the
specified
LensRules
. Any record syntax in the input will be stripped
off.
makeWrapped :: Name -> DecsQ Source #
Build
Wrapped
instance for a given newtype
underscoreFields :: LensRules Source #
Field rules for fields in the form
_prefix_fieldname
underscoreNamer :: FieldNamer Source #
A
FieldNamer
for
underscoreFields
.
camelCaseFields :: LensRules Source #
Field rules for fields in the form
prefixFieldname or _prefixFieldname
If you want all fields to be lensed, then there is no reason to use an
_
before the prefix.
If any of the record fields leads with an
_
then it is assume a field without an
_
should not have a lens created.
Note
: The
prefix
must be the same as the typename (with the first
letter lowercased). This is a change from lens versions before lens 4.5.
If you want the old behaviour, use
makeLensesWith
abbreviatedFields
camelCaseNamer :: FieldNamer Source #
A
FieldNamer
for
camelCaseFields
.
classUnderscoreNoPrefixFields :: LensRules Source #
Field rules for fields in the form
_fieldname
(the leading
underscore is mandatory).
Note
: The primary difference to
camelCaseFields
is that for
classUnderscoreNoPrefixFields
the field names are not expected to
be prefixed with the type name. This might be the desired behaviour
when the
DuplicateRecordFields
extension is enabled.
abbreviatedFields :: LensRules Source #
Field rules fields in the form
prefixFieldname or _prefixFieldname
If you want all fields to be lensed, then there is no reason to use an
_
before the prefix.
If any of the record fields leads with an
_
then it is assume a field without an
_
should not have a lens created.
Note that
prefix
may be any string of characters that are not uppercase
letters. (In particular, it may be arbitrary string of lowercase letters
and numbers) This is the behavior that
defaultFieldRules
had in lens
4.4 and earlier.
abbreviatedNamer :: FieldNamer Source #
A
FieldNamer
for
abbreviatedFields
.
makeFields :: Name -> DecsQ Source #
Generate overloaded field accessors.
e.g
data Foo a = Foo { _fooX ::Int
, _fooY :: a } newtype Bar = Bar { _barX ::Char
} makeFields ''Foo makeFields ''Bar
will create
_fooXLens :: Lens' (Foo a) Int _fooYLens :: Lens (Foo a) (Foo b) a b class HasX s a | s -> a where x :: Lens' s a instance HasX (Foo a) Int where x = _fooXLens class HasY s a | s -> a where y :: Lens' s a instance HasY (Foo a) a where y = _fooYLens _barXLens :: Iso' Bar Char instance HasX Bar Char where x = _barXLens
For details, see
camelCaseFields
.
makeFields =makeLensesWith
defaultFieldRules
makeFieldsNoPrefix :: Name -> DecsQ Source #
Generate overloaded field accessors based on field names which
are only prefixed with an underscore (e.g.
_name
), not
additionally with the type name (e.g.
_fooName
).
This might be the desired behaviour in case the
DuplicateRecordFields
language extension is used in order to get
rid of the necessity to prefix each field name with the type name.
As an example:
data Foo a = Foo { _x ::Int
, _y :: a } newtype Bar = Bar { _x ::Char
} makeFieldsNoPrefix ''Foo makeFieldsNoPrefix ''Bar
will create classes
class HasX s a | s -> a where x :: Lens' s a class HasY s a | s -> a where y :: Lens' s a
together with instances
instance HasX (Foo a) Int instance HasY (Foo a) a where instance HasX Bar Char where
For details, see
classUnderscoreNoPrefixFields
.
makeFieldsNoPrefix =makeLensesWith
classUnderscoreNoPrefixFields