1{-# LANGUAGE CPP #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE UndecidableInstances #-}
5{-# LANGUAGE RankNTypes #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7{-# LANGUAGE KindSignatures #-}
8{-# LANGUAGE TypeFamilies #-}
9{-# LANGUAGE MultiParamTypeClasses #-}
10{-# LANGUAGE FunctionalDependencies #-}
11{-# LANGUAGE ConstraintKinds #-}
12{-# LANGUAGE ImplicitParams #-}
13
14-- Note: this module is marked 'Unsafe' because it exports (#.), which is essentially 'coerce', and Data.Coerce is marked 'Unsafe' in base. As per <https://github.com/ekmett/lens/issues/661>, this is an issue for 'lens' as well but they have opted for 'Trustworthy' instead.
15{-# LANGUAGE Unsafe #-}
16
17{- |
18Module      :  Lens.Micro.Internal
19Copyright   :  (C) 2013-2016 Edward Kmett, 2015-2016 Artyom Kazak, 2018 Monadfix
20License     :  BSD-style (see the file LICENSE)
21
22This module is needed to give other packages from the microlens family (like <http://hackage.haskell.org/package/microlens-ghc microlens-ghc>) access to functions and classes that don't need to be exported from "Lens.Micro" (because they just clutter the namespace). Also:
23
24  * 'traversed' is here because otherwise there'd be a dependency cycle
25  * 'sets' is here because it's used in RULEs
26
27Classes like 'Each', 'Ixed', etc are provided for convenience – you're not supposed to export functions that work on all members of 'Ixed', for instance. Only microlens can do that. You mustn't declare instances of those classes for other types, either; these classes are incompatible with lens's classes, and by doing so you would divide the ecosystem.
28
29If you absolutely need to define an instance (e.g. for internal use), only do it for your own types, because otherwise I might add an instance to one of the microlens packages later and if our instances are different it might lead to subtle bugs.
30-}
31module Lens.Micro.Internal
32(
33  traversed,
34  folded,
35  foldring,
36  foldrOf,
37  foldMapOf,
38  sets,
39  ( #. ),
40  ( .# ),
41  phantom,
42  Each(..),
43  Index,
44  IxValue,
45  Ixed(..),
46  At(..),
47  ixAt,
48  Field1(..),
49  Field2(..),
50  Field3(..),
51  Field4(..),
52  Field5(..),
53  Cons(..),
54  Snoc(..),
55  Strict(..),
56
57  -- * CallStack
58  HasCallStack,
59)
60where
61
62
63import Lens.Micro.Type
64
65import Control.Applicative
66import Data.Monoid
67import Data.Foldable as F
68import Data.Functor.Identity
69import Data.Complex
70
71#if __GLASGOW_HASKELL__ >= 800
72import Data.List.NonEmpty (NonEmpty)
73#endif
74
75#if __GLASGOW_HASKELL__ < 710
76import Data.Traversable
77#endif
78
79#if __GLASGOW_HASKELL__ >= 708
80import Data.Coerce
81#else
82import Unsafe.Coerce
83#endif
84
85-- We don't depend on the call-stack package because building an extra
86-- package is likely slower than adding several lines of code here.
87#if MIN_VERSION_base(4,9,0)
88import GHC.Stack (HasCallStack)
89#elif MIN_VERSION_base(4,8,1)
90import qualified GHC.Stack as GHC
91type HasCallStack = (?callStack :: GHC.CallStack)
92#else
93import GHC.Exts (Constraint)
94type HasCallStack = (() :: Constraint)
95#endif
96
97{- |
98'traversed' traverses any 'Traversable' container (list, vector, @Map@, 'Maybe', you name it):
99
100>>> Just 1 ^.. traversed
101[1]
102
103'traversed' is the same as 'traverse', but can be faster thanks to magic rewrite rules.
104-}
105traversed :: Traversable f => Traversal (f a) (f b) a b
106traversed = traverse
107{-# INLINE [0] traversed #-}
108
109{-# RULES
110"traversed -> mapped"
111  traversed = sets fmap :: Functor f => ASetter (f a) (f b) a b;
112"traversed -> folded"
113  traversed = folded :: Foldable f => Getting (Endo r) (f a) a;
114  #-}
115
116{- |
117'folded' is a fold for anything 'Foldable'. In a way, it's an opposite of
118'mapped' – the most powerful getter, but can't be used as a setter.
119-}
120folded :: Foldable f => SimpleFold (f a) a
121folded = foldring F.foldr
122{-# INLINE folded #-}
123
124foldring :: Monoid r => ((a -> Const r a -> Const r a) -> Const r a -> s -> Const r a) -> (a -> Const r b) -> s -> Const r t
125foldring fr f = phantom . fr (\a fa -> f a *> fa) noEffect
126{-# INLINE foldring #-}
127
128foldrOf :: Getting (Endo r) s a -> (a -> r -> r) -> r -> s -> r
129foldrOf l f z = flip appEndo z . foldMapOf l (Endo #. f)
130{-# INLINE foldrOf #-}
131
132foldMapOf :: Getting r s a -> (a -> r) -> s -> r
133foldMapOf l f = getConst #. l (Const #. f)
134{-# INLINE foldMapOf #-}
135
136{- |
137'sets' creates an 'ASetter' from an ordinary function. (The only thing it does is wrapping and unwrapping 'Identity'.)
138-}
139sets :: ((a -> b) -> s -> t) -> ASetter s t a b
140sets f g = Identity #. f (runIdentity #. g)
141{-# INLINE sets #-}
142
143------------------------------------------------------------------------------
144-- Control.Lens.Internal.Getter
145------------------------------------------------------------------------------
146
147-- was renamed from “coerce”
148phantom :: Const r a -> Const r b
149phantom = Const #. getConst
150{-# INLINE phantom #-}
151
152noEffect :: Monoid r => Const r a
153noEffect = phantom (pure ())
154{-# INLINE noEffect #-}
155
156------------------------------------------------------------------------------
157-- Data.Profunctor.Unsafe
158------------------------------------------------------------------------------
159
160-- Note: 'lens' defines a type-restricted version of (#.) to work around a
161-- bug, but our version is restricted enough that we don't need it. See
162-- <https://github.com/ekmett/lens/commit/cde2fc39c0dba413d1a6f814b47bd14431a5e339>
163
164#if __GLASGOW_HASKELL__ >= 708
165( #. ) :: Coercible c b => (b -> c) -> (a -> b) -> (a -> c)
166( #. ) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b
167
168( .# ) :: Coercible b a => (b -> c) -> (a -> b) -> (a -> c)
169( .# ) pbc _ = coerce pbc
170#else
171( #. ) :: (b -> c) -> (a -> b) -> (a -> c)
172( #. ) _ = unsafeCoerce
173
174( .# ) :: (b -> c) -> (a -> b) -> (a -> c)
175( .# ) pbc _ = unsafeCoerce pbc
176#endif
177
178{-# INLINE ( #. ) #-}
179{-# INLINE ( .# ) #-}
180
181infixr 9 #.
182infixl 8 .#
183
184------------------------------------------------------------------------------
185-- classes
186------------------------------------------------------------------------------
187
188class Each s t a b | s -> a, t -> b, s b -> t, t a -> s where
189  {- |
190'each' tries to be a universal 'Traversal' – it behaves like 'traversed' in most situations, but also adds support for e.g. tuples with same-typed values:
191
192>>> (1,2) & each %~ succ
193(2,3)
194
195>>> ["x", "y", "z"] ^. each
196"xyz"
197
198However, note that 'each' doesn't work on /every/ instance of 'Traversable'. If you have a 'Traversable' which isn't supported by 'each', you can use 'traversed' instead. Personally, I like using 'each' instead of 'traversed' whenever possible – it's shorter and more descriptive.
199
200You can use 'each' with these things:
201
202@
203'each' :: 'Traversal' [a] [b] a b
204
205'each' :: 'Traversal' ('Maybe' a) ('Maybe' b) a b
206'each' :: 'Traversal' ('Either' a a) ('Either' b b) a b  -- since 0.4.11
207
208'each' :: 'Traversal' (a,a) (b,b) a b
209'each' :: 'Traversal' (a,a,a) (b,b,b) a b
210'each' :: 'Traversal' (a,a,a,a) (b,b,b,b) a b
211'each' :: 'Traversal' (a,a,a,a,a) (b,b,b,b,b) a b
212
213'each' :: ('RealFloat' a, 'RealFloat' b) => 'Traversal' ('Complex' a) ('Complex' b) a b
214@
215
216You can also use 'each' with types from <http://hackage.haskell.org/package/array array>, <http://hackage.haskell.org/package/bytestring bytestring>, and <http://hackage.haskell.org/package/containers containers> by using <http://hackage.haskell.org/package/microlens-ghc microlens-ghc>, or additionally with types from <http://hackage.haskell.org/package/vector vector>, <http://hackage.haskell.org/package/text text>, and <http://hackage.haskell.org/package/unordered-containers unordered-containers> by using <http://hackage.haskell.org/package/microlens-platform microlens-platform>.
217  -}
218  each :: Traversal s t a b
219
220instance (a~b, q~r) => Each (a,b) (q,r) a q where
221  each f ~(a,b) = (,) <$> f a <*> f b
222  {-# INLINE each #-}
223
224instance (a~b, a~c, q~r, q~s) => Each (a,b,c) (q,r,s) a q where
225  each f ~(a,b,c) = (,,) <$> f a <*> f b <*> f c
226  {-# INLINE each #-}
227
228instance (a~b, a~c, a~d, q~r, q~s, q~t) => Each (a,b,c,d) (q,r,s,t) a q where
229  each f ~(a,b,c,d) = (,,,) <$> f a <*> f b <*> f c <*> f d
230  {-# INLINE each #-}
231
232instance (a~b, a~c, a~d, a~e, q~r, q~s, q~t, q~u) => Each (a,b,c,d,e) (q,r,s,t,u) a q where
233  each f ~(a,b,c,d,e) = (,,,,) <$> f a <*> f b <*> f c <*> f d <*> f e
234  {-# INLINE each #-}
235
236instance Each (Complex a) (Complex b) a b where
237  each f (a :+ b) = (:+) <$> f a <*> f b
238  {-# INLINE each #-}
239
240instance Each [a] [b] a b where
241  each = traversed
242  {-# INLINE each #-}
243
244instance Each (Maybe a) (Maybe b) a b where
245  each = traverse
246  {-# INLINE each #-}
247
248{- |
249@since 0.4.11
250-}
251instance (a~a', b~b') => Each (Either a a') (Either b b') a b where
252  each f (Left a)   = Left <$> f a
253  each f (Right a ) = Right <$> f a
254  {-# INLINE each #-}
255
256#if __GLASGOW_HASKELL__ >= 800
257instance Each (NonEmpty a) (NonEmpty b) a b where
258  each = traversed
259  {-# INLINE each #-}
260#endif
261
262-- NOTE: when adding new instances of 'Each', update the docs for 'each'.
263
264type family Index (s :: *) :: *
265
266type family IxValue (m :: *) :: *
267
268type instance Index   (e -> a) = e
269type instance IxValue (e -> a) = a
270type instance Index   [a] = Int
271type instance IxValue [a] = a
272
273class Ixed m where
274  {- |
275This traversal lets you access (and update) an arbitrary element in a list, array, @Map@, etc. (If you want to insert or delete elements as well, look at 'at'.)
276
277An example for lists:
278
279>>> [0..5] & ix 3 .~ 10
280[0,1,2,10,4,5]
281
282You can use it for getting, too:
283
284>>> [0..5] ^? ix 3
285Just 3
286
287Of course, the element may not be present (which means that you can use 'ix' as a safe variant of ('!!')):
288
289>>> [0..5] ^? ix 10
290Nothing
291
292Another useful instance is the one for functions – it lets you modify their outputs for specific inputs. For instance, here's 'maximum' that returns 0 when the list is empty (instead of throwing an exception):
293
294@
295maximum0 = 'maximum' 'Lens.Micro.&' 'ix' [] 'Lens.Micro..~' 0
296@
297
298The following instances are provided in this package:
299
300@
301'ix' :: 'Int' -> 'Traversal'' [a] a
302
303'ix' :: ('Eq' e) => e -> 'Traversal'' (e -> a) a
304@
305
306You can also use 'ix' with types from <http://hackage.haskell.org/package/array array>, <http://hackage.haskell.org/package/bytestring bytestring>, and <http://hackage.haskell.org/package/containers containers> by using <http://hackage.haskell.org/package/microlens-ghc microlens-ghc>, or additionally with types from <http://hackage.haskell.org/package/vector vector>, <http://hackage.haskell.org/package/text text>, and <http://hackage.haskell.org/package/unordered-containers unordered-containers> by using <http://hackage.haskell.org/package/microlens-platform microlens-platform>.
307  -}
308  ix :: Index m -> Traversal' m (IxValue m)
309
310class Ixed m => At m where
311  {- |
312This lens lets you read, write, or delete elements in @Map@-like structures. It returns 'Nothing' when the value isn't found, just like @lookup@:
313
314@
315Data.Map.lookup k m = m 'Lens.Micro.^.' at k
316@
317
318However, it also lets you insert and delete values by setting the value to @'Just' value@ or 'Nothing':
319
320@
321Data.Map.insert k a m = m 'Lens.Micro.&' at k 'Lens.Micro..~' Just a
322
323Data.Map.delete k m = m 'Lens.Micro.&' at k 'Lens.Micro..~' Nothing
324@
325
326Or you could use ('Lens.Micro.?~') instead of ('Lens.Micro..~'):
327
328@
329Data.Map.insert k a m = m 'Lens.Micro.&' at k 'Lens.Micro.?~' a
330@
331
332Note that 'at' doesn't work for arrays or lists. You can't delete an arbitrary element from an array (what would be left in its place?), and you can't set an arbitrary element in a list because if the index is out of list's bounds, you'd have to somehow fill the stretch between the last element and the element you just inserted (i.e. @[1,2,3] & at 10 .~ 5@ is undefined). If you want to modify an already existing value in an array or list, you should use 'ix' instead.
333
334'at' is often used with 'Lens.Micro.non'. See the documentation of 'Lens.Micro.non' for examples.
335
336Note that 'at' isn't strict for @Map@, even if you're using @Data.Map.Strict@:
337
338>>> Data.Map.Strict.size (Data.Map.Strict.empty & at 1 .~ Just undefined)
3391
340
341The reason for such behavior is that there's actually no “strict @Map@” type; @Data.Map.Strict@ just provides some strict functions for ordinary @Map@s.
342
343This package doesn't actually provide any instances for 'at', but there are instances for @Map@ and @IntMap@ in <http://hackage.haskell.org/package/microlens-ghc microlens-ghc> and an instance for @HashMap@ in <http://hackage.haskell.org/package/microlens-platform microlens-platform>.
344  -}
345  at :: Index m -> Lens' m (Maybe (IxValue m))
346
347ixAt :: At m => Index m -> Traversal' m (IxValue m)
348ixAt i = at i . traverse
349{-# INLINE ixAt #-}
350
351instance Eq e => Ixed (e -> a) where
352  ix e p f = (\a e' -> if e == e' then a else f e') <$> p (f e)
353  {-# INLINE ix #-}
354
355instance Ixed [a] where
356  ix k f xs0 | k < 0     = pure xs0
357             | otherwise = go xs0 k where
358    go [] _ = pure []
359    go (a:as) 0 = (:as) <$> f a
360    go (a:as) i = (a:) <$> (go as $! i - 1)
361  {-# INLINE ix #-}
362
363class Field1 s t a b | s -> a, t -> b, s b -> t, t a -> s where
364  {- |
365Gives access to the 1st field of a tuple (up to 5-tuples).
366
367Getting the 1st component:
368
369>>> (1,2,3,4,5) ^. _1
3701
371
372Setting the 1st component:
373
374>>> (1,2,3) & _1 .~ 10
375(10,2,3)
376
377Note that this lens is lazy, and can set fields even of 'undefined':
378
379>>> set _1 10 undefined :: (Int, Int)
380(10,*** Exception: Prelude.undefined
381
382This is done to avoid violating a lens law stating that you can get back what you put:
383
384>>> view _1 . set _1 10 $ (undefined :: (Int, Int))
38510
386
387The implementation (for 2-tuples) is:
388
389@
390'_1' f t = (,) '<$>' f    ('fst' t)
391             '<*>' 'pure' ('snd' t)
392@
393
394or, alternatively,
395
396@
397'_1' f ~(a,b) = (\\a' -> (a',b)) '<$>' f a
398@
399
400(where @~@ means a <https://wiki.haskell.org/Lazy_pattern_match lazy pattern>).
401
402'_2', '_3', '_4', and '_5' are also available (see below).
403  -}
404  _1 :: Lens s t a b
405
406instance Field1 (a,b) (a',b) a a' where
407  _1 k ~(a,b) = (\a' -> (a',b)) <$> k a
408  {-# INLINE _1 #-}
409
410instance Field1 (a,b,c) (a',b,c) a a' where
411  _1 k ~(a,b,c) = (\a' -> (a',b,c)) <$> k a
412  {-# INLINE _1 #-}
413
414instance Field1 (a,b,c,d) (a',b,c,d) a a' where
415  _1 k ~(a,b,c,d) = (\a' -> (a',b,c,d)) <$> k a
416  {-# INLINE _1 #-}
417
418instance Field1 (a,b,c,d,e) (a',b,c,d,e) a a' where
419  _1 k ~(a,b,c,d,e) = (\a' -> (a',b,c,d,e)) <$> k a
420  {-# INLINE _1 #-}
421
422{-
423
424instance Field1 (a,b,c,d,e,f) (a',b,c,d,e,f) a a' where
425  _1 k ~(a,b,c,d,e,f) = (\a' -> (a',b,c,d,e,f)) <$> k a
426  {-# INLINE _1 #-}
427
428instance Field1 (a,b,c,d,e,f,g) (a',b,c,d,e,f,g) a a' where
429  _1 k ~(a,b,c,d,e,f,g) = (\a' -> (a',b,c,d,e,f,g)) <$> k a
430  {-# INLINE _1 #-}
431
432instance Field1 (a,b,c,d,e,f,g,h) (a',b,c,d,e,f,g,h) a a' where
433  _1 k ~(a,b,c,d,e,f,g,h) = (\a' -> (a',b,c,d,e,f,g,h)) <$> k a
434  {-# INLINE _1 #-}
435
436instance Field1 (a,b,c,d,e,f,g,h,i) (a',b,c,d,e,f,g,h,i) a a' where
437  _1 k ~(a,b,c,d,e,f,g,h,i) = (\a' -> (a',b,c,d,e,f,g,h,i)) <$> k a
438  {-# INLINE _1 #-}
439
440-}
441
442class Field2 s t a b | s -> a, t -> b, s b -> t, t a -> s where
443  _2 :: Lens s t a b
444
445instance Field2 (a,b) (a,b') b b' where
446  _2 k ~(a,b) = (\b' -> (a,b')) <$> k b
447  {-# INLINE _2 #-}
448
449instance Field2 (a,b,c) (a,b',c) b b' where
450  _2 k ~(a,b,c) = (\b' -> (a,b',c)) <$> k b
451  {-# INLINE _2 #-}
452
453instance Field2 (a,b,c,d) (a,b',c,d) b b' where
454  _2 k ~(a,b,c,d) = (\b' -> (a,b',c,d)) <$> k b
455  {-# INLINE _2 #-}
456
457instance Field2 (a,b,c,d,e) (a,b',c,d,e) b b' where
458  _2 k ~(a,b,c,d,e) = (\b' -> (a,b',c,d,e)) <$> k b
459  {-# INLINE _2 #-}
460
461{-
462
463instance Field2 (a,b,c,d,e,f) (a,b',c,d,e,f) b b' where
464  _2 k ~(a,b,c,d,e,f) = (\b' -> (a,b',c,d,e,f)) <$> k b
465  {-# INLINE _2 #-}
466
467instance Field2 (a,b,c,d,e,f,g) (a,b',c,d,e,f,g) b b' where
468  _2 k ~(a,b,c,d,e,f,g) = (\b' -> (a,b',c,d,e,f,g)) <$> k b
469  {-# INLINE _2 #-}
470
471instance Field2 (a,b,c,d,e,f,g,h) (a,b',c,d,e,f,g,h) b b' where
472  _2 k ~(a,b,c,d,e,f,g,h) = (\b' -> (a,b',c,d,e,f,g,h)) <$> k b
473  {-# INLINE _2 #-}
474
475instance Field2 (a,b,c,d,e,f,g,h,i) (a,b',c,d,e,f,g,h,i) b b' where
476  _2 k ~(a,b,c,d,e,f,g,h,i) = (\b' -> (a,b',c,d,e,f,g,h,i)) <$> k b
477  {-# INLINE _2 #-}
478
479-}
480
481class Field3 s t a b | s -> a, t -> b, s b -> t, t a -> s where
482  _3 :: Lens s t a b
483
484instance Field3 (a,b,c) (a,b,c') c c' where
485  _3 k ~(a,b,c) = (\c' -> (a,b,c')) <$> k c
486  {-# INLINE _3 #-}
487
488instance Field3 (a,b,c,d) (a,b,c',d) c c' where
489  _3 k ~(a,b,c,d) = (\c' -> (a,b,c',d)) <$> k c
490  {-# INLINE _3 #-}
491
492instance Field3 (a,b,c,d,e) (a,b,c',d,e) c c' where
493  _3 k ~(a,b,c,d,e) = (\c' -> (a,b,c',d,e)) <$> k c
494  {-# INLINE _3 #-}
495
496{-
497
498instance Field3 (a,b,c,d,e,f) (a,b,c',d,e,f) c c' where
499  _3 k ~(a,b,c,d,e,f) = (\c' -> (a,b,c',d,e,f)) <$> k c
500  {-# INLINE _3 #-}
501
502instance Field3 (a,b,c,d,e,f,g) (a,b,c',d,e,f,g) c c' where
503  _3 k ~(a,b,c,d,e,f,g) = (\c' -> (a,b,c',d,e,f,g)) <$> k c
504  {-# INLINE _3 #-}
505
506instance Field3 (a,b,c,d,e,f,g,h) (a,b,c',d,e,f,g,h) c c' where
507  _3 k ~(a,b,c,d,e,f,g,h) = (\c' -> (a,b,c',d,e,f,g,h)) <$> k c
508  {-# INLINE _3 #-}
509
510instance Field3 (a,b,c,d,e,f,g,h,i) (a,b,c',d,e,f,g,h,i) c c' where
511  _3 k ~(a,b,c,d,e,f,g,h,i) = (\c' -> (a,b,c',d,e,f,g,h,i)) <$> k c
512  {-# INLINE _3 #-}
513
514-}
515
516class Field4 s t a b | s -> a, t -> b, s b -> t, t a -> s where
517  _4 :: Lens s t a b
518
519instance Field4 (a,b,c,d) (a,b,c,d') d d' where
520  _4 k ~(a,b,c,d) = (\d' -> (a,b,c,d')) <$> k d
521  {-# INLINE _4 #-}
522
523instance Field4 (a,b,c,d,e) (a,b,c,d',e) d d' where
524  _4 k ~(a,b,c,d,e) = (\d' -> (a,b,c,d',e)) <$> k d
525  {-# INLINE _4 #-}
526
527{-
528
529instance Field4 (a,b,c,d,e,f) (a,b,c,d',e,f) d d' where
530  _4 k ~(a,b,c,d,e,f) = (\d' -> (a,b,c,d',e,f)) <$> k d
531  {-# INLINE _4 #-}
532
533instance Field4 (a,b,c,d,e,f,g) (a,b,c,d',e,f,g) d d' where
534  _4 k ~(a,b,c,d,e,f,g) = (\d' -> (a,b,c,d',e,f,g)) <$> k d
535  {-# INLINE _4 #-}
536
537instance Field4 (a,b,c,d,e,f,g,h) (a,b,c,d',e,f,g,h) d d' where
538  _4 k ~(a,b,c,d,e,f,g,h) = (\d' -> (a,b,c,d',e,f,g,h)) <$> k d
539  {-# INLINE _4 #-}
540
541instance Field4 (a,b,c,d,e,f,g,h,i) (a,b,c,d',e,f,g,h,i) d d' where
542  _4 k ~(a,b,c,d,e,f,g,h,i) = (\d' -> (a,b,c,d',e,f,g,h,i)) <$> k d
543  {-# INLINE _4 #-}
544
545-}
546
547class Field5 s t a b | s -> a, t -> b, s b -> t, t a -> s where
548  _5 :: Lens s t a b
549
550instance Field5 (a,b,c,d,e) (a,b,c,d,e') e e' where
551  _5 k ~(a,b,c,d,e) = (\e' -> (a,b,c,d,e')) <$> k e
552  {-# INLINE _5 #-}
553
554{-
555
556instance Field5 (a,b,c,d,e,f) (a,b,c,d,e',f) e e' where
557  _5 k ~(a,b,c,d,e,f) = (\e' -> (a,b,c,d,e',f)) <$> k e
558  {-# INLINE _5 #-}
559
560instance Field5 (a,b,c,d,e,f,g) (a,b,c,d,e',f,g) e e' where
561  _5 k ~(a,b,c,d,e,f,g) = (\e' -> (a,b,c,d,e',f,g)) <$> k e
562  {-# INLINE _5 #-}
563
564instance Field5 (a,b,c,d,e,f,g,h) (a,b,c,d,e',f,g,h) e e' where
565  _5 k ~(a,b,c,d,e,f,g,h) = (\e' -> (a,b,c,d,e',f,g,h)) <$> k e
566  {-# INLINE _5 #-}
567
568instance Field5 (a,b,c,d,e,f,g,h,i) (a,b,c,d,e',f,g,h,i) e e' where
569  _5 k ~(a,b,c,d,e,f,g,h,i) = (\e' -> (a,b,c,d,e',f,g,h,i)) <$> k e
570  {-# INLINE _5 #-}
571
572-}
573
574class Cons s t a b | s -> a, t -> b, s b -> t, t a -> s where
575  _Cons :: Traversal s t (a,s) (b,t)
576
577instance Cons [a] [b] a b where
578  _Cons f (a:as) = uncurry (:) <$> f (a, as)
579  _Cons _ []     = pure []
580  {-# INLINE _Cons #-}
581
582class Snoc s t a b | s -> a, t -> b, s b -> t, t a -> s where
583  _Snoc :: Traversal s t (s,a) (t,b)
584
585instance Snoc [a] [b] a b where
586  _Snoc _ [] = pure []
587  _Snoc f xs = (\(as,a) -> as ++ [a]) <$> f (init xs, last xs)
588  {-# INLINE _Snoc #-}
589
590class Strict lazy strict | lazy -> strict, strict -> lazy where
591  {- |
592'strict' lets you convert between strict and lazy versions of a datatype:
593
594>>> let someText = "hello" :: Lazy.Text
595>>> someText ^. strict
596"hello" :: Strict.Text
597
598It can also be useful if you have a function that works on a strict type but your type is lazy:
599
600@
601stripDiacritics :: Strict.Text -> Strict.Text
602stripDiacritics = ...
603@
604
605>>> let someText = "Paul Erdős" :: Lazy.Text
606>>> someText & strict %~ stripDiacritics
607"Paul Erdos" :: Lazy.Text
608
609'strict' works on @ByteString@ and @StateT@\/@WriterT@\/@RWST@ if you use <http://hackage.haskell.org/package/microlens-ghc microlens-ghc>, and additionally on @Text@ if you use <http://hackage.haskell.org/package/microlens-platform microlens-platform>.
610  -}
611  strict :: Lens' lazy strict
612
613  {- |
614'lazy' is like 'strict' but works in opposite direction:
615
616>>> let someText = "hello" :: Strict.Text
617>>> someText ^. lazy
618"hello" :: Lazy.Text
619  -}
620  lazy   :: Lens' strict lazy
621