1{-# LANGUAGE CPP #-}
2{-# LANGUAGE GADTs #-}
3{-# LANGUAGE Rank2Types #-}
4{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE PolyKinds #-}
9#if __GLASGOW_HASKELL__ >= 800
10{-# LANGUAGE TypeInType #-}
11#endif
12{-# LANGUAGE Trustworthy #-}
13-------------------------------------------------------------------------------
14-- |
15-- Module      :  Control.Lens.Type
16-- Copyright   :  (C) 2012-16 Edward Kmett
17-- License     :  BSD-style (see the file LICENSE)
18-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
19-- Stability   :  provisional
20-- Portability :  Rank2Types
21--
22-- This module exports the majority of the types that need to appear in user
23-- signatures or in documentation when talking about lenses. The remaining types
24-- for consuming lenses are distributed across various modules in the hierarchy.
25-------------------------------------------------------------------------------
26module Control.Lens.Type
27  (
28  -- * Other
29    Equality, Equality', As
30  , Iso, Iso'
31  , Prism , Prism'
32  , Review , AReview
33  -- * Lenses, Folds and Traversals
34  , Lens, Lens'
35  , Traversal, Traversal'
36  , Traversal1, Traversal1'
37  , Setter, Setter'
38  , Getter, Fold
39  , Fold1
40  -- * Indexed
41  , IndexedLens, IndexedLens'
42  , IndexedTraversal, IndexedTraversal'
43  , IndexedTraversal1, IndexedTraversal1'
44  , IndexedSetter, IndexedSetter'
45  , IndexedGetter, IndexedFold
46  , IndexedFold1
47  -- * Index-Preserving
48  , IndexPreservingLens, IndexPreservingLens'
49  , IndexPreservingTraversal, IndexPreservingTraversal'
50  , IndexPreservingTraversal1, IndexPreservingTraversal1'
51  , IndexPreservingSetter, IndexPreservingSetter'
52  , IndexPreservingGetter, IndexPreservingFold
53  , IndexPreservingFold1
54  -- * Common
55  , Simple
56  , LensLike, LensLike'
57  , Over, Over'
58  , IndexedLensLike, IndexedLensLike'
59  , Optical, Optical'
60  , Optic, Optic'
61  ) where
62
63import Prelude ()
64
65import Control.Lens.Internal.Prelude
66import Control.Lens.Internal.Setter
67import Control.Lens.Internal.Indexed
68import Data.Bifunctor
69import Data.Functor.Apply
70#if __GLASGOW_HASKELL__ >= 800
71import Data.Kind
72#endif
73
74-- $setup
75-- >>> :set -XNoOverloadedStrings
76-- >>> import Control.Lens
77-- >>> import Debug.SimpleReflect.Expr
78-- >>> import Debug.SimpleReflect.Vars as Vars hiding (f,g,h)
79-- >>> let f :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f
80-- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g
81-- >>> let h :: Expr -> Expr -> Expr; h = Debug.SimpleReflect.Vars.h
82-- >>> let getter :: Expr -> Expr; getter = fun "getter"
83-- >>> let setter :: Expr -> Expr -> Expr; setter = fun "setter"
84-- >>> import Numeric.Natural
85-- >>> let nat :: Prism' Integer Natural; nat = prism toInteger $ \i -> if i < 0 then Left i else Right (fromInteger i)
86
87-------------------------------------------------------------------------------
88-- Lenses
89-------------------------------------------------------------------------------
90
91-- | A 'Lens' is actually a lens family as described in
92-- <http://comonad.com/reader/2012/mirrored-lenses/>.
93--
94-- With great power comes great responsibility and a 'Lens' is subject to the
95-- three common sense 'Lens' laws:
96--
97-- 1) You get back what you put in:
98--
99-- @
100-- 'Control.Lens.Getter.view' l ('Control.Lens.Setter.set' l v s)  ≡ v
101-- @
102--
103-- 2) Putting back what you got doesn't change anything:
104--
105-- @
106-- 'Control.Lens.Setter.set' l ('Control.Lens.Getter.view' l s) s  ≡ s
107-- @
108--
109-- 3) Setting twice is the same as setting once:
110--
111-- @
112-- 'Control.Lens.Setter.set' l v' ('Control.Lens.Setter.set' l v s) ≡ 'Control.Lens.Setter.set' l v' s
113-- @
114--
115-- These laws are strong enough that the 4 type parameters of a 'Lens' cannot
116-- vary fully independently. For more on how they interact, read the \"Why is
117-- it a Lens Family?\" section of
118-- <http://comonad.com/reader/2012/mirrored-lenses/>.
119--
120-- There are some emergent properties of these laws:
121--
122-- 1) @'Control.Lens.Setter.set' l s@ must be injective for every @s@ This is a consequence of law #1
123--
124-- 2) @'Control.Lens.Setter.set' l@ must be surjective, because of law #2, which indicates that it is possible to obtain any 'v' from some 's' such that @'Control.Lens.Setter.set' s v = s@
125--
126-- 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:
127--
128-- @
129-- 'Control.Lens.Setter.set' l v ('Control.Lens.Setter.set' l v s) ≡ 'Control.Lens.Setter.set' l v s
130-- @
131--
132-- Every 'Lens' can be used directly as a 'Control.Lens.Setter.Setter' or 'Traversal'.
133--
134-- You can also use a 'Lens' for 'Control.Lens.Getter.Getting' as if it were a
135-- 'Fold' or 'Getter'.
136--
137-- Since every 'Lens' is a valid 'Traversal', the
138-- 'Traversal' laws are required of any 'Lens' you create:
139--
140-- @
141-- l 'pure' ≡ 'pure'
142-- 'fmap' (l f) '.' l g ≡ 'Data.Functor.Compose.getCompose' '.' l ('Data.Functor.Compose.Compose' '.' 'fmap' f '.' g)
143-- @
144--
145-- @
146-- type 'Lens' s t a b = forall f. 'Functor' f => 'LensLike' f s t a b
147-- @
148type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
149
150-- | @
151-- type 'Lens'' = 'Simple' 'Lens'
152-- @
153type Lens' s a = Lens s s a a
154
155-- | Every 'IndexedLens' is a valid 'Lens' and a valid 'Control.Lens.Traversal.IndexedTraversal'.
156type IndexedLens i s t a b = forall f p. (Indexable i p, Functor f) => p a (f b) -> s -> f t
157
158-- | @
159-- type 'IndexedLens'' i = 'Simple' ('IndexedLens' i)
160-- @
161type IndexedLens' i s a = IndexedLens i s s a a
162
163-- | An 'IndexPreservingLens' leaves any index it is composed with alone.
164type IndexPreservingLens s t a b = forall p f. (Conjoined p, Functor f) => p a (f b) -> p s (f t)
165
166-- | @
167-- type 'IndexPreservingLens'' = 'Simple' 'IndexPreservingLens'
168-- @
169type IndexPreservingLens' s a = IndexPreservingLens s s a a
170
171------------------------------------------------------------------------------
172-- Traversals
173------------------------------------------------------------------------------
174
175-- | A 'Traversal' can be used directly as a 'Control.Lens.Setter.Setter' or a 'Fold' (but not as a 'Lens') and provides
176-- the ability to both read and update multiple fields, subject to some relatively weak 'Traversal' laws.
177--
178-- These have also been known as multilenses, but they have the signature and spirit of
179--
180-- @
181-- 'Data.Traversable.traverse' :: 'Data.Traversable.Traversable' f => 'Traversal' (f a) (f b) a b
182-- @
183--
184-- and the more evocative name suggests their application.
185--
186-- Most of the time the 'Traversal' you will want to use is just 'Data.Traversable.traverse', but you can also pass any
187-- 'Lens' or 'Iso' as a 'Traversal', and composition of a 'Traversal' (or 'Lens' or 'Iso') with a 'Traversal' (or 'Lens' or 'Iso')
188-- using ('.') forms a valid 'Traversal'.
189--
190-- The laws for a 'Traversal' @t@ follow from the laws for 'Data.Traversable.Traversable' as stated in \"The Essence of the Iterator Pattern\".
191--
192-- @
193-- t 'pure' ≡ 'pure'
194-- 'fmap' (t f) '.' t g ≡ 'Data.Functor.Compose.getCompose' '.' t ('Data.Functor.Compose.Compose' '.' 'fmap' f '.' g)
195-- @
196--
197-- One consequence of this requirement is that a 'Traversal' needs to leave the same number of elements as a
198-- candidate for subsequent 'Traversal' that it started with. Another testament to the strength of these laws
199-- is that the caveat expressed in section 5.5 of the \"Essence of the Iterator Pattern\" about exotic
200-- 'Data.Traversable.Traversable' instances that 'Data.Traversable.traverse' the same entry multiple times was actually already ruled out by the
201-- second law in that same paper!
202type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t
203
204-- | @
205-- type 'Traversal'' = 'Simple' 'Traversal'
206-- @
207type Traversal' s a = Traversal s s a a
208
209type Traversal1 s t a b = forall f. Apply f => (a -> f b) -> s -> f t
210type Traversal1' s a = Traversal1 s s a a
211
212-- | Every 'IndexedTraversal' is a valid 'Control.Lens.Traversal.Traversal' or
213-- 'Control.Lens.Fold.IndexedFold'.
214--
215-- The 'Indexed' constraint is used to allow an 'IndexedTraversal' to be used
216-- directly as a 'Control.Lens.Traversal.Traversal'.
217--
218-- The 'Control.Lens.Traversal.Traversal' laws are still required to hold.
219--
220-- In addition, the index @i@ should satisfy the requirement that it stays
221-- unchanged even when modifying the value @a@, otherwise traversals like
222-- 'indices' break the 'Traversal' laws.
223type IndexedTraversal i s t a b = forall p f. (Indexable i p, Applicative f) => p a (f b) -> s -> f t
224
225-- | @
226-- type 'IndexedTraversal'' i = 'Simple' ('IndexedTraversal' i)
227-- @
228type IndexedTraversal' i s a = IndexedTraversal i s s a a
229
230type IndexedTraversal1 i s t a b = forall p f. (Indexable i p, Apply f) => p a (f b) -> s -> f t
231type IndexedTraversal1' i s a = IndexedTraversal1 i s s a a
232
233-- | An 'IndexPreservingLens' leaves any index it is composed with alone.
234type IndexPreservingTraversal s t a b = forall p f. (Conjoined p, Applicative f) => p a (f b) -> p s (f t)
235
236-- | @
237-- type 'IndexPreservingTraversal'' = 'Simple' 'IndexPreservingTraversal'
238-- @
239type IndexPreservingTraversal' s a = IndexPreservingTraversal s s a a
240
241type IndexPreservingTraversal1 s t a b = forall p f. (Conjoined p, Apply f) => p a (f b) -> p s (f t)
242type IndexPreservingTraversal1' s a = IndexPreservingTraversal1 s s a a
243
244------------------------------------------------------------------------------
245-- Setters
246------------------------------------------------------------------------------
247
248-- | The only 'LensLike' law that can apply to a 'Setter' @l@ is that
249--
250-- @
251-- 'Control.Lens.Setter.set' l y ('Control.Lens.Setter.set' l x a) ≡ 'Control.Lens.Setter.set' l y a
252-- @
253--
254-- You can't 'Control.Lens.Getter.view' a 'Setter' in general, so the other two laws are irrelevant.
255--
256-- However, two 'Functor' laws apply to a 'Setter':
257--
258-- @
259-- 'Control.Lens.Setter.over' l 'id' ≡ 'id'
260-- 'Control.Lens.Setter.over' l f '.' 'Control.Lens.Setter.over' l g ≡ 'Control.Lens.Setter.over' l (f '.' g)
261-- @
262--
263-- These can be stated more directly:
264--
265-- @
266-- l 'pure' ≡ 'pure'
267-- l f '.' 'untainted' '.' l g ≡ l (f '.' 'untainted' '.' g)
268-- @
269--
270-- You can compose a 'Setter' with a 'Lens' or a 'Traversal' using ('.') from the @Prelude@
271-- and the result is always only a 'Setter' and nothing more.
272--
273-- >>> over traverse f [a,b,c,d]
274-- [f a,f b,f c,f d]
275--
276-- >>> over _1 f (a,b)
277-- (f a,b)
278--
279-- >>> over (traverse._1) f [(a,b),(c,d)]
280-- [(f a,b),(f c,d)]
281--
282-- >>> over both f (a,b)
283-- (f a,f b)
284--
285-- >>> over (traverse.both) f [(a,b),(c,d)]
286-- [(f a,f b),(f c,f d)]
287type Setter s t a b = forall f. Settable f => (a -> f b) -> s -> f t
288
289-- | A 'Setter'' is just a 'Setter' that doesn't change the types.
290--
291-- These are particularly common when talking about monomorphic containers. /e.g./
292--
293-- @
294-- 'sets' Data.Text.map :: 'Setter'' 'Data.Text.Internal.Text' 'Char'
295-- @
296--
297-- @
298-- type 'Setter'' = 'Simple' 'Setter'
299-- @
300type Setter' s a = Setter s s a a
301
302-- | Every 'IndexedSetter' is a valid 'Setter'.
303--
304-- The 'Setter' laws are still required to hold.
305type IndexedSetter i s t a b = forall f p.
306  (Indexable i p, Settable f) => p a (f b) -> s -> f t
307
308-- | @
309-- type 'IndexedSetter'' i = 'Simple' ('IndexedSetter' i)
310-- @
311type IndexedSetter' i s a = IndexedSetter i s s a a
312
313-- | An 'IndexPreservingSetter' can be composed with a 'IndexedSetter', 'IndexedTraversal' or 'IndexedLens'
314-- and leaves the index intact, yielding an 'IndexedSetter'.
315type IndexPreservingSetter s t a b = forall p f. (Conjoined p, Settable f) => p a (f b) -> p s (f t)
316
317-- | @
318-- type 'IndexedPreservingSetter'' i = 'Simple' 'IndexedPreservingSetter'
319-- @
320type IndexPreservingSetter' s a = IndexPreservingSetter s s a a
321
322-----------------------------------------------------------------------------
323-- Isomorphisms
324-----------------------------------------------------------------------------
325
326-- | Isomorphism families can be composed with another 'Lens' using ('.') and 'id'.
327--
328-- Since every 'Iso' is both a valid 'Lens' and a valid 'Prism', the laws for those types
329-- imply the following laws for an 'Iso' 'f':
330--
331-- @
332-- f '.' 'Control.Lens.Iso.from' f ≡ 'id'
333-- 'Control.Lens.Iso.from' f '.' f ≡ 'id'
334-- @
335--
336-- Note: Composition with an 'Iso' is index- and measure- preserving.
337type Iso s t a b = forall p f. (Profunctor p, Functor f) => p a (f b) -> p s (f t)
338
339-- | @
340-- type 'Iso'' = 'Control.Lens.Type.Simple' 'Iso'
341-- @
342type Iso' s a = Iso s s a a
343
344------------------------------------------------------------------------------
345-- Review Internals
346------------------------------------------------------------------------------
347
348-- | This is a limited form of a 'Prism' that can only be used for 're' operations.
349--
350-- Like with a 'Getter', there are no laws to state for a 'Review'.
351--
352-- You can generate a 'Review' by using 'unto'. You can also use any 'Prism' or 'Iso'
353-- directly as a 'Review'.
354type Review t b = forall p f. (Choice p, Bifunctor p, Settable f) => Optic' p f t b
355
356-- | If you see this in a signature for a function, the function is expecting a 'Review'
357-- (in practice, this usually means a 'Prism').
358type AReview t b = Optic' Tagged Identity t b
359
360------------------------------------------------------------------------------
361-- Prism Internals
362------------------------------------------------------------------------------
363
364-- | A 'Prism' @l@ is a 'Traversal' that can also be turned
365-- around with 'Control.Lens.Review.re' to obtain a 'Getter' in the
366-- opposite direction.
367--
368-- There are three laws that a 'Prism' should satisfy:
369--
370-- First, if I 'Control.Lens.Review.re' or 'Control.Lens.Review.review' a value with a 'Prism' and then 'Control.Lens.Fold.preview' or use ('Control.Lens.Fold.^?'), I will get it back:
371--
372-- @
373-- 'Control.Lens.Fold.preview' l ('Control.Lens.Review.review' l b) ≡ 'Just' b
374-- @
375--
376-- 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@:
377--
378-- @
379-- 'Control.Lens.Fold.preview' l s ≡ 'Just' a ⟹ 'Control.Lens.Review.review' l a ≡ s
380-- @
381--
382-- Third, if you get non-match @t@, you can convert it result back to @s@:
383--
384-- @
385-- 'Control.Lens.Combinators.matching' l s ≡ 'Left' t ⟹ 'Control.Lens.Combinators.matching' l t ≡ 'Left' s
386-- @
387--
388-- The first two laws imply that the 'Traversal' laws hold for every 'Prism' and that we 'Data.Traversable.traverse' at most 1 element:
389--
390-- @
391-- 'Control.Lens.Fold.lengthOf' l x '<=' 1
392-- @
393--
394-- It may help to think of this as an 'Iso' that can be partial in one direction.
395--
396-- Every 'Prism' is a valid 'Traversal'.
397--
398-- Every 'Iso' is a valid 'Prism'.
399--
400-- For example, you might have a @'Prism'' 'Integer' 'Numeric.Natural.Natural'@ allows you to always
401-- go from a 'Numeric.Natural.Natural' to an 'Integer', and provide you with tools to check if an 'Integer' is
402-- a 'Numeric.Natural.Natural' and/or to edit one if it is.
403--
404--
405-- @
406-- 'nat' :: 'Prism'' 'Integer' 'Numeric.Natural.Natural'
407-- 'nat' = 'Control.Lens.Prism.prism' 'toInteger' '$' \\ i ->
408--    if i '<' 0
409--    then 'Left' i
410--    else 'Right' ('fromInteger' i)
411-- @
412--
413-- Now we can ask if an 'Integer' is a 'Numeric.Natural.Natural'.
414--
415-- >>> 5^?nat
416-- Just 5
417--
418-- >>> (-5)^?nat
419-- Nothing
420--
421-- We can update the ones that are:
422--
423-- >>> (-3,4) & both.nat *~ 2
424-- (-3,8)
425--
426-- And we can then convert from a 'Numeric.Natural.Natural' to an 'Integer'.
427--
428-- >>> 5 ^. re nat -- :: Natural
429-- 5
430--
431-- Similarly we can use a 'Prism' to 'Data.Traversable.traverse' the 'Left' half of an 'Either':
432--
433-- >>> Left "hello" & _Left %~ length
434-- Left 5
435--
436-- or to construct an 'Either':
437--
438-- >>> 5^.re _Left
439-- Left 5
440--
441-- such that if you query it with the 'Prism', you will get your original input back.
442--
443-- >>> 5^.re _Left ^? _Left
444-- Just 5
445--
446-- Another interesting way to think of a 'Prism' is as the categorical dual of a 'Lens'
447-- -- a co-'Lens', so to speak. This is what permits the construction of 'Control.Lens.Prism.outside'.
448--
449-- Note: Composition with a 'Prism' is index-preserving.
450type Prism s t a b = forall p f. (Choice p, Applicative f) => p a (f b) -> p s (f t)
451
452-- | A 'Simple' 'Prism'.
453type Prism' s a = Prism s s a a
454
455-------------------------------------------------------------------------------
456-- Equality
457-------------------------------------------------------------------------------
458
459-- | A witness that @(a ~ s, b ~ t)@.
460--
461-- Note: Composition with an 'Equality' is index-preserving.
462#if __GLASGOW_HASKELL__ >= 800
463type Equality (s :: k1) (t :: k2) (a :: k1) (b :: k2) = forall k3 (p :: k1 -> k3 -> Type) (f :: k2 -> k3) .
464#else
465type Equality (s :: k1) (t :: k2) (a :: k1) (b :: k2) = forall (p :: k1 -> * -> *) (f :: k2 -> *) .
466#endif
467    p a (f b) -> p s (f t)
468
469-- | A 'Simple' 'Equality'.
470type Equality' s a = Equality s s a a
471
472-- | Composable `asTypeOf`. Useful for constraining excess
473-- polymorphism, @foo . (id :: As Int) . bar@.
474type As a = Equality' a a
475
476-------------------------------------------------------------------------------
477-- Getters
478-------------------------------------------------------------------------------
479
480-- | A 'Getter' describes how to retrieve a single value in a way that can be
481-- composed with other 'LensLike' constructions.
482--
483-- Unlike a 'Lens' a 'Getter' is read-only. Since a 'Getter'
484-- cannot be used to write back there are no 'Lens' laws that can be applied to
485-- it. In fact, it is isomorphic to an arbitrary function from @(s -> a)@.
486--
487-- Moreover, a 'Getter' can be used directly as a 'Control.Lens.Fold.Fold',
488-- since it just ignores the 'Applicative'.
489type Getter s a = forall f. (Contravariant f, Functor f) => (a -> f a) -> s -> f s
490
491-- | Every 'IndexedGetter' is a valid 'Control.Lens.Fold.IndexedFold' and can be used for 'Control.Lens.Getter.Getting' like a 'Getter'.
492type IndexedGetter i s a = forall p f. (Indexable i p, Contravariant f, Functor f) => p a (f a) -> s -> f s
493
494-- | An 'IndexPreservingGetter' can be used as a 'Getter', but when composed with an 'IndexedTraversal',
495-- 'IndexedFold', or 'IndexedLens' yields an 'IndexedFold', 'IndexedFold' or 'IndexedGetter' respectively.
496type IndexPreservingGetter s a = forall p f. (Conjoined p, Contravariant f, Functor f) => p a (f a) -> p s (f s)
497
498--------------------------
499-- Folds
500--------------------------
501
502-- | A 'Fold' describes how to retrieve multiple values in a way that can be composed
503-- with other 'LensLike' constructions.
504--
505-- A @'Fold' s a@ provides a structure with operations very similar to those of the 'Data.Foldable.Foldable'
506-- typeclass, see 'Control.Lens.Fold.foldMapOf' and the other 'Fold' combinators.
507--
508-- By convention, if there exists a 'foo' method that expects a @'Data.Foldable.Foldable' (f a)@, then there should be a
509-- @fooOf@ method that takes a @'Fold' s a@ and a value of type @s@.
510--
511-- A 'Getter' is a legal 'Fold' that just ignores the supplied 'Data.Monoid.Monoid'.
512--
513-- Unlike a 'Control.Lens.Traversal.Traversal' a 'Fold' is read-only. Since a 'Fold' cannot be used to write back
514-- there are no 'Lens' laws that apply.
515type Fold s a = forall f. (Contravariant f, Applicative f) => (a -> f a) -> s -> f s
516
517-- | Every 'IndexedFold' is a valid 'Control.Lens.Fold.Fold' and can be used for 'Control.Lens.Getter.Getting'.
518type IndexedFold i s a = forall p f.  (Indexable i p, Contravariant f, Applicative f) => p a (f a) -> s -> f s
519
520-- | An 'IndexPreservingFold' can be used as a 'Fold', but when composed with an 'IndexedTraversal',
521-- 'IndexedFold', or 'IndexedLens' yields an 'IndexedFold' respectively.
522type IndexPreservingFold s a = forall p f. (Conjoined p, Contravariant f, Applicative f) => p a (f a) -> p s (f s)
523
524-- | A relevant Fold (aka 'Fold1') has one or more targets.
525type Fold1 s a = forall f. (Contravariant f, Apply f) => (a -> f a) -> s -> f s
526type IndexedFold1 i s a = forall p f.  (Indexable i p, Contravariant f, Apply f) => p a (f a) -> s -> f s
527type IndexPreservingFold1 s a = forall p f. (Conjoined p, Contravariant f, Apply f) => p a (f a) -> p s (f s)
528
529-------------------------------------------------------------------------------
530-- Simple Overloading
531-------------------------------------------------------------------------------
532
533-- | A 'Simple' 'Lens', 'Simple' 'Traversal', ... can
534-- be used instead of a 'Lens','Traversal', ...
535-- whenever the type variables don't change upon setting a value.
536--
537-- @
538-- 'Data.Complex.Lens._imagPart' :: 'Simple' 'Lens' ('Data.Complex.Complex' a) a
539-- 'Control.Lens.Traversal.traversed' :: 'Simple' ('IndexedTraversal' 'Int') [a] a
540-- @
541--
542-- Note: To use this alias in your own code with @'LensLike' f@ or
543-- 'Setter', you may have to turn on @LiberalTypeSynonyms@.
544--
545-- This is commonly abbreviated as a \"prime\" marker, /e.g./ 'Lens'' = 'Simple' 'Lens'.
546type Simple f s a = f s s a a
547
548-------------------------------------------------------------------------------
549-- Optics
550-------------------------------------------------------------------------------
551
552-- | A valid 'Optic' @l@ should satisfy the laws:
553--
554-- @
555-- l 'pure' ≡ 'pure'
556-- l ('Procompose' f g) = 'Procompose' (l f) (l g)
557-- @
558--
559-- This gives rise to the laws for 'Equality', 'Iso', 'Prism', 'Lens',
560-- 'Traversal', 'Traversal1', 'Setter', 'Fold', 'Fold1', and 'Getter' as well
561-- along with their index-preserving variants.
562--
563-- @
564-- type 'LensLike' f s t a b = 'Optic' (->) f s t a b
565-- @
566type Optic p f s t a b = p a (f b) -> p s (f t)
567
568-- | @
569-- type 'Optic'' p f s a = 'Simple' ('Optic' p f) s a
570-- @
571type Optic' p f s a = Optic p f s s a a
572
573-- | @
574-- type 'LensLike' f s t a b = 'Optical' (->) (->) f s t a b
575-- @
576--
577-- @
578-- type 'Over' p f s t a b = 'Optical' p (->) f s t a b
579-- @
580--
581-- @
582-- type 'Optic' p f s t a b = 'Optical' p p f s t a b
583-- @
584type Optical p q f s t a b = p a (f b) -> q s (f t)
585
586-- | @
587-- type 'Optical'' p q f s a = 'Simple' ('Optical' p q f) s a
588-- @
589type Optical' p q f s a = Optical p q f s s a a
590
591
592-- | Many combinators that accept a 'Lens' can also accept a
593-- 'Traversal' in limited situations.
594--
595-- They do so by specializing the type of 'Functor' that they require of the
596-- caller.
597--
598-- If a function accepts a @'LensLike' f s t a b@ for some 'Functor' @f@,
599-- then they may be passed a 'Lens'.
600--
601-- Further, if @f@ is an 'Applicative', they may also be passed a
602-- 'Traversal'.
603type LensLike f s t a b = (a -> f b) -> s -> f t
604
605-- | @
606-- type 'LensLike'' f = 'Simple' ('LensLike' f)
607-- @
608type LensLike' f s a = LensLike f s s a a
609
610-- | Convenient alias for constructing indexed lenses and their ilk.
611type IndexedLensLike i f s t a b = forall p. Indexable i p => p a (f b) -> s -> f t
612
613-- | Convenient alias for constructing simple indexed lenses and their ilk.
614type IndexedLensLike' i f s a = IndexedLensLike i f s s a a
615
616-- | This is a convenient alias for use when you need to consume either indexed or non-indexed lens-likes based on context.
617type Over p f s t a b = p a (f b) -> s -> f t
618
619-- | This is a convenient alias for use when you need to consume either indexed or non-indexed lens-likes based on context.
620--
621-- @
622-- type 'Over'' p f = 'Simple' ('Over' p f)
623-- @
624type Over' p f s a = Over p f s s a a
625