1{-# LANGUAGE CPP #-}
2{-# LANGUAGE RankNTypes #-}
3{-# LANGUAGE Safe #-}
4
5
6{- |
7Module      :  Lens.Micro.Type
8Copyright   :  (C) 2013-2016 Edward Kmett, 2015-2016 Artyom Kazak, 2018 Monadfix
9License     :  BSD-style (see the file LICENSE)
10
11This module provides just the types ('Lens', 'Traversal', etc). It's needed to break the dependency cycle – "Lens.Micro" depends on "Lens.Micro.Internal", but "Lens.Micro.Internal" needs types like 'Lens', so 'Lens' can't be defined in "Lens.Micro".
12-}
13module Lens.Micro.Type
14(
15  ASetter, ASetter',
16  SimpleGetter, Getting,
17  SimpleFold,
18  Lens, Lens',
19  Traversal, Traversal',
20  LensLike, LensLike',
21)
22where
23
24
25import Control.Applicative
26import Data.Functor.Identity
27
28#if __GLASGOW_HASKELL__ < 710
29import Data.Monoid
30#endif
31
32
33{- |
34@ASetter s t a b@ is something that turns a function modifying a value into a function modifying a /structure/. If you ignore 'Identity' (as @Identity a@ is the same thing as @a@), the type is:
35
36@
37type ASetter s t a b = (a -> b) -> s -> t
38@
39
40The reason 'Identity' is used here is for 'ASetter' to be composable with other types, such as 'Lens'.
41
42Technically, if you're writing a library, you shouldn't use this type for setters you are exporting from your library; the right type to use is @<http://hackage.haskell.org/package/lens/docs/Control-Lens-Setter.html#t:Setter Setter>@, but it is not provided by this package (because then it'd have to depend on <http://hackage.haskell.org/package/distributive distributive>). It's completely alright, however, to export functions which take an 'ASetter' as an argument.
43-}
44type ASetter s t a b = (a -> Identity b) -> s -> Identity t
45
46{- |
47This is a type alias for monomorphic setters which don't change the type of the container (or of the value inside). It's useful more often than the same type in lens, because we can't provide real setters and so it does the job of both @<http://hackage.haskell.org/package/lens/docs/Control-Lens-Setter.html#t:ASetter-39- ASetter'>@ and @<http://hackage.haskell.org/package/lens/docs/Control-Lens-Setter.html#t:Setter-39- Setter'>@.
48-}
49type ASetter' s a = ASetter s s a a
50
51{- |
52A @SimpleGetter s a@ extracts @a@ from @s@; so, it's the same thing as @(s -> a)@, but you can use it in lens chains because its type looks like this:
53
54@
55type SimpleGetter s a =
56  forall r. (a -> Const r a) -> s -> Const r s
57@
58
59Since @Const r@ is a functor, 'SimpleGetter' has the same shape as other lens types and can be composed with them. To get @(s -> a)@ out of a 'SimpleGetter', choose @r ~ a@ and feed @Const :: a -> Const a a@ to the getter:
60
61@
62-- the actual signature is more permissive:
63-- 'Lens.Micro.Extras.view' :: 'Getting' a s a -> s -> a
64'Lens.Micro.Extras.view' :: 'SimpleGetter' s a -> s -> a
65'Lens.Micro.Extras.view' getter = 'getConst' . getter 'Const'
66@
67
68The actual @<http://hackage.haskell.org/package/lens/docs/Control-Lens-Getter.html#t:Getter Getter>@ from lens is more general:
69
70@
71type Getter s a =
72  forall f. (Contravariant f, Functor f) => (a -> f a) -> s -> f s
73@
74
75I'm not currently aware of any functions that take lens's @Getter@ but won't accept 'SimpleGetter', but you should try to avoid exporting 'SimpleGetter's anyway to minimise confusion. Alternatively, look at <http://hackage.haskell.org/package/microlens-contra microlens-contra>, which provides a fully lens-compatible @Getter@.
76
77Lens users: you can convert a 'SimpleGetter' to @Getter@ by applying @to . view@ to it.
78-}
79type SimpleGetter s a = forall r. Getting r s a
80
81{- |
82Functions that operate on getters and folds – such as ('Lens.Micro.^.'), ('Lens.Micro.^..'), ('Lens.Micro.^?') – use @Getter r s a@ (with different values of @r@) to describe what kind of result they need. For instance, ('Lens.Micro.^.') needs the getter to be able to return a single value, and so it accepts a getter of type @Getting a s a@. ('Lens.Micro.^..') wants the getter to gather values together, so it uses @Getting (Endo [a]) s a@ (it could've used @Getting [a] s a@ instead, but it's faster with 'Data.Monoid.Endo'). The choice of @r@ depends on what you want to do with elements you're extracting from @s@.
83-}
84type Getting r s a = (a -> Const r a) -> s -> Const r s
85
86{- |
87A @SimpleFold s a@ extracts several @a@s from @s@; so, it's pretty much the same thing as @(s -> [a])@, but you can use it with lens operators.
88
89The actual @Fold@ from lens is more general:
90
91@
92type Fold s a =
93  forall f. (Contravariant f, Applicative f) => (a -> f a) -> s -> f s
94@
95
96There are several functions in lens that accept lens's @Fold@ but won't accept 'SimpleFold'; I'm aware of
97@<http://hackage.haskell.org/package/lens/docs/Control-Lens-Fold.html#v:takingWhile takingWhile>@,
98@<http://hackage.haskell.org/package/lens/docs/Control-Lens-Fold.html#v:droppingWhile droppingWhile>@,
99@<http://hackage.haskell.org/package/lens/docs/Control-Lens-Fold.html#v:backwards backwards>@,
100@<http://hackage.haskell.org/package/lens/docs/Control-Lens-Fold.html#v:foldByOf foldByOf>@,
101@<http://hackage.haskell.org/package/lens/docs/Control-Lens-Fold.html#v:foldMapByOf foldMapByOf>@.
102For this reason, try not to export 'SimpleFold's if at all possible. <http://hackage.haskell.org/package/microlens-contra microlens-contra> provides a fully lens-compatible @Fold@.
103
104Lens users: you can convert a 'SimpleFold' to @Fold@ by applying @folded . toListOf@ to it.
105-}
106type SimpleFold s a = forall r. Monoid r => Getting r s a
107
108{- |
109@Lens s t a b@ is the lowest common denominator of a setter and a getter, something that has the power of both; it has a 'Functor' constraint, and since both 'Const' and 'Identity' are functors, it can be used whenever a getter or a setter is needed.
110
111  * @a@ is the type of the value inside of structure
112  * @b@ is the type of the replaced value
113  * @s@ is the type of the whole structure
114  * @t@ is the type of the structure after replacing @a@ in it with @b@
115-}
116type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t
117
118{- |
119This is a type alias for monomorphic lenses which don't change the type of the container (or of the value inside).
120-}
121type Lens' s a = Lens s s a a
122
123{- |
124@Traversal s t a b@ is a generalisation of 'Lens' which allows many targets (possibly 0). It's achieved by changing the constraint to 'Applicative' instead of 'Functor' – indeed, the point of 'Applicative' is that you can combine effects, which is just what we need to have many targets.
125
126Ultimately, traversals should follow 2 laws:
127
128@
129t pure ≡ pure
130fmap (t f) . t g ≡ getCompose . t (Compose . fmap f . g)
131@
132
133The 1st law states that you can't change the shape of the structure or do anything funny with elements (traverse elements which aren't in the structure, create new elements out of thin air, etc.). The 2nd law states that you should be able to fuse 2 identical traversals into one. For a more detailed explanation of the laws, see <http://artyom.me/lens-over-tea-2#traversal-laws this blog post> (if you prefer rambling blog posts), or <https://www.cs.ox.ac.uk/jeremy.gibbons/publications/iterator.pdf The Essence Of The Iterator Pattern> (if you prefer papers).
134
135Traversing any value twice is a violation of traversal laws. You can, however, traverse values in any order.
136-}
137type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t
138
139{- |
140This is a type alias for monomorphic traversals which don't change the type of the container (or of the values inside).
141-}
142type Traversal' s a = Traversal s s a a
143
144{- |
145'LensLike' is a type that is often used to make combinators as general as possible. For instance, take ('Lens.Micro.<<%~'), which only requires the passed lens to be able to work with the @(,) a@ functor (lenses and traversals can do that). The fully expanded type is as follows:
146
147@
148('Lens.Micro.<<%~') :: ((a -> (a, b)) -> s -> (a, t)) -> (a -> b) -> s -> (a, t)
149@
150
151With 'LensLike', the intent to use the @(,) a@ functor can be made a bit clearer:
152
153@
154('Lens.Micro.<<%~') :: LensLike ((,) a) s t a b -> (a -> b) -> s -> (a, t)
155@
156-}
157type LensLike f s t a b = (a -> f b) -> s -> f t
158
159{- |
160A type alias for monomorphic 'LensLike's.
161-}
162type LensLike' f s a = LensLike f s s a a
163