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 '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  phantom,
40  Each(..),
41  Index,
42  IxValue,
43  Ixed(..),
44  At(..),
45  ixAt,
46  Field1(..),
47  Field2(..),
48  Field3(..),
49  Field4(..),
50  Field5(..),
51  Cons(..),
52  Snoc(..),
53  Strict(..),
54
55  -- * CallStack
56  HasCallStack,
57
58  -- * Coerce compatibility shim
59  coerce,
60
61  -- * Coerce-like composition
62  ( #. ),
63  ( .# ),
64)
65where
66
67
68import Lens.Micro.Type
69
70import Control.Applicative
71import Data.Monoid
72import Data.Foldable as F
73import Data.Functor.Identity
74import Data.Complex
75
76#if __GLASGOW_HASKELL__ >= 800
77import Data.List.NonEmpty (NonEmpty(..))
78#endif
79
80#if __GLASGOW_HASKELL__ < 710
81import Data.Traversable
82#endif
83
84#if __GLASGOW_HASKELL__ >= 708
85import Data.Coerce
86#else
87import Unsafe.Coerce
88#endif
89
90-- We don't depend on the call-stack package because building an extra
91-- package is likely slower than adding several lines of code here.
92#if MIN_VERSION_base(4,9,0)
93import GHC.Stack (HasCallStack)
94#elif MIN_VERSION_base(4,8,1)
95import qualified GHC.Stack as GHC
96type HasCallStack = (?callStack :: GHC.CallStack)
97#else
98import GHC.Exts (Constraint)
99type HasCallStack = (() :: Constraint)
100#endif
101
102{- |
103'traversed' traverses any 'Traversable' container (list, vector, @Map@, 'Maybe', you name it):
104
105>>> Just 1 ^.. traversed
106[1]
107
108'traversed' is the same as 'traverse', but can be faster thanks to magic rewrite rules.
109-}
110traversed :: Traversable f => Traversal (f a) (f b) a b
111traversed = traverse
112{-# INLINE [0] traversed #-}
113
114{-# RULES
115"traversed -> mapped"
116  traversed = sets fmap :: Functor f => ASetter (f a) (f b) a b;
117"traversed -> folded"
118  traversed = folded :: Foldable f => Getting (Endo r) (f a) a;
119  #-}
120
121{- |
122'folded' is a fold for anything 'Foldable'. In a way, it's an opposite of
123'mapped' – the most powerful getter, but can't be used as a setter.
124-}
125folded :: Foldable f => SimpleFold (f a) a
126folded = foldring F.foldr
127{-# INLINE folded #-}
128
129foldring :: Monoid r => ((a -> Const r a -> Const r a) -> Const r a -> s -> Const r a) -> (a -> Const r b) -> s -> Const r t
130foldring fr f = phantom . fr (\a fa -> f a *> fa) noEffect
131{-# INLINE foldring #-}
132
133foldrOf :: Getting (Endo r) s a -> (a -> r -> r) -> r -> s -> r
134foldrOf l f z = flip appEndo z . foldMapOf l (Endo #. f)
135{-# INLINE foldrOf #-}
136
137foldMapOf :: Getting r s a -> (a -> r) -> s -> r
138foldMapOf l f = getConst #. l (Const #. f)
139{-# INLINE foldMapOf #-}
140
141{- |
142'sets' creates an 'ASetter' from an ordinary function. (The only thing it does is wrapping and unwrapping 'Identity'.)
143-}
144sets :: ((a -> b) -> s -> t) -> ASetter s t a b
145sets f g = Identity #. f (runIdentity #. g)
146{-# INLINE sets #-}
147
148------------------------------------------------------------------------------
149-- Control.Lens.Internal.Getter
150------------------------------------------------------------------------------
151
152-- was renamed from “coerce”
153phantom :: Const r a -> Const r b
154phantom = Const #. getConst
155{-# INLINE phantom #-}
156
157noEffect :: Monoid r => Const r a
158noEffect = phantom (pure ())
159{-# INLINE noEffect #-}
160
161------------------------------------------------------------------------------
162-- classes
163------------------------------------------------------------------------------
164
165class Each s t a b | s -> a, t -> b, s b -> t, t a -> s where
166  {- |
167'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:
168
169>>> (1,2) & each %~ succ
170(2,3)
171
172>>> ["x", "y", "z"] ^. each
173"xyz"
174
175However, 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.
176
177You can use 'each' with these things:
178
179@
180'each' :: 'Traversal' [a] [b] a b
181
182'each' :: 'Traversal' ('Maybe' a) ('Maybe' b) a b
183'each' :: 'Traversal' ('Either' a a) ('Either' b b) a b  -- since 0.4.11
184
185'each' :: 'Traversal' (a,a) (b,b) a b
186'each' :: 'Traversal' (a,a,a) (b,b,b) a b
187'each' :: 'Traversal' (a,a,a,a) (b,b,b,b) a b
188'each' :: 'Traversal' (a,a,a,a,a) (b,b,b,b,b) a b
189
190'each' :: ('RealFloat' a, 'RealFloat' b) => 'Traversal' ('Complex' a) ('Complex' b) a b
191@
192
193You 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>.
194  -}
195  each :: Traversal s t a b
196
197instance (a~b, q~r) => Each (a,b) (q,r) a q where
198  each f ~(a,b) = (,) <$> f a <*> f b
199  {-# INLINE each #-}
200
201instance (a~b, a~c, q~r, q~s) => Each (a,b,c) (q,r,s) a q where
202  each f ~(a,b,c) = (,,) <$> f a <*> f b <*> f c
203  {-# INLINE each #-}
204
205instance (a~b, a~c, a~d, q~r, q~s, q~t) => Each (a,b,c,d) (q,r,s,t) a q where
206  each f ~(a,b,c,d) = (,,,) <$> f a <*> f b <*> f c <*> f d
207  {-# INLINE each #-}
208
209instance (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
210  each f ~(a,b,c,d,e) = (,,,,) <$> f a <*> f b <*> f c <*> f d <*> f e
211  {-# INLINE each #-}
212
213instance Each (Complex a) (Complex b) a b where
214  each f (a :+ b) = (:+) <$> f a <*> f b
215  {-# INLINE each #-}
216
217instance Each [a] [b] a b where
218  each = traversed
219  {-# INLINE each #-}
220
221instance Each (Maybe a) (Maybe b) a b where
222  each = traverse
223  {-# INLINE each #-}
224
225{- |
226@since 0.4.11
227-}
228instance (a~a', b~b') => Each (Either a a') (Either b b') a b where
229  each f (Left a)   = Left <$> f a
230  each f (Right a ) = Right <$> f a
231  {-# INLINE each #-}
232
233#if __GLASGOW_HASKELL__ >= 800
234instance Each (NonEmpty a) (NonEmpty b) a b where
235  each = traversed
236  {-# INLINE each #-}
237#endif
238
239-- NOTE: when adding new instances of 'Each', update the docs for 'each'.
240
241type family Index (s :: *) :: *
242
243type family IxValue (m :: *) :: *
244
245type instance Index   (e -> a) = e
246type instance IxValue (e -> a) = a
247type instance Index   [a] = Int
248type instance IxValue [a] = a
249
250#if __GLASGOW_HASKELL__ >= 800
251type instance Index   (NonEmpty a) = Int
252type instance IxValue (NonEmpty a) = a
253#endif
254
255class Ixed m where
256  {- |
257This 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'.)
258
259An example for lists:
260
261>>> [0..5] & ix 3 .~ 10
262[0,1,2,10,4,5]
263
264You can use it for getting, too:
265
266>>> [0..5] ^? ix 3
267Just 3
268
269Of course, the element may not be present (which means that you can use 'ix' as a safe variant of ('!!')):
270
271>>> [0..5] ^? ix 10
272Nothing
273
274Another 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):
275
276@
277maximum0 = 'maximum' 'Lens.Micro.&' 'ix' [] 'Lens.Micro..~' 0
278@
279
280The following instances are provided in this package:
281
282#if __GLASGOW_HASKELL__ >= 800
283@
284'ix' :: 'Int' -> 'Traversal'' [a] a
285
286'ix' :: 'Int' -> 'Traversal'' (NonEmpty a) a
287
288'ix' :: ('Eq' e) => e -> 'Traversal'' (e -> a) a
289@
290#else
291@
292'ix' :: 'Int' -> 'Traversal'' [a] a
293
294'ix' :: ('Eq' e) => e -> 'Traversal'' (e -> a) a
295@
296#endif
297
298You 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>.
299  -}
300  ix :: Index m -> Traversal' m (IxValue m)
301
302class Ixed m => At m where
303  {- |
304This lens lets you read, write, or delete elements in @Map@-like structures. It returns 'Nothing' when the value isn't found, just like @lookup@:
305
306@
307Data.Map.lookup k m = m 'Lens.Micro.^.' at k
308@
309
310However, it also lets you insert and delete values by setting the value to @'Just' value@ or 'Nothing':
311
312@
313Data.Map.insert k a m = m 'Lens.Micro.&' at k 'Lens.Micro..~' Just a
314
315Data.Map.delete k m = m 'Lens.Micro.&' at k 'Lens.Micro..~' Nothing
316@
317
318Or you could use ('Lens.Micro.?~') instead of ('Lens.Micro..~'):
319
320@
321Data.Map.insert k a m = m 'Lens.Micro.&' at k 'Lens.Micro.?~' a
322@
323
324Note 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.
325
326'at' is often used with 'Lens.Micro.non'. See the documentation of 'Lens.Micro.non' for examples.
327
328Note that 'at' isn't strict for @Map@, even if you're using @Data.Map.Strict@:
329
330>>> Data.Map.Strict.size (Data.Map.Strict.empty & at 1 .~ Just undefined)
3311
332
333The 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.
334
335This 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>.
336  -}
337  at :: Index m -> Lens' m (Maybe (IxValue m))
338
339ixAt :: At m => Index m -> Traversal' m (IxValue m)
340ixAt i = at i . traverse
341{-# INLINE ixAt #-}
342
343instance Eq e => Ixed (e -> a) where
344  ix e p f = (\a e' -> if e == e' then a else f e') <$> p (f e)
345  {-# INLINE ix #-}
346
347instance Ixed [a] where
348  ix k f xs0 | k < 0     = pure xs0
349             | otherwise = go xs0 k where
350    go [] _ = pure []
351    go (a:as) 0 = (:as) <$> f a
352    go (a:as) i = (a:) <$> (go as $! i - 1)
353  {-# INLINE ix #-}
354
355#if __GLASGOW_HASKELL__ >= 800
356instance Ixed (NonEmpty a) where
357  ix k f xs0 | k < 0 = pure xs0
358             | otherwise = go xs0 k where
359    go (a:|as) 0 = (:|as) <$> f a
360    go (a:|as) i = (a:|) <$> ix (i - 1) f as
361  {-# INLINE ix #-}
362#endif
363
364class Field1 s t a b | s -> a, t -> b, s b -> t, t a -> s where
365  {- |
366Gives access to the 1st field of a tuple (up to 5-tuples).
367
368Getting the 1st component:
369
370>>> (1,2,3,4,5) ^. _1
3711
372
373Setting the 1st component:
374
375>>> (1,2,3) & _1 .~ 10
376(10,2,3)
377
378Note that this lens is lazy, and can set fields even of 'undefined':
379
380>>> set _1 10 undefined :: (Int, Int)
381(10,*** Exception: Prelude.undefined
382
383This is done to avoid violating a lens law stating that you can get back what you put:
384
385>>> view _1 . set _1 10 $ (undefined :: (Int, Int))
38610
387
388The implementation (for 2-tuples) is:
389
390@
391'_1' f t = (,) '<$>' f    ('fst' t)
392             '<*>' 'pure' ('snd' t)
393@
394
395or, alternatively,
396
397@
398'_1' f ~(a,b) = (\\a' -> (a',b)) '<$>' f a
399@
400
401(where @~@ means a <https://wiki.haskell.org/Lazy_pattern_match lazy pattern>).
402
403'_2', '_3', '_4', and '_5' are also available (see below).
404  -}
405  _1 :: Lens s t a b
406
407instance Field1 (a,b) (a',b) a a' where
408  _1 k ~(a,b) = (\a' -> (a',b)) <$> k a
409  {-# INLINE _1 #-}
410
411instance Field1 (a,b,c) (a',b,c) a a' where
412  _1 k ~(a,b,c) = (\a' -> (a',b,c)) <$> k a
413  {-# INLINE _1 #-}
414
415instance Field1 (a,b,c,d) (a',b,c,d) a a' where
416  _1 k ~(a,b,c,d) = (\a' -> (a',b,c,d)) <$> k a
417  {-# INLINE _1 #-}
418
419instance Field1 (a,b,c,d,e) (a',b,c,d,e) a a' where
420  _1 k ~(a,b,c,d,e) = (\a' -> (a',b,c,d,e)) <$> k a
421  {-# INLINE _1 #-}
422
423{-
424
425instance Field1 (a,b,c,d,e,f) (a',b,c,d,e,f) a a' where
426  _1 k ~(a,b,c,d,e,f) = (\a' -> (a',b,c,d,e,f)) <$> k a
427  {-# INLINE _1 #-}
428
429instance Field1 (a,b,c,d,e,f,g) (a',b,c,d,e,f,g) a a' where
430  _1 k ~(a,b,c,d,e,f,g) = (\a' -> (a',b,c,d,e,f,g)) <$> k a
431  {-# INLINE _1 #-}
432
433instance Field1 (a,b,c,d,e,f,g,h) (a',b,c,d,e,f,g,h) a a' where
434  _1 k ~(a,b,c,d,e,f,g,h) = (\a' -> (a',b,c,d,e,f,g,h)) <$> k a
435  {-# INLINE _1 #-}
436
437instance Field1 (a,b,c,d,e,f,g,h,i) (a',b,c,d,e,f,g,h,i) a a' where
438  _1 k ~(a,b,c,d,e,f,g,h,i) = (\a' -> (a',b,c,d,e,f,g,h,i)) <$> k a
439  {-# INLINE _1 #-}
440
441-}
442
443class Field2 s t a b | s -> a, t -> b, s b -> t, t a -> s where
444  _2 :: Lens s t a b
445
446instance Field2 (a,b) (a,b') b b' where
447  _2 k ~(a,b) = (\b' -> (a,b')) <$> k b
448  {-# INLINE _2 #-}
449
450instance Field2 (a,b,c) (a,b',c) b b' where
451  _2 k ~(a,b,c) = (\b' -> (a,b',c)) <$> k b
452  {-# INLINE _2 #-}
453
454instance Field2 (a,b,c,d) (a,b',c,d) b b' where
455  _2 k ~(a,b,c,d) = (\b' -> (a,b',c,d)) <$> k b
456  {-# INLINE _2 #-}
457
458instance Field2 (a,b,c,d,e) (a,b',c,d,e) b b' where
459  _2 k ~(a,b,c,d,e) = (\b' -> (a,b',c,d,e)) <$> k b
460  {-# INLINE _2 #-}
461
462{-
463
464instance Field2 (a,b,c,d,e,f) (a,b',c,d,e,f) b b' where
465  _2 k ~(a,b,c,d,e,f) = (\b' -> (a,b',c,d,e,f)) <$> k b
466  {-# INLINE _2 #-}
467
468instance Field2 (a,b,c,d,e,f,g) (a,b',c,d,e,f,g) b b' where
469  _2 k ~(a,b,c,d,e,f,g) = (\b' -> (a,b',c,d,e,f,g)) <$> k b
470  {-# INLINE _2 #-}
471
472instance Field2 (a,b,c,d,e,f,g,h) (a,b',c,d,e,f,g,h) b b' where
473  _2 k ~(a,b,c,d,e,f,g,h) = (\b' -> (a,b',c,d,e,f,g,h)) <$> k b
474  {-# INLINE _2 #-}
475
476instance Field2 (a,b,c,d,e,f,g,h,i) (a,b',c,d,e,f,g,h,i) b b' where
477  _2 k ~(a,b,c,d,e,f,g,h,i) = (\b' -> (a,b',c,d,e,f,g,h,i)) <$> k b
478  {-# INLINE _2 #-}
479
480-}
481
482class Field3 s t a b | s -> a, t -> b, s b -> t, t a -> s where
483  _3 :: Lens s t a b
484
485instance Field3 (a,b,c) (a,b,c') c c' where
486  _3 k ~(a,b,c) = (\c' -> (a,b,c')) <$> k c
487  {-# INLINE _3 #-}
488
489instance Field3 (a,b,c,d) (a,b,c',d) c c' where
490  _3 k ~(a,b,c,d) = (\c' -> (a,b,c',d)) <$> k c
491  {-# INLINE _3 #-}
492
493instance Field3 (a,b,c,d,e) (a,b,c',d,e) c c' where
494  _3 k ~(a,b,c,d,e) = (\c' -> (a,b,c',d,e)) <$> k c
495  {-# INLINE _3 #-}
496
497{-
498
499instance Field3 (a,b,c,d,e,f) (a,b,c',d,e,f) c c' where
500  _3 k ~(a,b,c,d,e,f) = (\c' -> (a,b,c',d,e,f)) <$> k c
501  {-# INLINE _3 #-}
502
503instance Field3 (a,b,c,d,e,f,g) (a,b,c',d,e,f,g) c c' where
504  _3 k ~(a,b,c,d,e,f,g) = (\c' -> (a,b,c',d,e,f,g)) <$> k c
505  {-# INLINE _3 #-}
506
507instance Field3 (a,b,c,d,e,f,g,h) (a,b,c',d,e,f,g,h) c c' where
508  _3 k ~(a,b,c,d,e,f,g,h) = (\c' -> (a,b,c',d,e,f,g,h)) <$> k c
509  {-# INLINE _3 #-}
510
511instance Field3 (a,b,c,d,e,f,g,h,i) (a,b,c',d,e,f,g,h,i) c c' where
512  _3 k ~(a,b,c,d,e,f,g,h,i) = (\c' -> (a,b,c',d,e,f,g,h,i)) <$> k c
513  {-# INLINE _3 #-}
514
515-}
516
517class Field4 s t a b | s -> a, t -> b, s b -> t, t a -> s where
518  _4 :: Lens s t a b
519
520instance Field4 (a,b,c,d) (a,b,c,d') d d' where
521  _4 k ~(a,b,c,d) = (\d' -> (a,b,c,d')) <$> k d
522  {-# INLINE _4 #-}
523
524instance Field4 (a,b,c,d,e) (a,b,c,d',e) d d' where
525  _4 k ~(a,b,c,d,e) = (\d' -> (a,b,c,d',e)) <$> k d
526  {-# INLINE _4 #-}
527
528{-
529
530instance Field4 (a,b,c,d,e,f) (a,b,c,d',e,f) d d' where
531  _4 k ~(a,b,c,d,e,f) = (\d' -> (a,b,c,d',e,f)) <$> k d
532  {-# INLINE _4 #-}
533
534instance Field4 (a,b,c,d,e,f,g) (a,b,c,d',e,f,g) d d' where
535  _4 k ~(a,b,c,d,e,f,g) = (\d' -> (a,b,c,d',e,f,g)) <$> k d
536  {-# INLINE _4 #-}
537
538instance Field4 (a,b,c,d,e,f,g,h) (a,b,c,d',e,f,g,h) d d' where
539  _4 k ~(a,b,c,d,e,f,g,h) = (\d' -> (a,b,c,d',e,f,g,h)) <$> k d
540  {-# INLINE _4 #-}
541
542instance Field4 (a,b,c,d,e,f,g,h,i) (a,b,c,d',e,f,g,h,i) d d' where
543  _4 k ~(a,b,c,d,e,f,g,h,i) = (\d' -> (a,b,c,d',e,f,g,h,i)) <$> k d
544  {-# INLINE _4 #-}
545
546-}
547
548class Field5 s t a b | s -> a, t -> b, s b -> t, t a -> s where
549  _5 :: Lens s t a b
550
551instance Field5 (a,b,c,d,e) (a,b,c,d,e') e e' where
552  _5 k ~(a,b,c,d,e) = (\e' -> (a,b,c,d,e')) <$> k e
553  {-# INLINE _5 #-}
554
555{-
556
557instance Field5 (a,b,c,d,e,f) (a,b,c,d,e',f) e e' where
558  _5 k ~(a,b,c,d,e,f) = (\e' -> (a,b,c,d,e',f)) <$> k e
559  {-# INLINE _5 #-}
560
561instance Field5 (a,b,c,d,e,f,g) (a,b,c,d,e',f,g) e e' where
562  _5 k ~(a,b,c,d,e,f,g) = (\e' -> (a,b,c,d,e',f,g)) <$> k e
563  {-# INLINE _5 #-}
564
565instance Field5 (a,b,c,d,e,f,g,h) (a,b,c,d,e',f,g,h) e e' where
566  _5 k ~(a,b,c,d,e,f,g,h) = (\e' -> (a,b,c,d,e',f,g,h)) <$> k e
567  {-# INLINE _5 #-}
568
569instance Field5 (a,b,c,d,e,f,g,h,i) (a,b,c,d,e',f,g,h,i) e e' where
570  _5 k ~(a,b,c,d,e,f,g,h,i) = (\e' -> (a,b,c,d,e',f,g,h,i)) <$> k e
571  {-# INLINE _5 #-}
572
573-}
574
575class Cons s t a b | s -> a, t -> b, s b -> t, t a -> s where
576  _Cons :: Traversal s t (a,s) (b,t)
577
578instance Cons [a] [b] a b where
579  _Cons f (a:as) = uncurry (:) <$> f (a, as)
580  _Cons _ []     = pure []
581  {-# INLINE _Cons #-}
582
583class Snoc s t a b | s -> a, t -> b, s b -> t, t a -> s where
584  _Snoc :: Traversal s t (s,a) (t,b)
585
586instance Snoc [a] [b] a b where
587  _Snoc _ [] = pure []
588  _Snoc f xs = (\(as,a) -> as ++ [a]) <$> f (init xs, last xs)
589  {-# INLINE _Snoc #-}
590
591class Strict lazy strict | lazy -> strict, strict -> lazy where
592  {- |
593'strict' lets you convert between strict and lazy versions of a datatype:
594
595>>> let someText = "hello" :: Lazy.Text
596>>> someText ^. strict
597"hello" :: Strict.Text
598
599It can also be useful if you have a function that works on a strict type but your type is lazy:
600
601@
602stripDiacritics :: Strict.Text -> Strict.Text
603stripDiacritics = ...
604@
605
606>>> let someText = "Paul Erdős" :: Lazy.Text
607>>> someText & strict %~ stripDiacritics
608"Paul Erdos" :: Lazy.Text
609
610'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>.
611  -}
612  strict :: Lens' lazy strict
613
614  {- |
615'lazy' is like 'strict' but works in opposite direction:
616
617>>> let someText = "hello" :: Strict.Text
618>>> someText ^. lazy
619"hello" :: Lazy.Text
620  -}
621  lazy   :: Lens' strict lazy
622
623----------------------------------------------------------------------------
624-- Coerce compatibility shim
625----------------------------------------------------------------------------
626
627#if __GLASGOW_HASKELL__ < 708
628coerce :: a -> b
629coerce = unsafeCoerce
630{-# INLINE coerce #-}
631#endif
632
633----------------------------------------------------------------------------
634-- Coerce-like composition
635----------------------------------------------------------------------------
636
637-- Note: 'lens' defines a type-restricted version of (#.) to work around a
638-- bug, but our version is restricted enough that we don't need it. See
639-- <https://github.com/ekmett/lens/commit/cde2fc39c0dba413d1a6f814b47bd14431a5e339>
640
641#if __GLASGOW_HASKELL__ >= 708
642( #. ) :: Coercible c b => (b -> c) -> (a -> b) -> (a -> c)
643( #. ) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b
644
645( .# ) :: Coercible b a => (b -> c) -> (a -> b) -> (a -> c)
646( .# ) pbc _ = coerce pbc
647#else
648( #. ) :: (b -> c) -> (a -> b) -> (a -> c)
649( #. ) _ = unsafeCoerce
650
651( .# ) :: (b -> c) -> (a -> b) -> (a -> c)
652( .# ) pbc _ = unsafeCoerce pbc
653#endif
654
655{-# INLINE ( #. ) #-}
656{-# INLINE ( .# ) #-}
657
658infixr 9 #.
659infixl 8 .#
660