Copyright | (C) 2012-2016 Edward Kmett |
---|---|
License | BSD-style (see the file LICENSE) |
Maintainer | Edward Kmett <ekmett@gmail.com> |
Stability | experimental |
Portability | non-portable |
Safe Haskell | Trustworthy |
Language | Haskell2010 |
Internal implementation details for Indexed
lens-likes
Synopsis
- newtype Indexed i a b = Indexed {
- runIndexed :: 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
- class Conjoined p => Indexable i p where
- indexed :: p a b -> i -> a -> b
- newtype Indexing f a = Indexing {
- runIndexing :: Int -> (Int, f a)
- indexing :: Indexable Int p => ((a -> Indexing f b) -> s -> Indexing f t) -> p a (f b) -> s -> f t
- newtype Indexing64 f a = Indexing64 {
- runIndexing64 :: Int64 -> (Int64, f a)
- 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)
An Indexed Profunctor
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
Classes
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 (->) Source # | |
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.
Indexing
Applicative
composition of
with a State
Int
Functor
, used
by indexed
.
Indexing | |
|
Instances
Contravariant f => Contravariant (Indexing f) Source # | |
Applicative f => Applicative (Indexing f) Source # | |
Defined in Control.Lens.Internal.Indexed | |
Functor f => Functor (Indexing f) Source # | |
Apply f => Apply (Indexing f) Source # | |
Monoid (f a) => Monoid (Indexing f a) Source # |
|
Semigroup (f a) => Semigroup (Indexing f a) 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
64-bit Indexing
newtype Indexing64 f a Source #
Applicative
composition of
with a State
Int64
Functor
, used
by indexed64
.
Indexing64 | |
|
Instances
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
Converting to Folds
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")]