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