lens 4.13.2.1 → 4.14

raw patch · 15 files changed

+194/−326 lines, 15 filesdep −comonads-fddep ~basedep ~comonaddep ~criterionPVP ok

version bump matches the API change (PVP)

Dependencies removed: comonads-fd

Dependency ranges changed: base, comonad, criterion, profunctors, semigroupoids, template-haskell, transformers

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +4/−0
• README.markdown +0/−178
• benchmarks/alongside.hs +9/−11
• benchmarks/plated.hs +8/−0
• benchmarks/unsafe.hs +7/−5
• benchmarks/zipper.hs +0/−45
• cabal.project +1/−0
• lens.cabal +7/−24
• src/Control/Lens/Cons.hs +0/−14
• src/Control/Lens/Getter.hs +10/−0
• src/Control/Lens/Internal/Zoom.hs +47/−43
• src/Control/Lens/Lens.hs +1/−1
• src/Control/Lens/TH.hs +5/−2
• src/Control/Lens/Zoom.hs +48/−2
• src/Language/Haskell/TH/Lens.hs +47/−1

@@ -1,3 +1,7 @@+4.14+----+* Remove `Cons` and `Snoc` instances for `NonEmpty`.+ 4.13.2.1 ------ * Fixed `itraverse_` and `imapM_` returning bottom

