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