microlens (empty) → 0.1.0.0

raw patch · 5 files changed

+1076/−0 lines, 5 filesdep +basedep +transformerssetup-changed

Dependencies added: base, transformers

Files

LICENSE +30/−0
Setup.hs +2/−0
microlens.cabal +58/−0
src/Lens/Micro.hs +959/−0
src/Lens/Micro/Extras.hs +27/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2015, Artyom++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Artyom nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ microlens.cabal view

@@ -0,0 +1,58 @@+name:                microlens+version:             0.1.0.0+synopsis:            A tiny part of the ‘lens’ library which you can depend upon.+description:+  This is an extract from the @lens@ library (with only 1 dependency).+  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.+  .+  Use this library:+  .+    * if you want to define lenses or traversals in your own library, but+      don't want to depend on @lens@+    * if you are new to lenses and want a small library to play with,+      but don't want to use something “inferior” or have to relearn things+      when/if you switch to @lens@+  .+  Don't use this library:+  .+    * if you need @Iso@s, @Prism@s, indexed traversals, @at@, @ix@,+      or actually anything else which isn't defined here+    * if you think lenses compose “in the wrong order” (in which case+      you're looking for @fclabels@)+  .+  Note that microlens has /no/ dependencies starting from GHC 7.10 +  (base-4.8). Prior to that, it has to depend on transformers-0.2 or above.+license:             BSD3+license-file:        LICENSE+author:              Artyom+maintainer:          Artyom <yom@artyom.me>+homepage:            http://github.com/aelve/microlens+bug-reports:         http://github.com/aelve/microlens/issues+-- copyright:           +category:            Data, Lenses+build-type:          Simple+-- extra-source-files:  README.md+cabal-version:       >=1.10++source-repository head+  type:                git+  location:            git://github.com/aelve/microlens.git++library+  exposed-modules:     Lens.Micro+                       Lens.Micro.Extras+  -- other-modules:       +  -- other-extensions:    ++  -- Since base-4.8 we get the Identity functor in base, so we can avoid a+  -- transformers dependency.+  if impl(ghc>=7.9)+    build-depends:     base >=4.8 && <5+  if !impl(ghc>=7.9)+    build-depends:     base >=4.4 && <5+                     , transformers >=0.2++  hs-source-dirs:      src+  default-language:    Haskell2010

+ src/Lens/Micro.hs view

@@ -0,0 +1,959 @@+{-# LANGUAGE+  CPP+, MultiParamTypeClasses+, FunctionalDependencies+, FlexibleInstances+, FlexibleContexts+, RankNTypes+, ScopedTypeVariables+  #-}+++module Lens.Micro+(+  (&),++  -- * Setting (applying a function to values)+  ASetter,+  sets,+  (%~), over,+  (.~), set,+  mapped,++  -- * Getting (retrieving a value)+  -- $getters-note+  Getting,+  (^.),++  -- * Folds (getters which return multiple elements)+  (^..), toListOf,+  (^?),+  (^?!),+  folded,+  has,++  -- * Lenses (things which are both setters and getters)+  Lens, Lens',+  lens,++  -- * Traversals (lenses which have multiple targets)+  Traversal, Traversal',+  both,++  -- * Prisms+  -- $prisms-note+  _Left, _Right,+  _Just, _Nothing,++  -- * Tuples+  Field1(..),+  Field2(..),+  Field3(..),+  Field4(..),+  Field5(..),+)+where+++import Control.Applicative+import Data.Functor.Identity+import Data.Foldable+import Data.Monoid++#if __GLASGOW_HASKELL__ >= 710+import Data.Function ((&))+#endif+++{- $setup+-- >>> import Data.Char (toUpper)+-- >>> import Control.Arrow (first, second, left, right)+-}+++#if __GLASGOW_HASKELL__ < 710+{- |+'&' is a reverse application operator. This provides notational+convenience. Its precedence is one higher than that of the forward+application operator '$', which allows '&' to be nested in '$'.+-}+(&) :: a -> (a -> b) -> b+a & f = f a+{-# INLINE (&) #-}+infixl 1 &+#endif++-- Setting -----------------------------------------------------------------++{- |+@ASetter s t a b@ is something that turns a function modifying a value+into a function modifying a /structure/. If you ignore+'Control.Monad.Identity.Identity' (as @Identity a@ is the same thing as @a@),+the type is:++@+type ASetter s t a b = (a -> b) -> s -> t+@++This means that examples of setters you might've already seen are:++  * @'map' :: (a -> b) -> [a] -> [b]@++    (which corresponds to 'mapped')++  * @'fmap' :: 'Functor' f => (a -> b) -> f a -> f b@++    (which corresponds to 'mapped' as well)++  * @'Control.Arrow.first' :: (a -> b) -> (a, x) -> (b, x)@++    (which corresponds to '_1')++  * @'Control.Arrow.left' :: (a -> b) -> Either a x -> Either b x@++    (which corresponds to '_Left')++The reason 'Control.Monad.Identity.Identity' is used here is for 'ASetter' to+be composable with other types, such as 'Lens'.++Technically, if you're writing a library, you shouldn't use this type for+setters you are exporting from your library; the right type to use is+@Setter@, but it is not provided by microlens. It's completely alright,+however, to export functions which take an 'ASetter' as an argument.+-}+type ASetter s t a b = (a -> Identity b) -> s -> Identity t++{- |+'sets' creates an 'ASetter' from an ordinary function. (The only thing it+does is wrapping and unwrapping 'Control.Monad.Identity.Identity'.)+-}+sets :: ((a -> b) -> s -> t) -> ASetter s t a b+sets f g = Identity . f (runIdentity . g)+{-# INLINE sets #-}++{- |+('%~') applies a function to the target; an alternative explanation is that+it is an inverse of 'sets', which turns a setter into an ordinary+function. @'mapped' '%~' reverse@ is the same thing as @'fmap' reverse@.++See 'over' if you want a non-operator synonym.++Negating the 1st element of a pair:++>>> (1,2) & _1 %~ negate+(-1,2)++Turning all @Left@s in a list to upper case:++>>> (mapped._Left.mapped %~ toUpper) [Left "foo", Right "bar"]+[Left "FOO",Right "bar"]+-}+(%~) :: ASetter s t a b -> (a -> b) -> s -> t+(%~) = over+{-# INLINE (%~) #-}++infixr 4 %~++{- |+'over' is a synonym for ('%~').++Getting 'fmap' in a roundabout way:++@+'over' 'mapped' :: 'Functor' f => (a -> b) -> f a -> f b+'over' 'mapped' = 'fmap'+@++Applying a function to both components of a pair:++@+'over' 'both' :: (a -> b) -> (a, a) -> (b, b)+'over' 'both' = \\f t -> (f (fst t), f (snd t))+@++Using @'over' '_2'@ as a replacement for 'Control.Arrow.second':++>>> over _2 show (10,20)+(10,"20")+-}+over :: ASetter s t a b -> (a -> b) -> s -> t+over l f = runIdentity . l (Identity . f)+{-# INLINE over #-}++{- |+('.~') assigns a value to the target. These are equivalent:++@+l '.~' x+l '%~' 'const' x+@++See 'set' if you want a non-operator synonym.++Here it is used to change 2 fields of a 3-tuple:++>>> (0,0,0) & _1 .~ 1 & _3 .~ 3+(1,0,3)+-}+(.~) :: ASetter s t a b -> b -> s -> t+(.~) = set+{-# INLINE (.~) #-}++infixr 4 .~++{- |+'set' is a synonym for ('.~').++Setting the 1st component of a pair:++@+'set' '_1' :: x -> (a, b) -> (x, b)+'set' '_1' = \\x t -> (x, snd t)+@++Using it to rewrite ('Data.Functor.<$'):++@+'set' 'mapped' :: 'Functor' f => a -> f b -> f a+'set' 'mapped' = ('Data.Functor.<$')+@+-}+set :: ASetter s t a b -> b -> s -> t+set l b = runIdentity . l (\_ -> Identity b)+{-# INLINE set #-}++{- |+'mapped' is a setter for everything contained in a functor. You can use it+to map over lists, @Maybe@, or even @IO@ (which is something you can't do+with 'traversed' or 'each').++Here 'mapped' is used to turn a value to all non-'Nothing' values in a list:++>>> [Just 3,Nothing,Just 5] & mapped.mapped .~ 0+[Just 0,Nothing,Just 0]++Keep in mind that while 'mapped' is a more powerful setter than 'each', it+can't be used as a getter! This won't work (and will fail with a type error):++@+[(1,2),(3,4),(5,6)] '^..' 'mapped' . 'both'+@+-}+mapped :: Functor f => ASetter (f a) (f b) a b+mapped = sets fmap+{-# INLINE mapped #-}++-- Getting -----------------------------------------------------------------++{- $getters-note++Getters are a not-entirely-obvious way to use (supposedly) /value-changing/+traversals to /carry out/ information from a structure. For details, see the+documentation for 'Getting'.++Exporting @Getter@ is impossible, as then microlens would have to depend on+contravariant.+-}++{- |+@Getting r s a@ is, in a way, equivalent to @s -> a@. Since @'Const' r a@ is+the same as @r@, 'Getting' is actually @(a -> r) -> s -> r@, which is just+CPS-transformed @s -> a@. The reason 'Const' and CPS are used is that we want+getters to have the same shape as lenses (which we achieve because 'Const' is+a functor).+-}+type Getting r s a = (a -> Const r a) -> s -> Const r s++{- |+('^.') applies a getter to a value; in other words, it gets a value out of a+structure using a getter (which can be a lens, traversal, fold, etc.).++Getting 1st field of a tuple:++@+('^.' '_1') :: (a, b) -> a+('^.' '_1') = 'fst'+@++When ('^.') is used with a traversal, it combines all results using the+'Monoid' instance for the resulting type. For instance, for lists it would be+simple concatenation:++>>> ("str","ing") ^. each+"string"++The reason for this is that traversals use 'Applicative', and the+'Applicative' instance for 'Const' uses monoid concatenation to combine+“effects” of 'Const'.+-}+(^.) :: s -> Getting a s a -> a+s ^. l = getConst (l Const s)+{-# INLINE (^.) #-}++infixl 8 ^.++-- Folds -------------------------------------------------------------------++-- | A 'Monoid' for a 'Contravariant' 'Applicative'.+newtype Folding f a = Folding { getFolding :: f a }++instance (Applicative (Const r)) => Monoid (Folding (Const r) a) where+  mempty = Folding (Const . getConst $ pure ())+  {-# INLINE mempty #-}+  Folding fr `mappend` Folding fs = Folding (fr *> fs)+  {-# INLINE mappend #-}++{- |+@s ^.. t@ returns the list of all values that @t@ gets from @s@.++A 'Maybe' contains either 0 or 1 values:++>>> Just 3 ^.. _Just+[3]++Gathering all values in a list of tuples:++>>> [(1,2),(3,4)] ^.. each.each+[1,2,3,4]+-}+(^..) :: s -> Getting (Endo [a]) s a -> [a]+s ^.. l = toListOf l s+{-# INLINE (^..) #-}++infixl 8 ^..++{- |+'toListOf' is a synonym for ('^..').+-}+toListOf :: Getting (Endo [a]) s a -> s -> [a]+toListOf l = foldrOf l (:) []+{-# INLINE toListOf #-}++{- |+@s ^? t@ returns the 1st element @t@ returns, or 'Nothing' if @t@ doesn't+return anything. It's trivially implemented by passing the 'First' monoid to+the getter.++Safe 'head':++>>> [] ^? each+Nothing++>>> [1..3] ^? each+Just 1++Converting 'Either' to 'Maybe':++>>> Left 1 ^? _Right+Nothing++>>> Right 1 ^? _Right+Just 1+-}+(^?) :: s -> Getting (First a) s a -> Maybe a+s ^? l = getFirst (foldMapOf l (First . Just) s)+{-# INLINE (^?) #-}++infixl 8 ^?++{- |+('^?!') is an unsafe variant of ('^?') – instead of using 'Nothing' to+indicate that there were no elements returned, it throws an exception.+-}+(^?!) :: s -> Getting (Endo a) s a -> a+s ^?! l = foldrOf l const (error "(^?!): empty Fold") s+{-# INLINE (^?!) #-}++infixl 8 ^?!++foldrOf :: Getting (Endo r) s a -> (a -> r -> r) -> r -> s -> r+foldrOf l f z = flip appEndo z . foldMapOf l (Endo . f)+{-# INLINE foldrOf #-}++foldMapOf :: Getting r s a -> (a -> r) -> s -> r+foldMapOf l f = getConst . l (Const . f)+{-# INLINE foldMapOf #-}++{- |+'folded' is a fold for anything 'Foldable'. In a way, it's an opposite of+'mapped' – the most powerful getter, but can't be used as a setter.+-}+folded :: (Foldable f, Applicative (Const r)) => Getting r (f a) a+folded f = Const . getConst . getFolding . foldMap (Folding . f)+{-# INLINE folded #-}++{- |+'has' checks whether a getter (any getter, including lenses, traversals, and+folds) returns at least 1 value.++Checking whether a list is non-empty:++>>> has each []+False++You can also use it with e.g. '_Left' (and other 0-or-1 traversals) as a+replacement for 'Data.Maybe.isNothing', 'Data.Maybe.isJust' and other+@isConstructorName@ functions:++>>> has _Left (Left 1)+True+-}+has :: Getting Any s a -> s -> Bool+has l = getAny . foldMapOf l (\_ -> Any True)+{-# INLINE has #-}++-- Lenses ------------------------------------------------------------------++{- |+Lenses in a nutshell: use ('^.') to get, ('.~') to set, ('%~') to+modify. ('.')  composes lenses (i.e. if a @B@ is a part of @A@, and a @C@ is+a part of in @B@, then @b.c@ lets you operate on @C@ inside @A@). You can+create lenses with 'lens', or you can write them by hand (see below).++@Lens s t a b@ is the lowest common denominator of a setter and a getter,+something that has the power of both; it has a 'Functor' constraint, and+since both 'Const' and 'Control.Monad.Identity.Identity' are functors, it can+be used whenever a getter or a setter is needed.++  * @a@ is the type of the value inside of structure+  * @b@ is the type of the replaced value+  * @s@ is the type of the whole structure+  * @t@ is the type of the structure after replacing @a@ in it with @b@++A 'Lens' can only point at a single value inside a structure (unlike a+'Traversal').++It is easy to write lenses manually. The generic template is:++@+somelens :: Lens s t a b++-- “f” is the “a -> f b” function, “s” is the structure.+somelens f s =+  let+    a = ...                 -- Extract the value from “s”.+    rebuildWith b = ...     -- Write a function which would+                            -- combine “s” and modified value+                            -- to produce new structure.+  in+    rebuildWith '<$>' f a     -- Apply the structure-producing+                            -- function to the modified value.+@++Here's the '_1' lens:++@+_1 :: Lens (a, x) (b, x) a b+_1 f (a, x) = (\\b -> (b, x)) '<$>' f a+@++Here's a more complicated lens, which extracts /several/ values from a+structure (in a tuple):++@+type Age     = Int+type City    = String+type Country = String++data Person = Person Age City Country++-- This lens lets you access all location-related information about a person.+location :: 'Lens'' Person (City, Country)+location f (Person age city country) =+  (\\(city', country') -> Person age city' country') '<$>' f (city, country)+@++You even can choose to use a lens to present /all/ information contained in+the structure (in a different way). Such lenses are called @Iso@ in lens's+terminology. For instance (assuming you don't mind functions that can error+out), here's a lens which lets you act on the string representation of a+value:++@+string :: (Read a, Show a) => 'Lens'' a String+string f s = read '<$>' f (show s)+@++Using it to reverse a number:++@+>>> 123 '&' string '%~' reverse+321+@+-}+type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t++{- |+This is a type alias for monomorphic lenses which don't change the type of+the container (or of the value inside).+-}+type Lens' s a = Lens s s a a++{- |+'lens' creates a 'Lens' from a getter and a setter. The resulting lens isn't+the most effective one (because of having to traverse the structure twice+when modifying), but it shouldn't matter much.++A (partial) lens for list indexing:++@+ix :: Int -> 'Lens'' [a] a+ix i = 'lens' ('!!' i)                                   -- getter+            (\\s b -> take i s ++ b : drop (i+1) s)   -- setter+@++Usage:++@+>>> [1..9] '^.' ix 3+4++>>> [1..9] & ix 3 '%~' negate+[1,2,3,-4,5,6,7,8,9]+@++When getting, the setter is completely unused. When setting, the getter is+unused. Both are used only when the value is being modified.++Here's an example of using a lens targeting the head of a list. The getter is+replaced with 'undefined' to make sure it's not used:++>>> [1,2,3] & lens undefined (\s b -> b : tail s) .~ 10+[10,2,3]+-}+lens :: (s -> a) -> (s -> b -> t) -> Lens s t a b+lens sa sbt afb s = sbt s <$> afb (sa s)+{-# INLINE lens #-}++-- Traversals --------------------------------------------------------------++{- |+Traversals in a nutshell: they're like lenses but they can point at multiple+values. Use ('^..') (not '^.') to get all values, ('^?') to get the 1st+value, ('.~') to set values, ('%~') to modify them. ('.') composes traversals+just as it composes lenses.++@Traversal s t a b@ is a generalisation of 'Lens' which allows many targets+(possibly 0). It's achieved by changing the constraint to 'Applicative'+instead of 'Functor' – indeed, the point of 'Applicative' is that you can+combine effects, which is just what we need to have many targets.++Traversals don't differ from lenses when it comes to setting – you can use+usual ('%~') and ('.~') to modify and set values. Getting is a bit different,+because you have to decide what to do in the case of multiple values. In+particular, you can use these combinators (as well as everything else in the+“Folds” section):++  * ('^..') gets a list of values+  * ('^?') gets the 1st value (or 'Nothing' if there are no values)+  * ('^?!') gets the 1st value and throws an exception if there are no values++In addition, ('^.') works for traversals as well – it combines traversed+values using the ('<>') operation (if the values are instances of 'Monoid').++Traversing any value twice is a violation of traversal laws. You can,+however, traverse values in any order.++Ultimately, traversals should follow 2 laws:++@+t pure ≡ pure+fmap (t f) . t g ≡ getCompose . t (Compose . fmap f . g)+@++The 1st law states that you can't change the shape of the structure or do+anything funny with elements (traverse elements which aren't in the+structure, create new elements out of thin air, etc.). The 2nd law states+that you should be able to fuse 2 identical traversals into one. For a more+detailed explanation of the laws, see+<http://artyom.me/lens-over-tea-2#traversal-laws this blog post> (if you+prefer rambling blog posts), or+<https://www.cs.ox.ac.uk/jeremy.gibbons/publications/iterator.pdf The Essence Of The Iterator Pattern> (if you prefer papers).+-}+type Traversal s t a b = forall f. Applicative f => (a -> f b) -> s -> f t++{- |+This is a type alias for monomorphic traversals which don't change the type+of the container (or of the values inside).+-}+type Traversal' s a = Traversal s s a a++{- |+'both' traverses both fields of a tuple. Unlike @both@ from lens, it only+works for pairs – not for triples or 'Either'.++>>> ("str","ing") ^. both+"string"++>>> ("str","ing") & both %~ reverse+("rts","gni")+-}+both :: Traversal (a, a) (b, b) a b+both f = \ ~(a, b) -> liftA2 (,) (f a) (f b)+{-# INLINE both #-}++-- Prisms ------------------------------------------------------------------++{- $prisms-note++Prisms are traversals which always target 0 or 1 values. Moreover, it's+possible to /reverse/ a prism, using it to construct a structure instead of+peeking into it. Here's an example from the lens library:++@+>>> over _Left (+1) (Left 2)+Left 3++>>> _Left # 5+Left 5+@++However, it's not possible for microlens to export prisms, because their type+depends on @Choice@, which resides in the profunctors library, which is a+somewhat huge dependency. So, all prisms included here are traversals+instead.+-}++{- |+'_Left' targets the value contained in an 'Either', provided it's a 'Left'.++Gathering all @Left@s in a structure (like the 'Data.Either.lefts' function):++@+'toListOf' ('each' . '_Left') :: ['Either' a b] -> [a]+'toListOf' ('each' . '_Left') = 'Data.Either.lefts'+@++Checking whether an 'Either' is a 'Left' (like 'Data.Either.isLeft'):++>>> has _Left (Left 1)+True++>>> has _Left (Right 1)+False++Extracting a value (if you're sure it's a 'Left'):++>>> Left 1 ^?! _Left+1++Mapping over all @Left@s:++>>> (each._Left %~ map toUpper) [Left "foo", Right "bar"]+[Left "FOO",Right "bar"]++Implementation:++@+'_Left' f (Left a)  = 'Left' '<$>' f a+'_Left' _ (Right b) = 'pure' ('Right' b)+@+-}+_Left :: Traversal (Either a b) (Either a' b) a a'+_Left f (Left a) = Left <$> f a+_Left _ (Right b) = pure (Right b)+{-# INLINE _Left #-}++{- |+'_Right' targets the value contained in an 'Either', provided it's a 'Right'.++See documentation for '_Left'.+-}+_Right :: Traversal (Either a b) (Either a b') b b'+_Right f (Right b) = Right <$> f b+_Right _ (Left a) = pure (Left a)+{-# INLINE _Right #-}++{- |+'_Just' targets the value contained in a 'Maybe', provided it's a 'Just'.++See documentation for '_Left' (as these 2 are pretty similar). In particular,+it can be used to write these:++  * Unsafely extracting a value from a 'Just':++    @+    'Data.Maybe.fromJust' = ('^?!' '_Just')+    @++  * Checking whether a value is a 'Just':++    @+    'Data.Maybe.isJust' = 'has' '_Just'+    @++  * Converting a 'Maybe' to a list (empty or consisting of a single element):++    @+    'Data.Maybe.maybeToList' = ('^..' '_Just')+    @++  * Gathering all @Just@s in a list:++    @+    'Data.Maybe.catMaybes' = ('^..' 'each' . '_Just')+    @+-}+_Just :: Traversal (Maybe a) (Maybe a') a a'+_Just f (Just a) = Just <$> f a+_Just _ Nothing = pure Nothing+{-# INLINE _Just #-}++{- |+'_Nothing' targets a @()@ if the 'Maybe' is a 'Nothing', and doesn't target+anything otherwise:++>>> Just 1 ^.. _Nothing+[]++>>> Nothing ^.. _Nothing+[()]++It's not particularly useful (unless you want to use @'has' '_Nothing'@ as a+replacement for 'Data.Maybe.isNothing'), and provided mainly for consistency.++Implementation:++@+'_Nothing' f Nothing = 'const' 'Nothing' '<$>' f ()+'_Nothing' _ j       = 'pure' j+@+-}+_Nothing :: Traversal' (Maybe a) ()+_Nothing f Nothing = const Nothing <$> f ()+_Nothing _ j = pure j+{-# INLINE _Nothing #-}++-- Tuples ------------------------------------------------------------------++-- Commented instances amount to ~0.8s of building time.++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 lazy pattern).+  -}+  _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+  {- |+Gives access to the 2nd field of a tuple (up to 5-tuples).++See documentation for '_1'.+  -}+  _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+  {- |+Gives access to the 3rd field of a tuple (up to 5-tuples).++See documentation for '_1'.+  -}+  _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+  {- |+Gives access to the 4th field of a tuple (up to 5-tuples).++See documentation for '_1'.+  -}+  _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+  {- |+Gives access to the 5th field of a tuple (only for 5-tuples).++See documentation for '_1'.+  -}+  _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/Extras.hs view

@@ -0,0 +1,27 @@+module Lens.Micro.Extras+(+  (+~), (-~), (*~), (//~),+)+where+++import Lens.Micro+++infixr 4 +~, -~, *~, //~++(+~) :: Num a => ASetter s t a a -> a -> s -> t+l +~ n = over l (+ n)+{-# INLINE (+~) #-}++(*~) :: Num a => ASetter s t a a -> a -> s -> t+l *~ n = over l (* n)+{-# INLINE (*~) #-}++(-~) :: Num a => ASetter s t a a -> a -> s -> t+l -~ n = over l (subtract n)+{-# INLINE (-~) #-}++(//~) :: Fractional a => ASetter s t a a -> a -> s -> t+l //~ n = over l (/ n)+{-# INLINE (//~) #-}