@@ -220,184 +220,6 @@  There are also a couple of hundred examples distributed throughout the haddock documentation. -Operators-=========--(See [`wiki/Operators`](https://github.com/ekmett/lens/wiki/Operators))--<table>-<thead>-<tr>-  <th>Combinator(s)</th>-  <th>w/ Result</th>-  <th>Stateful</th>-  <th>w/ Result</th>-  <th>Notes</th>-</tr>-</thead>-<tbody>-<tr><th colspan=5><a href="http://ekmett.github.com/lens/Control-Lens.html">Control.Lens</a></th></tr>-<tr>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Getter.html#v:view"><code>view</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-Getter.html#v:views"><code>views</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-Getter.html#v:-94-."><code>^.</code></a></td>-  <td/>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Getter.html#v:use"><code>use</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-Getter.html#v:uses"><code>uses</code></a></td>-  <td/>-  <td>View target(s). <a href="http://ekmett.github.com/lens/Control-Lens-Getter.html#v:view"><code>view</code></a> works like <a href="http://ekmett.github.com/lens/Control-Lens-Getter.html#v:use"><code>use</code></a> over a <code>MonadReader</code></td>-</tr>-<tr>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:set"><code>set</code></a>, <a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:.-126-"><code>.~</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-60-.-126-"><code>&lt;.~</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:.-61-"><code>.=</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:assign"><code>assign</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-60-.-61-"><code>&lt;.=</code></a></td>-  <td>Replace target(s). <a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--60-.-126-"><code>&lt;&lt;.~</code></a> and-      <a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--60-.-61-"><code>&lt;&lt;.=</code></a>-      return the old value</td>-</tr>-<tr>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:over"><code>over</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:mapOf"><code>mapOf</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-37--126-"><code>%~</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--37--126-"><code>&lt;%~</code></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-37--61-"><code>%=</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--37--61-"><code>&lt;%=</code></td>-  <td>Update target(s). <a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--60--37--126-"><code>&lt;&lt;%~</code></a> and-      <a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--60--37--61-"><code>&lt;&lt;%=</code></a>-      return the old value</td>-</tr>-<tr>-  <td><code>id</code>,<a href="http://ekmett.github.com/lens/Control-Lens-Traversal.html#v:traverseOf"><code>traverseOf</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-37--37--126-"><code>%%~</code></a></td>-  <td/>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-37--37--61-"><code>%%=</code></a></td>-  <td/>-  <td>Update target(s) with an <code>Applicative</code> or auxiliary result</td>-</tr>-<tr>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-43--126-"><code>+~</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--43--126-"><code>&lt;+~</code></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-43--61-"><code>+=</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--43--61-"><code>&lt;+=</code></td>-  <td>Add to target(s)</td>-</tr>-<tr>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-45--126-"><code>-~</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--45--126-"><code>&lt;-~</code></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-45--61-"><code>-=</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--45--61-"><code>&lt;-=</code></td>-  <td>Subtract from target(s)</td>-</tr>-<tr>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-42--126-"><code>*~</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--42--126-"><code>&lt;*~</code></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-42--61-"><code>*=</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--42--61-"><code>&lt;*=</code></td>-  <td>Multiply target(s)</td>-</tr>-<tr>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-47--47--126-"><code>//~</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--47--47--126-"><code>&lt;//~</code></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-47--47--61-"><code>//=</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--47--47--61-"><code>&lt;//=</code></td>-  <td>Divide target(s)</td>-</tr>-<tr>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-94--126-"><code>^~</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--94--126-"><code>&lt;^~</code></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-94--61-"><code>^=</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--94--61-"><code>&lt;^=</code></td>-  <td>Raise target(s) to a non-negative <code>Integral</code> power</td>-</tr>-<tr>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-94--94--126-"><code>^^~</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--94--94--126-"><code>&lt;^^~</code></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-94--94--61-"><code>^^=</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--94--94--61-"><code>&lt;^^=</code></td>-  <td>Raise target(s) to an <code>Integral</code> power</td>-</tr>-<tr>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-42--42--126-"><code>**~</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--42--42--126-"><code>&lt;**~</code></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-42--42--61-"><code>**=</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--42--42--61-"><code>&lt;**=</code></td>-  <td>Raise target(s) to an arbitrary power</td>-</tr>-<tr>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-124--124--126-"><code>||~</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--124--124--126-"><code>&lt;||~</code></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-124--124--61-"><code>||=</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--124--124--61-"><code>&lt;||=</code></td>-  <td>Logically or target(s)</td>-</tr>-<tr>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-38--38--126-"><code>&amp;&amp;~</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--38--38--126-"><code>&lt;&amp;&amp;~</code></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-38--38--61-"><code>&amp;&amp;=</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--38--38--61-"><code>&lt;&amp;&amp;=</code></td>-  <td>Logically and target(s)</td>-</tr>-<tr>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-60--62--126-"><code>&lt;&gt;~</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--60--62--126-"><code>&lt;&lt;&gt;~</code></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Setter.html#v:-60--62--61-"><code>&lt;&gt;=</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Lens.html#v:-60--60--62--61-"><code>&lt;&lt;&gt;=</code></td>-  <td><code>mappend</code> to the target monoidal value(s)</td>-</tr>-<tr>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Fold.html#v:headOf"><code>headOf</code>,<a href="http://ekmett.github.com/lens/Control-Lens-Fold.html#v:-94--63-"><code>^?</code></a></td>-  <td/><td/><td/>-  <td>Return <code>Just</code> the first target or <code>Nothing</code></td>-</tr>-<tr>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Fold.html#v:toListOf"><code>toListOf</code>,<a href="http://ekmett.github.com/lens/Control-Lens-Fold.html#v:-94-.."><code>^..</code></a></td>-  <td/><td/><td/>-  <td>Return a list of the target(s)</td>-</tr>-<tr><th colspan=5><a href="http://ekmett.github.com/lens/Control-Lens.html">Control.Lens</a> (Indexed)</th></tr>-<tr>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-IndexedSetter.html#v:iover"><code>iover</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-IndexedSetter.html#v:imapOf"><code>imapOf</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-IndexedSetter.html#v:-37--64--126-"><code>%@~</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-IndexedLens.html#v:-60--37--64--126-"><code>&lt;%@~</code></td>-  <td><a href=http://ekmett.github.com/lens/Control-Lens-IndexedSetter.html#v:-37--64--126-"><code>%@=</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-IndexedLens.html#v:-60--37--64--61-"><code>&lt;%@=</code></td>-  <td>Update target(s) with access to the index.</td>-</tr>-<tr>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-Indexed.html#v:withIndex"><code>withIndex</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-IndexedTraversal.html#v:itraverseOf"><code>itraverseOf</code></a>,<a href="http://ekmett.github.com/lens/Control-Lens-IndexedLens.html#v:-37--37--64--126-"><code>%%@~</code></a></td>-  <td/>-  <td><a href="http://ekmett.github.com/lens/Control-Lens-IndexedLens.html#v:-37--37--64--61-"><code>%%@=</code></a></td>-  <td/>-  <td>Update target(s) with an <code>Applicative</code> or auxiliary result with access to the index.</td>-</tr>-<tr><th colspan=5><a href="http://ekmett.github.com/lens/Data-Bits-Lens.html">Data.Bits.Lens</a></th></tr>-<tr>-  <td><a href="http://ekmett.github.com/lens/Data-Bits-Lens.html#v:-124--126-"><code>.|.~</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Data-Bits-Lens.html#v:-60--124--126-"><code>&lt;.|.~</code></td>-  <td><a href="http://ekmett.github.com/lens/Data-Bits-Lens.html#v:-124--61-"><code>.|.=</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Data-Bits-Lens.html#v:-60--124--61-"><code>&lt;.|.=</code></td>-  <td>Bitwise or target(s)</td>-</tr>-<tr>-  <td><a href="http://ekmett.github.com/lens/Data-Bits-Lens.html#v:-38--126-"><code>.&amp;.~</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Data-Bits-Lens.html#v:-60--38--126-"><code>&lt;.&amp;.~</code></td>-  <td><a href="http://ekmett.github.com/lens/Data-Bits-Lens.html#v:-38--61-"><code>.&amp;.=</code></a></td>-  <td><a href="http://ekmett.github.com/lens/Data-Bits-Lens.html#v:-60--38--61-"><code>&lt;.&amp;.=</code></td>-  <td>Bitwise and target(s)</td>-</tr>-<tr><th colspan=5><a href="http://ekmett.github.com/lens/System-FilePath-Lens.html">System.FilePath.Lens</a></th></tr>-<tr>-  <td><a href="http://ekmett.github.com/lens/System-FilePath-Lens.html#v:-60--47--62--126-"><code>&lt;/&gt;~</code></a></td>-  <td><a href="http://ekmett.github.com/lens/System-FilePath-Lens.html#v:-60--60--47--62--126-"><code>&lt;&lt;/&gt;~</code></td>-  <td><a href="http://ekmett.github.com/lens/System-FilePath-Lens.html#v:-60--47--62--61-"><code>&lt;/&gt;=</code></a></td>-  <td><a href="http://ekmett.github.com/lens/System-FilePath-Lens.html#v:-60--60--47--62--61-"><code>&lt;&lt;/&gt;=</code></td>-  <td>Append a relative path to a <code>FilePath</code></td>-</tr>-<tr>-  <td><a href="http://ekmett.github.com/lens/System-FilePath-Lens.html#v:-60-.-62--126-"><code>&lt;.&gt;~</code></a></td>-  <td><a href="http://ekmett.github.com/lens/System-FilePath-Lens.html#v:-60--60-.-62--126-"><code>&lt;&lt;.&gt;~</code></td>-  <td><a href="http://ekmett.github.com/lens/System-FilePath-Lens.html#v:-60-.-62--61-"><code>&lt;.&gt;=</code></a></td>-  <td><a href="http://ekmett.github.com/lens/System-FilePath-Lens.html#v:-60--60-.-62--61-"><code>&lt;&lt;.&gt;=</code></td>-  <td>Append a file extension to a <code>FilePath</code></td>-</tr>-</tbody>-</table>-- Contact Information ------------------- 

@@ -70,22 +70,20 @@ -- alongside' :: Lens s t a b -> Lens s' t' a' b' -> Lens (s,s') (t,t') (a,a') (b,b') -- {-# INLINE alongside'#-} -compound :: Lens s t a b-         -> Lens s' t' a' b'-         -> Lens (s,s') (t,t') (a,a') (b,b')+compound :: Lens' s a+         -> Lens' s' a'+         -> Lens' (s,s') (a,a') compound l r = lens (\(s, s') -> (view l s, view r s'))                     (\(s, s') (t, t') -> (set l t s, set r t' s')) {-# INLINE compound #-} -compound5 :: Lens s t a b-          -> Lens s' t' a' b'-          -> Lens s'' t'' a'' b''-          -> Lens s''' t''' a''' b'''-          -> Lens s'''' t'''' a'''' b''''-          -> Lens (s, (s', (s'', (s''', s''''))))-                  (t, (t', (t'', (t''', t''''))))+compound5 :: Lens' s a+          -> Lens' s' a'+          -> Lens' s'' a''+          -> Lens' s''' a'''+          -> Lens' s'''' a''''+          -> Lens' (s, (s', (s'', (s''', s''''))))                   (a, (a', (a'', (a''', a''''))))-                  (b, (b', (b'', (b''', b'''')))) compound5 l l' l'' l''' l''''   = lens (\(s, (s', (s'', (s''', s''''))))            -> (view l s, (view l' s', (view l'' s'', (view l''' s''', view l'''' s'''')))) )

@@ -2,7 +2,15 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} {-# OPTIONS_GHC -funbox-strict-fields #-}++#ifndef MIN_VERSION_base+#define MIN_VERSION_base(x,y,z) 1+#endif++#if !(MIN_VERSION_base(4,8,0)) import           Control.Applicative+#endif+ import           Control.Lens import           Control.DeepSeq import           Criterion.Main

@@ -6,16 +6,18 @@ import Control.Exception  import Criterion.Main-import Criterion.Config+import Criterion.Types (Config(..)) +import Data.Functor.Identity (Identity(..))+ import GHC.Exts  overS :: ASetter s t a b -> (a -> b) -> s -> t-overS l f = runMutator . l (Mutator . f)+overS l f = runIdentity . l (Identity . f) {-# INLINE overS #-}  mappedS :: ASetter [a] [b] a b-mappedS f = Mutator . map (runMutator . f)+mappedS f = Identity . map (runIdentity . f) {-# INLINE mappedS #-}  overU :: ASetter s t a b -> (a -> b) -> s -> t@@ -53,11 +55,11 @@         --l = replicate n ();   f = (\ _ -> ())         --l = replicate n ();   f = (\ !_ -> ()) -- strange results         --l = replicate n ();   f = lazy (\_ -> ())-    defaultMainWith config (return ())+    defaultMainWith config         [ bench "map   safe noinline" $ nf (mapSN f) l         , bench "map   safe   inline" $ nf (mapSI f) l         , bench "map unsafe noinline" $ nf (mapUN f) l         , bench "map unsafe   inline" $ nf (mapUI f) l         ]   where-    config = defaultConfig { cfgSamples = ljust 1000 }+    config = defaultConfig { resamples = 1000 }

@@ -1,45 +0,0 @@-module Main-       ( main -- :: IO ()-       ) where--import Control.Lens-import Criterion.Main--main :: IO ()-main = defaultMain-  [ bgroup "rezip"-      [ bench "rezip"             $ nf tugAndRezip1 ['a'..'z']-      , bench "farthest leftward" $ nf tugAndRezip2 ['a'..'z']-      , bench "leftmost"          $ nf tugAndRezip3 ['a'..'z']-      , bench "tugTo"             $ nf tugAndRezip4 ['a'..'z']-      ]-  , bgroup "zipper creation"-      [ bench "over traverse id"  $ nf (over traverse id) ['a'..'z']-      , bench "zipper"            $ nf zipTraverseRezip   ['a'..'z']-      ]-  , bgroup "downward"-      [ bench "downward _1"       $ nf downwardAndRezip1 (['a'..'z'],['z'..'a'])-      , bench "fromWithin"        $ nf downwardAndRezip2 (['a'..'z'],['z'..'a'])-      ]-  ]---- What's the fastest rezip of all?-tugAndRezip1, tugAndRezip2, tugAndRezip3 :: String -> String-tugAndRezip1 xs = zipntugs 25 xs & focus .~ 'a' & rezip-tugAndRezip2 xs = zipntugs 25 xs & focus .~ 'b' & farthest leftward & rezip-tugAndRezip3 xs = zipntugs 25 xs & focus .~ 'c' & leftmost & rezip-tugAndRezip4 xs = zipntugs 25 xs & focus .~ 'd' & tugTo 0 & rezip--zipntugs i x = zipper x & fromWithin traverse & tugs rightward i---- How fast is creating and destroying a zipper compared to--- a regular traversal?-zipTraverseRezip x = zipper x & fromWithin traverse & rezip---- is 'downward' any faster than the composition of traverse?-downwardAndRezip1 :: (String, String) -> (String, String)-downwardAndRezip1 xs =-  zipper xs & downward _1 & fromWithin traverse & focus .~ 'h' & rezip-downwardAndRezip2 :: (String, String) -> (String, String)-downwardAndRezip2 xs =-  zipper xs & fromWithin (_1.traverse) & focus .~ 'g' & rezip

@@ -0,0 +1,1 @@+packages: .

@@ -1,6 +1,6 @@ name:          lens category:      Data, Lenses, Generics-version:       4.13.2.1+version:       4.14 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE@@ -91,6 +91,7 @@   .travis.yml   .gitignore   .vim.custom+  cabal.project   examples/LICENSE   examples/lens-examples.cabal   examples/*.hs@@ -109,7 +110,7 @@  source-repository head   type: git-  location: git://github.com/ekmett/lens.git+  location: https://github.com/ekmett/lens.git  -- Enable benchmarking against Neil Mitchell's uniplate library for comparative performance analysis. Defaults to being turned off to avoid -- the extra dependency.@@ -315,7 +316,7 @@    -- hack around the buggy unused matches check for class associated types in ghc 8 rc1   if impl(ghc >= 8)-    ghc-options: -fno-warn-missing-pat-syn-sigs -fno-warn-unused-matches+    ghc-options: -Wno-missing-pattern-synonym-signatures -Wno-unused-matches    if flag(j) && impl(ghc>=7.8)     ghc-options: -j4@@ -452,8 +453,7 @@   hs-source-dirs: benchmarks   build-depends:     base,-    comonad,-    comonads-fd,+    comonad >= 4,     criterion,     deepseq,     lens,@@ -497,25 +497,8 @@   hs-source-dirs: benchmarks   build-depends:     base,-    comonad,-    comonads-fd,-    criterion,-    deepseq,-    generic-deriving,-    lens,-    transformers---- Benchmarking zipper usage-benchmark zipper-  type:           exitcode-stdio-1.0-  main-is:        zipper.hs-  ghc-options:    -w -O2 -threaded -fdicts-cheap -funbox-strict-fields-  hs-source-dirs: benchmarks-  build-depends:-    base,-    comonad,-    comonads-fd,-    criterion,+    comonad >= 4,+    criterion >= 1,     deepseq,     generic-deriving,     lens,

@@ -52,8 +52,6 @@ import Control.Lens.Type import qualified Data.ByteString      as StrictB import qualified Data.ByteString.Lazy as LazyB-import           Data.List.NonEmpty   (NonEmpty(..))-import qualified Data.List.NonEmpty   as NonEmpty import           Data.Monoid import qualified Data.Sequence as Seq import           Data.Sequence hiding ((<|), (|>), (:<), (:>))@@ -121,12 +119,6 @@     []     -> Left  []   {-# INLINE _Cons #-} -instance a~b => Cons (NonEmpty a) (NonEmpty b) a b where-  _Cons = prism' (uncurry NonEmpty.cons) $ \ xyz -> case xyz of-    (x:|y:z) -> Just (x,y:|z)-    _        -> Nothing-  {-# INLINE _Cons #-}- instance Cons (Seq a) (Seq b) a b where   _Cons = prism (uncurry (Seq.<|)) $ \aas -> case viewl aas of     a Seq.:< as -> Right (a, as)@@ -351,12 +343,6 @@     then Left []     else Right (Prelude.init aas, Prelude.last aas)   {-# INLINE _Snoc #-}--instance a~b => Snoc (NonEmpty a) (NonEmpty b) a b where-  _Snoc = prism' (\(x:|y,z) -> x:|y++[z]) $ \xyz -> case xyz of-    x:|y-      | Prelude.null y -> Nothing-      | otherwise      -> Just (x :| Prelude.init y, Prelude.last y)  instance Snoc (Seq a) (Seq b) a b where   _Snoc = prism (uncurry (Seq.|>)) $ \aas -> case viewr aas of

@@ -48,6 +48,16 @@ -- Since it is only a function, every 'Getter' obviously only retrieves a -- single value for a given input. --+-- A common question is whether you can combine multiple 'Getter's to+-- retrieve multiple values. Recall that all 'Getter's are 'Fold's and that+-- we have a @'Monoid' m => 'Applicative' ('Const' m)@ instance to play+-- with. Knowing this, we can use @'Data.Monoid.<>'@ to glue 'Fold's+-- together:+--+-- >>> import Data.Monoid+-- >>> (1, 2, 3, 4, 5) ^.. (_2 <> _3 <> _5)+-- [2,3,5]+-- ------------------------------------------------------------------------------- module Control.Lens.Getter   (

@@ -1,10 +1,12 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE Safe #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} +#if __GLASGOW_HASKELL__ < 708+{-# LANGUAGE Trustworthy #-}+#endif+ {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-} ----------------------------------------------------------------------------- -- |@@ -19,15 +21,14 @@ module Control.Lens.Internal.Zoom   (   -- * Zoom-    Zoomed-  , Focusing(..)+    Focusing(..)   , FocusingWith(..)   , FocusingPlus(..)   , FocusingOn(..)   , FocusingMay(..), May(..)   , FocusingErr(..), Err(..)+  , FocusingFree(..), Freed(..)   -- * Magnify-  , Magnified   , Effect(..)   , EffectRWS(..)   ) where@@ -36,42 +37,13 @@ import Control.Category import Control.Comonad import Control.Monad.Reader as Reader-import Control.Monad.Trans.State.Lazy as Lazy-import Control.Monad.Trans.State.Strict as Strict-import Control.Monad.Trans.Writer.Lazy as Lazy-import Control.Monad.Trans.Writer.Strict as Strict-import Control.Monad.Trans.RWS.Lazy as Lazy-import Control.Monad.Trans.RWS.Strict as Strict-import Control.Monad.Trans.Error-import Control.Monad.Trans.Except-import Control.Monad.Trans.List-import Control.Monad.Trans.Identity-import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Free import Data.Functor.Bind import Data.Functor.Contravariant import Data.Semigroup import Prelude hiding ((.),id)  --------------------------------------------------------------------------------- Zoomed----------------------------------------------------------------------------------- | This type family is used by 'Control.Lens.Zoom.Zoom' to describe the common effect type.-type family Zoomed (m :: * -> *) :: * -> * -> *-type instance Zoomed (Strict.StateT s z) = Focusing z-type instance Zoomed (Lazy.StateT s z) = Focusing z-type instance Zoomed (ReaderT e m) = Zoomed m-type instance Zoomed (IdentityT m) = Zoomed m-type instance Zoomed (Strict.RWST r w s z) = FocusingWith w z-type instance Zoomed (Lazy.RWST r w s z) = FocusingWith w z-type instance Zoomed (Strict.WriterT w m) = FocusingPlus w (Zoomed m)-type instance Zoomed (Lazy.WriterT w m) = FocusingPlus w (Zoomed m)-type instance Zoomed (ListT m) = FocusingOn [] (Zoomed m)-type instance Zoomed (MaybeT m) = FocusingMay (Zoomed m)-type instance Zoomed (ErrorT e m) = FocusingErr e (Zoomed m)-type instance Zoomed (ExceptT e m) = FocusingErr e (Zoomed m)-------------------------------------------------------------------------------- -- Focusing ------------------------------------------------------------------------------ @@ -256,16 +228,48 @@   {-# INLINE (<*>) #-}  --------------------------------------------------------------------------------- Magnified+-- Freed ------------------------------------------------------------------------------ --- | This type family is used by 'Control.Lens.Zoom.Magnify' to describe the common effect type.-type family Magnified (m :: * -> *) :: * -> * -> *-type instance Magnified (ReaderT b m) = Effect m-type instance Magnified ((->)b) = Const-type instance Magnified (Strict.RWST a w s m) = EffectRWS w s m-type instance Magnified (Lazy.RWST a w s m) = EffectRWS w s m-type instance Magnified (IdentityT m) = Magnified m+-- | Make a 'Monoid' out of 'FreeF' for result collection.++newtype Freed f m a = Freed { getFreed :: FreeF f a (FreeT f m a) }++instance (Applicative f, Semigroup a, Monad m) => Semigroup (Freed f m a) where+  Freed (Pure a) <> Freed (Pure b) = Freed $ Pure $ a <> b+  Freed (Pure a) <> Freed (Free g) = Freed $ Free $ liftA2 (liftM2 (<>)) (pure $ return a) g+  Freed (Free f) <> Freed (Pure b) = Freed $ Free $ liftA2 (liftM2 (<>)) f (pure $ return b)+  Freed (Free f) <> Freed (Free g) = Freed $ Free $ liftA2 (liftM2 (<>)) f g++instance (Applicative f, Monoid a, Monad m) => Monoid (Freed f m a) where+  mempty = Freed $ Pure mempty++  Freed (Pure a) `mappend` Freed (Pure b) = Freed $ Pure $ a `mappend` b+  Freed (Pure a) `mappend` Freed (Free g) = Freed $ Free $ liftA2 (liftM2 mappend) (pure $ return a) g+  Freed (Free f) `mappend` Freed (Pure b) = Freed $ Free $ liftA2 (liftM2 mappend) f (pure $ return b)+  Freed (Free f) `mappend` Freed (Free g) = Freed $ Free $ liftA2 (liftM2 mappend) f g++------------------------------------------------------------------------------+-- FocusingFree+------------------------------------------------------------------------------++-- | Used by 'Control.Lens.Zoom.Zoom' to 'Control.Lens.Zoom.zoom' into+-- 'Control.Monad.Trans.FreeT'+newtype FocusingFree f m k s a = FocusingFree { unfocusingFree :: k (Freed f m s) a }++instance Functor (k (Freed f m s)) => Functor (FocusingFree f m k s) where+  fmap f (FocusingFree as) = FocusingFree (fmap f as)+  {-# INLINE fmap #-}++instance Apply (k (Freed f m s)) => Apply (FocusingFree f m k s) where+  FocusingFree kf <.> FocusingFree ka = FocusingFree (kf <.> ka)+  {-# INLINE (<.>) #-}++instance Applicative (k (Freed f m s)) => Applicative (FocusingFree f m k s) where+  pure = FocusingFree . pure+  {-# INLINE pure #-}+  FocusingFree kf <*> FocusingFree ka = FocusingFree (kf <*> ka)+  {-# INLINE (<*>) #-}  ----------------------------------------------------------------------------- --- Effect

@@ -545,7 +545,7 @@  -- | Modify the target of a 'Lens' and return the result. ----- When you do not need the result of the addition, ('Control.Lens.Setter.%~') is more flexible.+-- When you do not need the result of the operation, ('Control.Lens.Setter.%~') is more flexible. -- -- @ -- ('<%~') ::             'Lens' s t a b      -> (a -> b) -> s -> (b, t)

@@ -797,8 +797,11 @@        -- Recurse into instance declarations because they main contain       -- associated data family instances.-      InstanceD ctx inst body -> InstanceD ctx inst <$> traverse go body-+#if MIN_VERSION_template_haskell(2,11,0)+      InstanceD moverlap ctx inst body -> InstanceD moverlap ctx inst <$> traverse go body+#else+      InstanceD ctx inst body -> InstanceD  ctx inst <$> traverse go body+#endif       _ -> pure dec  stripFields :: Dec -> Dec

@@ -29,8 +29,10 @@ -- ------------------------------------------------------------------------------- module Control.Lens.Zoom-  ( Magnify(..)+  ( Magnified+  , Magnify(..)   , Zoom(..)+  , Zoomed   ) where  import Control.Lens.Getter@@ -50,6 +52,7 @@ import Control.Monad.Trans.List import Control.Monad.Trans.Identity import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Free import Data.Monoid import Data.Profunctor.Unsafe import Prelude@@ -71,10 +74,46 @@ -- Chosen so that they have lower fixity than ('%='), and to match ('<~'). infixr 2 `zoom`, `magnify` +------------------------------------------------------------------------------+-- Zoomed+------------------------------------------------------------------------------++-- | This type family is used by 'Control.Lens.Zoom.Zoom' to describe the common effect type.+type family Zoomed (m :: * -> *) :: * -> * -> *+type instance Zoomed (Strict.StateT s z) = Focusing z+type instance Zoomed (Lazy.StateT s z) = Focusing z+type instance Zoomed (ReaderT e m) = Zoomed m+type instance Zoomed (IdentityT m) = Zoomed m+type instance Zoomed (Strict.RWST r w s z) = FocusingWith w z+type instance Zoomed (Lazy.RWST r w s z) = FocusingWith w z+type instance Zoomed (Strict.WriterT w m) = FocusingPlus w (Zoomed m)+type instance Zoomed (Lazy.WriterT w m) = FocusingPlus w (Zoomed m)+type instance Zoomed (ListT m) = FocusingOn [] (Zoomed m)+type instance Zoomed (MaybeT m) = FocusingMay (Zoomed m)+type instance Zoomed (ErrorT e m) = FocusingErr e (Zoomed m)+type instance Zoomed (ExceptT e m) = FocusingErr e (Zoomed m)+type instance Zoomed (FreeT f m) = FocusingFree f m (Zoomed m)++------------------------------------------------------------------------------+-- Magnified+------------------------------------------------------------------------------++-- | This type family is used by 'Control.Lens.Zoom.Magnify' to describe the common effect type.+type family Magnified (m :: * -> *) :: * -> * -> *+type instance Magnified (ReaderT b m) = Effect m+type instance Magnified ((->)b) = Const+type instance Magnified (Strict.RWST a w s m) = EffectRWS w s m+type instance Magnified (Lazy.RWST a w s m) = EffectRWS w s m+type instance Magnified (IdentityT m) = Magnified m++------------------------------------------------------------------------------+-- Zoom+------------------------------------------------------------------------------+ -- | This class allows us to use 'zoom' in, changing the 'State' supplied by -- many different 'Control.Monad.Monad' transformers, potentially quite -- deep in a 'Monad' transformer stack.-class (Zoomed m ~ Zoomed n, MonadState s m, MonadState t n) => Zoom m n s t | m -> s, n -> t, m t -> n, n s -> m where+class (MonadState s m, MonadState t n) => Zoom m n s t | m -> s, n -> t, m t -> n, n s -> m where   -- | Run a monadic action in a larger 'State' than it was defined in,   -- using a 'Lens'' or 'Control.Lens.Traversal.Traversal''.   --@@ -160,6 +199,13 @@ instance Zoom m n s t => Zoom (ExceptT e m) (ExceptT e n) s t where   zoom l = ExceptT . liftM getErr . zoom (\afb -> unfocusingErr #. l (FocusingErr #. afb)) . liftM Err . runExceptT   {-# INLINE zoom #-}++instance (Functor f, Zoom m n s t) => Zoom (FreeT f m) (FreeT f n) s t where+  zoom l = FreeT . liftM (fmap $ zoom l) . liftM getFreed . zoom (\afb -> unfocusingFree #. l (FocusingFree #. afb)) . liftM Freed . runFreeT++------------------------------------------------------------------------------+-- Magnify+------------------------------------------------------------------------------  -- TODO: instance Zoom m m a a => Zoom (ContT r m) (ContT r m) a a where 

@@ -125,6 +125,13 @@   , _RecGadtC #endif #if MIN_VERSION_template_haskell(2,11,0)+  -- ** Overlap Prisms+  ,_Overlappable+  ,_Overlapping+  ,_Overlaps+  ,_Incoherent+#endif+#if MIN_VERSION_template_haskell(2,11,0)   -- ** SourceUnpackedness Prisms   , _NoSourceUnpackedness   , _SourceNoUnpack@@ -848,13 +855,52 @@       remitter (ClassD x y z w u) = Just (x, y, z, w, u)       remitter _ = Nothing +#if MIN_VERSION_template_haskell(2,11,0)+_InstanceD :: Prism' Dec (Maybe Overlap, Cxt, Type, [Dec])+#else _InstanceD :: Prism' Dec (Cxt, Type, [Dec])+#endif _InstanceD   = prism' reviewer remitter   where+#if MIN_VERSION_template_haskell(2,11,0)+      reviewer (x, y, z, w) = InstanceD x y z w+      remitter (InstanceD x y z w) = Just (x, y, z, w)+#else       reviewer (x, y, z) = InstanceD x y z-      remitter (InstanceD x y z) = Just (x, y, z)+      remitter (InstanceD x y z) = Just ( x, y, z)+#endif       remitter _ = Nothing++#if MIN_VERSION_template_haskell(2,11,0)+_Overlappable  :: Prism' Overlap  ()+_Overlappable  = prism' reviewer remitter+  where+      reviewer () = Overlappable+      remitter Overlappable = Just  ()+      remitter _ = Nothing++_Overlapping :: Prism' Overlap ()+_Overlapping = prism' reviewer remitter+  where+      reviewer () = Overlapping+      remitter Overlapping = Just ()+      remitter _ = Nothing++_Overlaps ::  Prism' Overlap  ()+_Overlaps =  prism' reviewer remitter+  where+      reviewer () =  Overlaps+      remitter Overlaps = Just ()+      remitter _ = Nothing++_Incoherent  :: Prism' Overlap ()+_Incoherent  = prism' reviewer remitter+  where+      reviewer () = Incoherent+      remitter Incoherent = Just ()+      remitter _ = Nothing+#endif  _SigD :: Prism' Dec (Name, Type) _SigD