microlens 0.4.12.0 → 0.5.0.0
raw patch · 5 files changed
Files
- CHANGELOG.md +17/−0
- microlens.cabal +21/−15
- src/Lens/Micro.hs +378/−2
- src/Lens/Micro/FieldN.hs +248/−0
- src/Lens/Micro/Internal.hs +6/−217
CHANGELOG.md view
@@ -1,3 +1,20 @@+# 0.5.0.0++* Move definitions for Field<N> e.g. `Field1` from `Lens.Micro.Interal` to `Lens.Micro`. This is a breaking change for users of these classes and instances. To upgrade, update your imports, e.g. `import Lens.Micro.Internal (Field1(..))` -> `import Lens.Micro (Field1(..))`.++# 0.4.14.0++* Add optics `mapMOf`, `rewriteMOf`, `transformMOf`, `anyOf`, `allOf`, `noneOf`, `foldMapOf`, and `cosmosOf`.++# 0.4.13.1++* [#161](https://github.com/stevenfontanella/microlens/pull/161) Fix GHC 9.4 warning for using `~` without TypeOperators+* [#162](https://github.com/stevenfontanella/microlens/pull/162) Fix GHC warning for depending on StarIsType++# 0.4.13.0++* Added `_Show`, `worded`, and `lined`.+ # 0.4.12.0 * Added instance `Ixed (NonEmpty a)` for GHC >= 8.
microlens.cabal view
@@ -1,12 +1,12 @@ name: microlens-version: 0.4.12.0+version: 0.5.0.0 synopsis: A tiny lens library with no dependencies description: NOTE: If you're writing an app, you probably want <http://hackage.haskell.org/package/microlens-platform microlens-platform> – it has the most features. <http://hackage.haskell.org/package/microlens microlens> is intended more for library writers who want a tiny lens library (after all, lenses are pretty useful for everything, not just for updating records!). . This library is an extract from <http://hackage.haskell.org/package/lens lens> (with no dependencies). It's not a toy lenses library, unsuitable for “real world”, but merely a small one. It is compatible with lens, and should have same performance. It also has better documentation. .- There's a longer readme <https://github.com/monadfix/microlens#readme on Github>. It has a migration guide for lens users, a description of other packages in the family, a discussion of other lens libraries you could use instead, and so on.+ There's a longer readme <https://github.com/stevenfontanella/microlens#readme on Github>. It has a migration guide for lens users, a description of other packages in the family, a discussion of other lens libraries you could use instead, and so on. . Here are some usecases for this library: .@@ -32,35 +32,40 @@ license: BSD3 license-file: LICENSE author: Edward Kmett, Artyom Kazak-maintainer: Monadfix <hi@monadfix.com>-homepage: http://github.com/monadfix/microlens-bug-reports: http://github.com/monadfix/microlens/issues+maintainer: Steven Fontanella <steven.fontanella@gmail.com>+homepage: http://github.com/stevenfontanella/microlens+bug-reports: http://github.com/stevenfontanella/microlens/issues -- copyright: category: Data, Lenses build-type: Simple extra-source-files: CHANGELOG.md cabal-version: >=1.10-tested-with: GHC==7.4.2- GHC==7.6.3- GHC==7.8.4- GHC==7.10.3- GHC==8.0.2- GHC==8.2.2- GHC==8.4.4+tested-with:+ GHC==9.12.1+ GHC==9.10.1+ GHC==9.8.4+ GHC==9.6.6+ GHC==9.4.8+ GHC==9.2.8+ GHC==9.0.2+ GHC==8.10.7+ GHC==8.8.4 GHC==8.6.5- GHC==8.8.1- GHC==8.10.1+ GHC==8.4.4+ GHC==8.2.2+ GHC==8.0.2 source-repository head type: git- location: git://github.com/monadfix/microlens.git+ location: https://github.com/stevenfontanella/microlens.git library exposed-modules: Lens.Micro Lens.Micro.Extras Lens.Micro.Internal Lens.Micro.Type+ Lens.Micro.FieldN -- other-modules: -- other-extensions: @@ -79,3 +84,4 @@ hs-source-dirs: src default-language: Haskell2010+ default-extensions: TypeOperators
src/Lens/Micro.hs view
@@ -21,6 +21,7 @@ * <http://hackage.haskell.org/package/microlens-ghc microlens-ghc> – everything in microlens + instances to make @each@\/@at@\/@ix@ usable with arrays, @ByteString@, and containers * <http://hackage.haskell.org/package/microlens-platform microlens-platform> – microlens-ghc + microlens-mtl + microlens-th + instances for @Text@, @Vector@, and @HashMap@ * <http://hackage.haskell.org/package/microlens-contra microlens-contra> – @Fold@ and @Getter@ that are exact copies of types in lens+* <http://hackage.haskell.org/package/microlens-pro microlens-pro> – microlens-platform + @Iso@ and @Prism@ Unofficial: @@ -45,8 +46,11 @@ (?~), (<%~), (<<%~), (<<.~), mapped,+ mapMOf, rewriteOf,+ rewriteMOf, transformOf,+ transformMOf, -- * Getter: extracts a value from a structure -- $getters-note@@ -66,13 +70,18 @@ has, folded, folding,+ foldMapOf,+ anyOf,+ allOf,+ noneOf, -- * Lens: a combined getter-and-setter -- $lenses-note Lens, Lens', lens, at,- _1, _2, _3, _4, _5,+ -- _1, _2, _3, _4, _5,+ module Lens.Micro.FieldN, -- * Iso: a lens that only changes the representation -- $isos-note@@ -93,24 +102,28 @@ ix, _head, _tail, _init, _last, mapAccumLOf,+ worded, lined,+ cosmosOf, -- * Prism: a traversal iterating over at most 1 element -- $prisms-note _Left, _Right, _Just, _Nothing,+ _Show, -- * Other types LensLike, LensLike', ) where -+import Lens.Micro.FieldN import Lens.Micro.Type import Lens.Micro.Internal import Control.Applicative import Control.Monad import Data.Functor.Identity+import Data.List (intercalate) import Data.Monoid import Data.Maybe import Data.Tuple@@ -118,6 +131,8 @@ #if MIN_VERSION_base(4,8,0) import Data.Function ((&))+#else+import Data.Traversable (traverse) #endif #if MIN_VERSION_base(4,11,0)@@ -454,6 +469,16 @@ {-# INLINE mapped #-} {- |+Map each element of a structure targeted by a Lens to a monadic action, evaluate these actions from left to right, and collect the results.++>>> mapMOf both (\x -> [x, x + 1]) (1,3)+[(1,3),(1,4),(2,3),(2,4)]+-}+mapMOf :: LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t+mapMOf = coerce+{-# INLINE mapMOf #-}++{- | This is a version of ('%~') which modifies the structure and returns it along with the new value: >>> (1, 2) & _1 <%~ negate@@ -527,6 +552,17 @@ {-# INLINE rewriteOf #-} {- |+Rewrite by applying a monadic rule everywhere you can. Ensures that the rule cannot be applied anywhere in the result.+-}+rewriteMOf+ :: Monad m+ => LensLike (WrappedMonad m) a b a b -> (b -> m (Maybe a)) -> a -> m b+rewriteMOf l f = go+ where+ go = transformMOf l (\x -> f x >>= maybe (return x) go)+{-# INLINE rewriteMOf #-}++{- | Transform every element by recursively applying a given 'ASetter' in a bottom-up manner. @since 0.4.11@@ -536,6 +572,16 @@ go = f . over l go {-# INLINE transformOf #-} +{- |+Transform every element by recursively applying a given 'ASetter' in a bottom-up manner with a monadic effect.+-}+transformMOf+ :: Monad m => LensLike (WrappedMonad m) a b a b -> (b -> m b) -> a -> m b+transformMOf l f = go+ where+ go t = mapMOf l go t >>= f+{-# INLINE transformMOf #-}+ -- Getting ----------------------------------------------------------------- {- $getters-note@@ -771,6 +817,51 @@ folding sfa agb = phantom . F.traverse_ agb . sfa {-# INLINE folding #-} +{- |+Returns 'True' if any value returned by a getter (any getter, including lenses,+traversals, and folds) satisfies a predicate.++>>> anyOf each (=='x') ['x','x']+True+>>> anyOf each (=='x') ['x','y']+True+>>> anyOf each (=='x') ['y','y']+False+-}+anyOf :: Getting Any s a -> (a -> Bool) -> s -> Bool+anyOf l f = getAny #. foldMapOf l (Any #. f)+{-# INLINE anyOf #-}++{- |+Returns 'True' if any value returned by a getter (any getter, including lenses,+traversals, and folds) satisfies a predicate.++>>> allOf each (=='x') ['x','x']+True+>>> allOf each (=='x') ['x','y']+False+>>> allOf each (=='x') ['y','y']+False+-}+allOf :: Getting All s a -> (a -> Bool) -> s -> Bool+allOf l f = getAll #. foldMapOf l (All #. f)+{-# INLINE allOf #-}++{- |+Returns 'True' if no value returned by a getter (any getter, including lenses,+traversals, and folds) satisfies a predicate.++>>> noneOf each (=='x') ['x','x']+False+>>> noneOf each (=='x') ['x','y']+False+>>> noneOf each (=='x') ['y','y']+True+-}+noneOf :: Getting Any s a -> (a -> Bool) -> s -> Bool+noneOf l f = not . anyOf l f+{-# INLINE noneOf #-}+ -- Lenses ------------------------------------------------------------------ {- $lenses-note@@ -905,6 +996,8 @@ @ However, it's not possible for microlens to export isomorphisms, because their type depends on @<http://hackage.haskell.org/package/profunctors/docs/Data-Profunctor.html#t:Profunctor Profunctor>@, which resides in the <http://hackage.haskell.org/package/profunctors profunctors> library, which is a somewhat huge dependency. So, all isomorphisms included here are lenses instead (and thus you can't use them in the opposite direction).++Should you find yourself in need of true lens-compatible isos, consider <https://hackage.haskell.org/package/microlens-pro microlens-pro>, or just lens :^). -} {- |@@ -1260,6 +1353,44 @@ g a = state $ \acc -> swap (f acc a) {-# INLINE mapAccumLOf #-} +{- |+Focus on the 'words' of a string.++>>> "avoid success at all costs" & worded . _head %~ toUpper+"Avoid Success At All Costs"++This violates the traversal laws when whitespace is set or when the source has+space at the ends or more than one contiguous space anywhere.+-}+worded :: Traversal' String String+worded f = fmap unwords . traverse f . words+{-# INLINE worded #-}++{- |+Focus on the 'lines' of a string.++@+countAndMarkEmptyLines :: String -> State Int String+countAndMarkEmptyLines s = runState (f s) 0 where+ f = 'traverseOf' (lined . 'filtered' null) $ \\_ -> do+ modify' (+ 1)+ return "# Empty line"+@++This violates the traversal laws when newlines are set or when the source has+more than one contiguous newline anywhere.+-}+lined :: Traversal' String String+lined f = fmap (intercalate "\n") . traverse f . lines+{-# INLINE lined #-}++{- |+Given a Traversal that knows how to locate immediate children, traverse all of the transitive descendants of a node, including itself.+-}+cosmosOf :: Traversal a t a t -> Traversal a t a b'+cosmosOf d f s = f s *> d (cosmosOf d f) s+{-# INLINE cosmosOf #-}+ -- Prisms ------------------------------------------------------------------ {- $prisms-note@@ -1275,6 +1406,8 @@ @ However, it's not possible for microlens to export prisms, because their type depends on @<http://hackage.haskell.org/package/profunctors/docs/Data-Profunctor.html#t:Choice Choice>@ from <http://hackage.haskell.org/package/profunctors profunctors>. So, all prisms included here are traversals instead (and you can't reverse them).++Should you find yourself in need of true lens-compatible prisms, consider <https://hackage.haskell.org/package/microlens-pro microlens-pro>, or just lens :^). -} {- |@@ -1382,6 +1515,37 @@ _Nothing _ j = pure j {-# INLINE _Nothing #-} +{- |+'_Show' targets the Haskell value in a @String@ using 'Read', or nothing if parsing fails. Likewise, setting a Haskell value through this prism renders a @String@ using 'Show'.++>>> ["abc","8","def","9"] & mapped . _Show %~ \x -> x + 1 :: Int+["abc","9","def","10"]++Note that this prism is improper for types that don\'t satisfy @read . show = id@:++>>> "25.9999999" & _Show %~ \x -> x :: Float+"26.0"++These functions from @base@ can be expressed in terms of '_Show':++ * Unsafely parsing a value from a 'String':++ @+ 'read' = ('^?!' '_Show')+ @++ * Safely parsing a value from a 'String':++ @+ 'Text.Read.readMaybe' = ('^?' '_Show')+ @+-}+_Show :: (Show a, Read a) => Traversal' String a+_Show f s = case reads s of+ [(a,"")] -> show <$> f a+ _ -> pure s+{-# INLINE _Show #-}+ -- Some of the guts of lens newtype Traversed a f = Traversed { getTraversed :: f a }@@ -1460,3 +1624,215 @@ instance (Fail.MonadFail m) => Fail.MonadFail (StateT s m) where fail str = StateT $ \ _ -> Fail.fail str #endif+++-- class Field1 s t a b | s -> a, t -> b, s b -> t, t a -> s where+-- {- |+-- Gives access to the 1st field of a tuple (up to 5-tuples).++-- Getting the 1st component:++-- >>> (1,2,3,4,5) ^. _1+-- 1++-- Setting the 1st component:++-- >>> (1,2,3) & _1 .~ 10+-- (10,2,3)++-- Note that this lens is lazy, and can set fields even of 'undefined':++-- >>> set _1 10 undefined :: (Int, Int)+-- (10,*** Exception: Prelude.undefined++-- This is done to avoid violating a lens law stating that you can get back what you put:++-- >>> view _1 . set _1 10 $ (undefined :: (Int, Int))+-- 10++-- The implementation (for 2-tuples) is:++-- @+-- '_1' f t = (,) '<$>' f ('fst' t)+-- '<*>' 'pure' ('snd' t)+-- @++-- or, alternatively,++-- @+-- '_1' f ~(a,b) = (\\a' -> (a',b)) '<$>' f a+-- @++-- (where @~@ means a <https://wiki.haskell.org/Lazy_pattern_match lazy pattern>).++-- '_2', '_3', '_4', and '_5' are also available (see below).+-- -}+-- _1 :: Lens s t a b++-- instance Field1 (a,b) (a',b) a a' where+-- _1 k ~(a,b) = (\a' -> (a',b)) <$> k a+-- {-# INLINE _1 #-}++-- instance Field1 (a,b,c) (a',b,c) a a' where+-- _1 k ~(a,b,c) = (\a' -> (a',b,c)) <$> k a+-- {-# INLINE _1 #-}++-- instance Field1 (a,b,c,d) (a',b,c,d) a a' where+-- _1 k ~(a,b,c,d) = (\a' -> (a',b,c,d)) <$> k a+-- {-# INLINE _1 #-}++-- instance Field1 (a,b,c,d,e) (a',b,c,d,e) a a' where+-- _1 k ~(a,b,c,d,e) = (\a' -> (a',b,c,d,e)) <$> k a+-- {-# INLINE _1 #-}++-- {-++-- instance Field1 (a,b,c,d,e,f) (a',b,c,d,e,f) a a' where+-- _1 k ~(a,b,c,d,e,f) = (\a' -> (a',b,c,d,e,f)) <$> k a+-- {-# INLINE _1 #-}++-- instance Field1 (a,b,c,d,e,f,g) (a',b,c,d,e,f,g) a a' where+-- _1 k ~(a,b,c,d,e,f,g) = (\a' -> (a',b,c,d,e,f,g)) <$> k a+-- {-# INLINE _1 #-}++-- instance Field1 (a,b,c,d,e,f,g,h) (a',b,c,d,e,f,g,h) a a' where+-- _1 k ~(a,b,c,d,e,f,g,h) = (\a' -> (a',b,c,d,e,f,g,h)) <$> k a+-- {-# INLINE _1 #-}++-- instance Field1 (a,b,c,d,e,f,g,h,i) (a',b,c,d,e,f,g,h,i) a a' where+-- _1 k ~(a,b,c,d,e,f,g,h,i) = (\a' -> (a',b,c,d,e,f,g,h,i)) <$> k a+-- {-# INLINE _1 #-}++-- -}++-- class Field2 s t a b | s -> a, t -> b, s b -> t, t a -> s where+-- _2 :: Lens s t a b++-- instance Field2 (a,b) (a,b') b b' where+-- _2 k ~(a,b) = (\b' -> (a,b')) <$> k b+-- {-# INLINE _2 #-}++-- instance Field2 (a,b,c) (a,b',c) b b' where+-- _2 k ~(a,b,c) = (\b' -> (a,b',c)) <$> k b+-- {-# INLINE _2 #-}++-- instance Field2 (a,b,c,d) (a,b',c,d) b b' where+-- _2 k ~(a,b,c,d) = (\b' -> (a,b',c,d)) <$> k b+-- {-# INLINE _2 #-}++-- instance Field2 (a,b,c,d,e) (a,b',c,d,e) b b' where+-- _2 k ~(a,b,c,d,e) = (\b' -> (a,b',c,d,e)) <$> k b+-- {-# INLINE _2 #-}++-- {-++-- instance Field2 (a,b,c,d,e,f) (a,b',c,d,e,f) b b' where+-- _2 k ~(a,b,c,d,e,f) = (\b' -> (a,b',c,d,e,f)) <$> k b+-- {-# INLINE _2 #-}++-- instance Field2 (a,b,c,d,e,f,g) (a,b',c,d,e,f,g) b b' where+-- _2 k ~(a,b,c,d,e,f,g) = (\b' -> (a,b',c,d,e,f,g)) <$> k b+-- {-# INLINE _2 #-}++-- instance Field2 (a,b,c,d,e,f,g,h) (a,b',c,d,e,f,g,h) b b' where+-- _2 k ~(a,b,c,d,e,f,g,h) = (\b' -> (a,b',c,d,e,f,g,h)) <$> k b+-- {-# INLINE _2 #-}++-- instance Field2 (a,b,c,d,e,f,g,h,i) (a,b',c,d,e,f,g,h,i) b b' where+-- _2 k ~(a,b,c,d,e,f,g,h,i) = (\b' -> (a,b',c,d,e,f,g,h,i)) <$> k b+-- {-# INLINE _2 #-}++-- -}++-- class Field3 s t a b | s -> a, t -> b, s b -> t, t a -> s where+-- _3 :: Lens s t a b++-- instance Field3 (a,b,c) (a,b,c') c c' where+-- _3 k ~(a,b,c) = (\c' -> (a,b,c')) <$> k c+-- {-# INLINE _3 #-}++-- instance Field3 (a,b,c,d) (a,b,c',d) c c' where+-- _3 k ~(a,b,c,d) = (\c' -> (a,b,c',d)) <$> k c+-- {-# INLINE _3 #-}++-- instance Field3 (a,b,c,d,e) (a,b,c',d,e) c c' where+-- _3 k ~(a,b,c,d,e) = (\c' -> (a,b,c',d,e)) <$> k c+-- {-# INLINE _3 #-}++-- {-++-- instance Field3 (a,b,c,d,e,f) (a,b,c',d,e,f) c c' where+-- _3 k ~(a,b,c,d,e,f) = (\c' -> (a,b,c',d,e,f)) <$> k c+-- {-# INLINE _3 #-}++-- instance Field3 (a,b,c,d,e,f,g) (a,b,c',d,e,f,g) c c' where+-- _3 k ~(a,b,c,d,e,f,g) = (\c' -> (a,b,c',d,e,f,g)) <$> k c+-- {-# INLINE _3 #-}++-- instance Field3 (a,b,c,d,e,f,g,h) (a,b,c',d,e,f,g,h) c c' where+-- _3 k ~(a,b,c,d,e,f,g,h) = (\c' -> (a,b,c',d,e,f,g,h)) <$> k c+-- {-# INLINE _3 #-}++-- instance Field3 (a,b,c,d,e,f,g,h,i) (a,b,c',d,e,f,g,h,i) c c' where+-- _3 k ~(a,b,c,d,e,f,g,h,i) = (\c' -> (a,b,c',d,e,f,g,h,i)) <$> k c+-- {-# INLINE _3 #-}++-- -}++-- class Field4 s t a b | s -> a, t -> b, s b -> t, t a -> s where+-- _4 :: Lens s t a b++-- instance Field4 (a,b,c,d) (a,b,c,d') d d' where+-- _4 k ~(a,b,c,d) = (\d' -> (a,b,c,d')) <$> k d+-- {-# INLINE _4 #-}++-- instance Field4 (a,b,c,d,e) (a,b,c,d',e) d d' where+-- _4 k ~(a,b,c,d,e) = (\d' -> (a,b,c,d',e)) <$> k d+-- {-# INLINE _4 #-}++-- {-++-- instance Field4 (a,b,c,d,e,f) (a,b,c,d',e,f) d d' where+-- _4 k ~(a,b,c,d,e,f) = (\d' -> (a,b,c,d',e,f)) <$> k d+-- {-# INLINE _4 #-}++-- instance Field4 (a,b,c,d,e,f,g) (a,b,c,d',e,f,g) d d' where+-- _4 k ~(a,b,c,d,e,f,g) = (\d' -> (a,b,c,d',e,f,g)) <$> k d+-- {-# INLINE _4 #-}++-- instance Field4 (a,b,c,d,e,f,g,h) (a,b,c,d',e,f,g,h) d d' where+-- _4 k ~(a,b,c,d,e,f,g,h) = (\d' -> (a,b,c,d',e,f,g,h)) <$> k d+-- {-# INLINE _4 #-}++-- instance Field4 (a,b,c,d,e,f,g,h,i) (a,b,c,d',e,f,g,h,i) d d' where+-- _4 k ~(a,b,c,d,e,f,g,h,i) = (\d' -> (a,b,c,d',e,f,g,h,i)) <$> k d+-- {-# INLINE _4 #-}++-- -}++-- class Field5 s t a b | s -> a, t -> b, s b -> t, t a -> s where+-- _5 :: Lens s t a b++-- instance Field5 (a,b,c,d,e) (a,b,c,d,e') e e' where+-- _5 k ~(a,b,c,d,e) = (\e' -> (a,b,c,d,e')) <$> k e+-- {-# INLINE _5 #-}++-- {-++-- instance Field5 (a,b,c,d,e,f) (a,b,c,d,e',f) e e' where+-- _5 k ~(a,b,c,d,e,f) = (\e' -> (a,b,c,d,e',f)) <$> k e+-- {-# INLINE _5 #-}++-- instance Field5 (a,b,c,d,e,f,g) (a,b,c,d,e',f,g) e e' where+-- _5 k ~(a,b,c,d,e,f,g) = (\e' -> (a,b,c,d,e',f,g)) <$> k e+-- {-# INLINE _5 #-}++-- instance Field5 (a,b,c,d,e,f,g,h) (a,b,c,d,e',f,g,h) e e' where+-- _5 k ~(a,b,c,d,e,f,g,h) = (\e' -> (a,b,c,d,e',f,g,h)) <$> k e+-- {-# INLINE _5 #-}++-- instance Field5 (a,b,c,d,e,f,g,h,i) (a,b,c,d,e',f,g,h,i) e e' where+-- _5 k ~(a,b,c,d,e,f,g,h,i) = (\e' -> (a,b,c,d,e',f,g,h,i)) <$> k e+-- {-# INLINE _5 #-}++-- -}
+ src/Lens/Micro/FieldN.hs view
@@ -0,0 +1,248 @@+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}++module Lens.Micro.FieldN where++import Lens.Micro.Type++class Field1 s t a b | s -> a, t -> b, s b -> t, t a -> s where+ {- |+Gives access to the 1st field of a tuple (up to 5-tuples).++Getting the 1st component:++>>> (1,2,3,4,5) ^. _1+1++Setting the 1st component:++>>> (1,2,3) & _1 .~ 10+(10,2,3)++Note that this lens is lazy, and can set fields even of 'undefined':++>>> set _1 10 undefined :: (Int, Int)+(10,*** Exception: Prelude.undefined++This is done to avoid violating a lens law stating that you can get back what you put:++>>> view _1 . set _1 10 $ (undefined :: (Int, Int))+10++The implementation (for 2-tuples) is:++@+'_1' f t = (,) '<$>' f ('fst' t)+ '<*>' 'pure' ('snd' t)+@++or, alternatively,++@+'_1' f ~(a,b) = (\\a' -> (a',b)) '<$>' f a+@++(where @~@ means a <https://wiki.haskell.org/Lazy_pattern_match lazy pattern>).++'_2', '_3', '_4', and '_5' are also available (see below).+ -}+ _1 :: Lens s t a b++instance Field1 (a,b) (a',b) a a' where+ _1 k ~(a,b) = (\a' -> (a',b)) <$> k a+ {-# INLINE _1 #-}++instance Field1 (a,b,c) (a',b,c) a a' where+ _1 k ~(a,b,c) = (\a' -> (a',b,c)) <$> k a+ {-# INLINE _1 #-}++instance Field1 (a,b,c,d) (a',b,c,d) a a' where+ _1 k ~(a,b,c,d) = (\a' -> (a',b,c,d)) <$> k a+ {-# INLINE _1 #-}++instance Field1 (a,b,c,d,e) (a',b,c,d,e) a a' where+ _1 k ~(a,b,c,d,e) = (\a' -> (a',b,c,d,e)) <$> k a+ {-# INLINE _1 #-}++instance Field1 (a,b,c,d,e,f) (a',b,c,d,e,f) a a' where+ _1 k ~(a,b,c,d,e,f) = (\a' -> (a',b,c,d,e,f)) <$> k a+ {-# INLINE _1 #-}++instance Field1 (a,b,c,d,e,f,g) (a',b,c,d,e,f,g) a a' where+ _1 k ~(a,b,c,d,e,f,g) = (\a' -> (a',b,c,d,e,f,g)) <$> k a+ {-# INLINE _1 #-}++instance Field1 (a,b,c,d,e,f,g,h) (a',b,c,d,e,f,g,h) a a' where+ _1 k ~(a,b,c,d,e,f,g,h) = (\a' -> (a',b,c,d,e,f,g,h)) <$> k a+ {-# INLINE _1 #-}++instance Field1 (a,b,c,d,e,f,g,h,i) (a',b,c,d,e,f,g,h,i) a a' where+ _1 k ~(a,b,c,d,e,f,g,h,i) = (\a' -> (a',b,c,d,e,f,g,h,i)) <$> k a+ {-# INLINE _1 #-}++class Field2 s t a b | s -> a, t -> b, s b -> t, t a -> s where+ _2 :: Lens s t a b++instance Field2 (a,b) (a,b') b b' where+ _2 k ~(a,b) = (\b' -> (a,b')) <$> k b+ {-# INLINE _2 #-}++instance Field2 (a,b,c) (a,b',c) b b' where+ _2 k ~(a,b,c) = (\b' -> (a,b',c)) <$> k b+ {-# INLINE _2 #-}++instance Field2 (a,b,c,d) (a,b',c,d) b b' where+ _2 k ~(a,b,c,d) = (\b' -> (a,b',c,d)) <$> k b+ {-# INLINE _2 #-}++instance Field2 (a,b,c,d,e) (a,b',c,d,e) b b' where+ _2 k ~(a,b,c,d,e) = (\b' -> (a,b',c,d,e)) <$> k b+ {-# INLINE _2 #-}++instance Field2 (a,b,c,d,e,f) (a,b',c,d,e,f) b b' where+ _2 k ~(a,b,c,d,e,f) = (\b' -> (a,b',c,d,e,f)) <$> k b+ {-# INLINE _2 #-}++instance Field2 (a,b,c,d,e,f,g) (a,b',c,d,e,f,g) b b' where+ _2 k ~(a,b,c,d,e,f,g) = (\b' -> (a,b',c,d,e,f,g)) <$> k b+ {-# INLINE _2 #-}++instance Field2 (a,b,c,d,e,f,g,h) (a,b',c,d,e,f,g,h) b b' where+ _2 k ~(a,b,c,d,e,f,g,h) = (\b' -> (a,b',c,d,e,f,g,h)) <$> k b+ {-# INLINE _2 #-}++instance Field2 (a,b,c,d,e,f,g,h,i) (a,b',c,d,e,f,g,h,i) b b' where+ _2 k ~(a,b,c,d,e,f,g,h,i) = (\b' -> (a,b',c,d,e,f,g,h,i)) <$> k b+ {-# INLINE _2 #-}++class Field3 s t a b | s -> a, t -> b, s b -> t, t a -> s where+ _3 :: Lens s t a b++instance Field3 (a,b,c) (a,b,c') c c' where+ _3 k ~(a,b,c) = (\c' -> (a,b,c')) <$> k c+ {-# INLINE _3 #-}++instance Field3 (a,b,c,d) (a,b,c',d) c c' where+ _3 k ~(a,b,c,d) = (\c' -> (a,b,c',d)) <$> k c+ {-# INLINE _3 #-}++instance Field3 (a,b,c,d,e) (a,b,c',d,e) c c' where+ _3 k ~(a,b,c,d,e) = (\c' -> (a,b,c',d,e)) <$> k c+ {-# INLINE _3 #-}++instance Field3 (a,b,c,d,e,f) (a,b,c',d,e,f) c c' where+ _3 k ~(a,b,c,d,e,f) = (\c' -> (a,b,c',d,e,f)) <$> k c+ {-# INLINE _3 #-}++instance Field3 (a,b,c,d,e,f,g) (a,b,c',d,e,f,g) c c' where+ _3 k ~(a,b,c,d,e,f,g) = (\c' -> (a,b,c',d,e,f,g)) <$> k c+ {-# INLINE _3 #-}++instance Field3 (a,b,c,d,e,f,g,h) (a,b,c',d,e,f,g,h) c c' where+ _3 k ~(a,b,c,d,e,f,g,h) = (\c' -> (a,b,c',d,e,f,g,h)) <$> k c+ {-# INLINE _3 #-}++instance Field3 (a,b,c,d,e,f,g,h,i) (a,b,c',d,e,f,g,h,i) c c' where+ _3 k ~(a,b,c,d,e,f,g,h,i) = (\c' -> (a,b,c',d,e,f,g,h,i)) <$> k c+ {-# INLINE _3 #-}++class Field4 s t a b | s -> a, t -> b, s b -> t, t a -> s where+ _4 :: Lens s t a b++instance Field4 (a,b,c,d) (a,b,c,d') d d' where+ _4 k ~(a,b,c,d) = (\d' -> (a,b,c,d')) <$> k d+ {-# INLINE _4 #-}++instance Field4 (a,b,c,d,e) (a,b,c,d',e) d d' where+ _4 k ~(a,b,c,d,e) = (\d' -> (a,b,c,d',e)) <$> k d+ {-# INLINE _4 #-}++instance Field4 (a,b,c,d,e,f) (a,b,c,d',e,f) d d' where+ _4 k ~(a,b,c,d,e,f) = (\d' -> (a,b,c,d',e,f)) <$> k d+ {-# INLINE _4 #-}++instance Field4 (a,b,c,d,e,f,g) (a,b,c,d',e,f,g) d d' where+ _4 k ~(a,b,c,d,e,f,g) = (\d' -> (a,b,c,d',e,f,g)) <$> k d+ {-# INLINE _4 #-}++instance Field4 (a,b,c,d,e,f,g,h) (a,b,c,d',e,f,g,h) d d' where+ _4 k ~(a,b,c,d,e,f,g,h) = (\d' -> (a,b,c,d',e,f,g,h)) <$> k d+ {-# INLINE _4 #-}++instance Field4 (a,b,c,d,e,f,g,h,i) (a,b,c,d',e,f,g,h,i) d d' where+ _4 k ~(a,b,c,d,e,f,g,h,i) = (\d' -> (a,b,c,d',e,f,g,h,i)) <$> k d+ {-# INLINE _4 #-}++class Field5 s t a b | s -> a, t -> b, s b -> t, t a -> s where+ _5 :: Lens s t a b++instance Field5 (a,b,c,d,e) (a,b,c,d,e') e e' where+ _5 k ~(a,b,c,d,e) = (\e' -> (a,b,c,d,e')) <$> k e+ {-# INLINE _5 #-}++instance Field5 (a,b,c,d,e,f) (a,b,c,d,e',f) e e' where+ _5 k ~(a,b,c,d,e,f) = (\e' -> (a,b,c,d,e',f)) <$> k e+ {-# INLINE _5 #-}++instance Field5 (a,b,c,d,e,f,g) (a,b,c,d,e',f,g) e e' where+ _5 k ~(a,b,c,d,e,f,g) = (\e' -> (a,b,c,d,e',f,g)) <$> k e+ {-# INLINE _5 #-}++instance Field5 (a,b,c,d,e,f,g,h) (a,b,c,d,e',f,g,h) e e' where+ _5 k ~(a,b,c,d,e,f,g,h) = (\e' -> (a,b,c,d,e',f,g,h)) <$> k e+ {-# INLINE _5 #-}++instance Field5 (a,b,c,d,e,f,g,h,i) (a,b,c,d,e',f,g,h,i) e e' where+ _5 k ~(a,b,c,d,e,f,g,h,i) = (\e' -> (a,b,c,d,e',f,g,h,i)) <$> k e+ {-# INLINE _5 #-}++class Field6 s t a b | s -> a, t -> b, s b -> t, t a -> s where+ _6 :: Lens s t a b++instance Field6 (a,b,c,d,e,f) (a,b,c,d,e,f') f f' where+ _6 k ~(a,b,c,d,e,f) = (\f' -> (a,b,c,d,e,f')) <$> k f+ {-# INLINE _6 #-}++instance Field6 (a,b,c,d,e,f,g) (a,b,c,d,e,f',g) f f' where+ _6 k ~(a,b,c,d,e,f,g) = (\f' -> (a,b,c,d,e,f',g)) <$> k f+ {-# INLINE _6 #-}++instance Field6 (a,b,c,d,e,f,g,h) (a,b,c,d,e,f',g,h) f f' where+ _6 k ~(a,b,c,d,e,f,g,h) = (\f' -> (a,b,c,d,e,f',g,h)) <$> k f+ {-# INLINE _6 #-}++instance Field6 (a,b,c,d,e,f,g,h,i) (a,b,c,d,e,f',g,h,i) f f' where+ _6 k ~(a,b,c,d,e,f,g,h,i) = (\f' -> (a,b,c,d,e,f',g,h,i)) <$> k f+ {-# INLINE _6 #-}++class Field7 s t a b | s -> a, t -> b, s b -> t, t a -> s where+ _7 :: Lens s t a b++instance Field7 (a,b,c,d,e,f,g) (a,b,c,d,e,f,g') g g' where+ _7 k ~(a,b,c,d,e,f,g) = (\g' -> (a,b,c,d,e,f,g')) <$> k g+ {-# INLINE _7 #-}++instance Field7 (a,b,c,d,e,f,g,h) (a,b,c,d,e,f,g',h) g g' where+ _7 k ~(a,b,c,d,e,f,g,h) = (\g' -> (a,b,c,d,e,f,g',h)) <$> k g+ {-# INLINE _7 #-}++instance Field7 (a,b,c,d,e,f,g,h,i) (a,b,c,d,e,f,g',h,i) g g' where+ _7 k ~(a,b,c,d,e,f,g,h,i) = (\g' -> (a,b,c,d,e,f,g',h,i)) <$> k g+ {-# INLINE _7 #-}++class Field8 s t a b | s -> a, t -> b, s b -> t, t a -> s where+ _8 :: Lens s t a b++instance Field8 (a,b,c,d,e,f,g,h) (a,b,c,d,e,f,g,h') h h' where+ _8 k ~(a,b,c,d,e,f,g,h) = (\h' -> (a,b,c,d,e,f,g,h')) <$> k h+ {-# INLINE _8 #-}++instance Field8 (a,b,c,d,e,f,g,h,i) (a,b,c,d,e,f,g,h',i) h h' where+ _8 k ~(a,b,c,d,e,f,g,h,i) = (\h' -> (a,b,c,d,e,f,g,h',i)) <$> k h+ {-# INLINE _8 #-}++class Field9 s t a b | s -> a, t -> b, s b -> t, t a -> s where+ _9 :: Lens s t a b++instance Field9 (a,b,c,d,e,f,g,h,i) (a,b,c,d,e,f,g,h,i') i i' where+ _9 k ~(a,b,c,d,e,f,g,h,i) = (\i' -> (a,b,c,d,e,f,g,h,i')) <$> k i
src/Lens/Micro/Internal.hs view
@@ -43,11 +43,6 @@ Ixed(..), At(..), ixAt,- Field1(..),- Field2(..),- Field3(..),- Field4(..),- Field5(..), Cons(..), Snoc(..), Strict(..),@@ -90,6 +85,7 @@ -- We don't depend on the call-stack package because building an extra -- package is likely slower than adding several lines of code here. #if MIN_VERSION_base(4,9,0)+import Data.Kind (Type) import GHC.Stack (HasCallStack) #elif MIN_VERSION_base(4,8,1) import qualified GHC.Stack as GHC@@ -238,9 +234,13 @@ -- NOTE: when adding new instances of 'Each', update the docs for 'each'. +#if MIN_VERSION_base(4,9,0)+type family Index (s :: Type) :: Type+type family IxValue (m :: Type) :: Type+#else type family Index (s :: *) :: *- type family IxValue (m :: *) :: *+#endif type instance Index (e -> a) = e type instance IxValue (e -> a) = a@@ -360,217 +360,6 @@ go (a:|as) i = (a:|) <$> ix (i - 1) f as {-# INLINE ix #-} #endif--class Field1 s t a b | s -> a, t -> b, s b -> t, t a -> s where- {- |-Gives access to the 1st field of a tuple (up to 5-tuples).--Getting the 1st component:-->>> (1,2,3,4,5) ^. _1-1--Setting the 1st component:-->>> (1,2,3) & _1 .~ 10-(10,2,3)--Note that this lens is lazy, and can set fields even of 'undefined':-->>> set _1 10 undefined :: (Int, Int)-(10,*** Exception: Prelude.undefined--This is done to avoid violating a lens law stating that you can get back what you put:-->>> view _1 . set _1 10 $ (undefined :: (Int, Int))-10--The implementation (for 2-tuples) is:--@-'_1' f t = (,) '<$>' f ('fst' t)- '<*>' 'pure' ('snd' t)-@--or, alternatively,--@-'_1' f ~(a,b) = (\\a' -> (a',b)) '<$>' f a-@--(where @~@ means a <https://wiki.haskell.org/Lazy_pattern_match lazy pattern>).--'_2', '_3', '_4', and '_5' are also available (see below).- -}- _1 :: Lens s t a b--instance Field1 (a,b) (a',b) a a' where- _1 k ~(a,b) = (\a' -> (a',b)) <$> k a- {-# INLINE _1 #-}--instance Field1 (a,b,c) (a',b,c) a a' where- _1 k ~(a,b,c) = (\a' -> (a',b,c)) <$> k a- {-# INLINE _1 #-}--instance Field1 (a,b,c,d) (a',b,c,d) a a' where- _1 k ~(a,b,c,d) = (\a' -> (a',b,c,d)) <$> k a- {-# INLINE _1 #-}--instance Field1 (a,b,c,d,e) (a',b,c,d,e) a a' where- _1 k ~(a,b,c,d,e) = (\a' -> (a',b,c,d,e)) <$> k a- {-# INLINE _1 #-}--{---instance Field1 (a,b,c,d,e,f) (a',b,c,d,e,f) a a' where- _1 k ~(a,b,c,d,e,f) = (\a' -> (a',b,c,d,e,f)) <$> k a- {-# INLINE _1 #-}--instance Field1 (a,b,c,d,e,f,g) (a',b,c,d,e,f,g) a a' where- _1 k ~(a,b,c,d,e,f,g) = (\a' -> (a',b,c,d,e,f,g)) <$> k a- {-# INLINE _1 #-}--instance Field1 (a,b,c,d,e,f,g,h) (a',b,c,d,e,f,g,h) a a' where- _1 k ~(a,b,c,d,e,f,g,h) = (\a' -> (a',b,c,d,e,f,g,h)) <$> k a- {-# INLINE _1 #-}--instance Field1 (a,b,c,d,e,f,g,h,i) (a',b,c,d,e,f,g,h,i) a a' where- _1 k ~(a,b,c,d,e,f,g,h,i) = (\a' -> (a',b,c,d,e,f,g,h,i)) <$> k a- {-# INLINE _1 #-}---}--class Field2 s t a b | s -> a, t -> b, s b -> t, t a -> s where- _2 :: Lens s t a b--instance Field2 (a,b) (a,b') b b' where- _2 k ~(a,b) = (\b' -> (a,b')) <$> k b- {-# INLINE _2 #-}--instance Field2 (a,b,c) (a,b',c) b b' where- _2 k ~(a,b,c) = (\b' -> (a,b',c)) <$> k b- {-# INLINE _2 #-}--instance Field2 (a,b,c,d) (a,b',c,d) b b' where- _2 k ~(a,b,c,d) = (\b' -> (a,b',c,d)) <$> k b- {-# INLINE _2 #-}--instance Field2 (a,b,c,d,e) (a,b',c,d,e) b b' where- _2 k ~(a,b,c,d,e) = (\b' -> (a,b',c,d,e)) <$> k b- {-# INLINE _2 #-}--{---instance Field2 (a,b,c,d,e,f) (a,b',c,d,e,f) b b' where- _2 k ~(a,b,c,d,e,f) = (\b' -> (a,b',c,d,e,f)) <$> k b- {-# INLINE _2 #-}--instance Field2 (a,b,c,d,e,f,g) (a,b',c,d,e,f,g) b b' where- _2 k ~(a,b,c,d,e,f,g) = (\b' -> (a,b',c,d,e,f,g)) <$> k b- {-# INLINE _2 #-}--instance Field2 (a,b,c,d,e,f,g,h) (a,b',c,d,e,f,g,h) b b' where- _2 k ~(a,b,c,d,e,f,g,h) = (\b' -> (a,b',c,d,e,f,g,h)) <$> k b- {-# INLINE _2 #-}--instance Field2 (a,b,c,d,e,f,g,h,i) (a,b',c,d,e,f,g,h,i) b b' where- _2 k ~(a,b,c,d,e,f,g,h,i) = (\b' -> (a,b',c,d,e,f,g,h,i)) <$> k b- {-# INLINE _2 #-}---}--class Field3 s t a b | s -> a, t -> b, s b -> t, t a -> s where- _3 :: Lens s t a b--instance Field3 (a,b,c) (a,b,c') c c' where- _3 k ~(a,b,c) = (\c' -> (a,b,c')) <$> k c- {-# INLINE _3 #-}--instance Field3 (a,b,c,d) (a,b,c',d) c c' where- _3 k ~(a,b,c,d) = (\c' -> (a,b,c',d)) <$> k c- {-# INLINE _3 #-}--instance Field3 (a,b,c,d,e) (a,b,c',d,e) c c' where- _3 k ~(a,b,c,d,e) = (\c' -> (a,b,c',d,e)) <$> k c- {-# INLINE _3 #-}--{---instance Field3 (a,b,c,d,e,f) (a,b,c',d,e,f) c c' where- _3 k ~(a,b,c,d,e,f) = (\c' -> (a,b,c',d,e,f)) <$> k c- {-# INLINE _3 #-}--instance Field3 (a,b,c,d,e,f,g) (a,b,c',d,e,f,g) c c' where- _3 k ~(a,b,c,d,e,f,g) = (\c' -> (a,b,c',d,e,f,g)) <$> k c- {-# INLINE _3 #-}--instance Field3 (a,b,c,d,e,f,g,h) (a,b,c',d,e,f,g,h) c c' where- _3 k ~(a,b,c,d,e,f,g,h) = (\c' -> (a,b,c',d,e,f,g,h)) <$> k c- {-# INLINE _3 #-}--instance Field3 (a,b,c,d,e,f,g,h,i) (a,b,c',d,e,f,g,h,i) c c' where- _3 k ~(a,b,c,d,e,f,g,h,i) = (\c' -> (a,b,c',d,e,f,g,h,i)) <$> k c- {-# INLINE _3 #-}---}--class Field4 s t a b | s -> a, t -> b, s b -> t, t a -> s where- _4 :: Lens s t a b--instance Field4 (a,b,c,d) (a,b,c,d') d d' where- _4 k ~(a,b,c,d) = (\d' -> (a,b,c,d')) <$> k d- {-# INLINE _4 #-}--instance Field4 (a,b,c,d,e) (a,b,c,d',e) d d' where- _4 k ~(a,b,c,d,e) = (\d' -> (a,b,c,d',e)) <$> k d- {-# INLINE _4 #-}--{---instance Field4 (a,b,c,d,e,f) (a,b,c,d',e,f) d d' where- _4 k ~(a,b,c,d,e,f) = (\d' -> (a,b,c,d',e,f)) <$> k d- {-# INLINE _4 #-}--instance Field4 (a,b,c,d,e,f,g) (a,b,c,d',e,f,g) d d' where- _4 k ~(a,b,c,d,e,f,g) = (\d' -> (a,b,c,d',e,f,g)) <$> k d- {-# INLINE _4 #-}--instance Field4 (a,b,c,d,e,f,g,h) (a,b,c,d',e,f,g,h) d d' where- _4 k ~(a,b,c,d,e,f,g,h) = (\d' -> (a,b,c,d',e,f,g,h)) <$> k d- {-# INLINE _4 #-}--instance Field4 (a,b,c,d,e,f,g,h,i) (a,b,c,d',e,f,g,h,i) d d' where- _4 k ~(a,b,c,d,e,f,g,h,i) = (\d' -> (a,b,c,d',e,f,g,h,i)) <$> k d- {-# INLINE _4 #-}---}--class Field5 s t a b | s -> a, t -> b, s b -> t, t a -> s where- _5 :: Lens s t a b--instance Field5 (a,b,c,d,e) (a,b,c,d,e') e e' where- _5 k ~(a,b,c,d,e) = (\e' -> (a,b,c,d,e')) <$> k e- {-# INLINE _5 #-}--{---instance Field5 (a,b,c,d,e,f) (a,b,c,d,e',f) e e' where- _5 k ~(a,b,c,d,e,f) = (\e' -> (a,b,c,d,e',f)) <$> k e- {-# INLINE _5 #-}--instance Field5 (a,b,c,d,e,f,g) (a,b,c,d,e',f,g) e e' where- _5 k ~(a,b,c,d,e,f,g) = (\e' -> (a,b,c,d,e',f,g)) <$> k e- {-# INLINE _5 #-}--instance Field5 (a,b,c,d,e,f,g,h) (a,b,c,d,e',f,g,h) e e' where- _5 k ~(a,b,c,d,e,f,g,h) = (\e' -> (a,b,c,d,e',f,g,h)) <$> k e- {-# INLINE _5 #-}--instance Field5 (a,b,c,d,e,f,g,h,i) (a,b,c,d,e',f,g,h,i) e e' where- _5 k ~(a,b,c,d,e,f,g,h,i) = (\e' -> (a,b,c,d,e',f,g,h,i)) <$> k e- {-# INLINE _5 #-}---} class Cons s t a b | s -> a, t -> b, s b -> t, t a -> s where _Cons :: Traversal s t (a,s) (b,t)