packages feed

lens 5.2 → 5.3.6

raw patch · 60 files changed

Files

.hlint.yaml view
@@ -16,6 +16,7 @@ - ignore: {name: Use list comprehension, within: [Control.Lens.Internal.FieldTH]} - ignore: {name: Use fmap, within: [Control.Exception.Lens, Control.Lens.Internal.Zoom, Control.Lens.Zoom, Control.Lens.Indexed, Control.Lens.Fold, Control.Monad.Error.Lens,Control.Lens.Setter]} # Needed to support pre-AMP GHC-7.8 - ignore: {name: Use uncurry}+- ignore: {name: Fuse concatMap/<&>, within: [Control.Lens.Internal.FieldTH]}  - fixity: "infixr 9 ..." - fixity: "infixl 1 &~"
CHANGELOG.markdown view
@@ -1,3 +1,114 @@+5.3.6 [2026.01.10]+------------------+* Allow building with `template-haskell-2.24.*` (GHC 9.14).+* Add `_SpecialiseEP` to `Language.Haskell.TH.Lens` (when building with+  `template-haskell-2.24.*`/GHC 9.14 or later).++5.3.5 [2025.06.17]+------------------+* Replace `test-framework` with `tasty` in the test suite.++5.3.4 [2025.03.03]+------------------+* Reduce the arity of `foldr1Of`, `foldl1Of`, `foldrOf'`, `foldlOf'`,+  `foldr1Of'`, `foldl1Of'`, `foldrMOf`, and `foldlMOf` so that GHC is more+  eager to inline them. On a simple benchmark involving `sumOf` (defined in+  terms of `foldlOf'`), this improves performance by 8x.+* Add `Ixed`, `Cons`, `Each`, `AsEmpty`, `Reversing`, and `Rewrapped` instances+  for strict boxed vectors when building with `vector-0.13.2` or later.+* Add an `AsEmpty` instance for primitive `Vector`s.++5.3.3 [2024.12.28]+------------------+* Add `makeFieldsId`, which generates overloaded field accessors using the+  same names as the underlying fields. This is intended for use with the+  `NoFieldSelectors` and `DuplicateRecordFields` language extensions.++  Also add `classIdFields :: LensRules` and `classIdNamer :: FieldNamer`, both+  of which use the same naming rules as `makeFieldsId`.+* Update the `Prism`s in `Language.Haskell.TH.Lens` to reflect additions to+  `template-haskell-2.23.0.0`:+  * Add an `_OrP` `Prism` for the `Pat` data type.+  * Add `_ForallE`, `_ForallVisE`, and `_ConstrainedE` `Prism`s for the `Exp`+    data type.++5.3.2 [2024.05.12]+------------------+* Define the following lenses that perform an operation and result the old+  result:+  * `(<<<>:~)` (prepend to the front via `(<>)` and return the old result)+  * `(<<<|~)` (prepend to the front via `(<|)` and return the old result)+  * `(<<|>~)` (append to the back via `(|>)` and return the old result)++  Each of these also has a variant that end with `=` instead of `~` (e.g.,+  `(<<<>:=)`) for working in a `MonadState` setting.+* Re-export `(<>:~)`, `(<<>:~)`, `(<|~)`, `(<<|~)`, `(|>~)`, and `(<|>~)` (as+  well as their variants which end with `=` instead of `~`, and their variants+  which return the old result) from `Control.Lens.Operators`.++5.3.1 [2024.05.05]+------------------+* Add a `Magnify` instance for the CPS variant of `RWST` when building with+  `mtl-2.3` or later.++5.3 [2024.05.04]+----------------+* Allow building with GHC 9.10.+* Update the `Prism`s in `Language.Haskell.TH.Lens` to reflect additions to+  `template-haskell-2.22.0.0`:+  * The `_InfixD` `Prism` now focuses on `(Fixity, NamespaceSpecifier, Name)`+    when building with `template-haskell-2.22.0.0` or later.+  * Add `Prism`s for the newly introduced `NamespaceSpecifier` data type.+  * Add `_TypeP` and `_InvisP` `Prism`s for the `Pat` data type.+  * Add a `_TypeE` `Prism` for the `Exp` data type.+  * Add a `_SCCP` `Prism` for the `Pragma` data type.+* Add the following `Setter`s for prepending and appending elements:+  * `(<>:~)`: prepend an element to the front via `(<>)`.+  * `(<<>:~)`: prepend an element to the front via `(<>)` and return the result.+  * `(<|~)`: cons an element to the front via `(<|)`.+  * `(<<|~)`: cons an element to the front via `(<|)` and return the result.+  * `(|>~)`: snoc an element to the back via `(|>)`.+  * `(<|>~)`: snoc an element to the back via `(|>)` and return the result.++  Each of these also has a variant that end with `=` instead of `~` (e.g.,+  `(<>:=)`) for working in a `MonadState` setting.++5.2.3 [2023.08.24]+------------------+* Allow building with GHC 9.8.+* Add new `Prism`s to `Language.Haskell.TH.Lens` to reflect recent additions to+  `template-haskell`:+  * `_GetFieldE` and `_ProjectionE` `Prism`s for the `Exp` data type, whose+    corresponding data constructors were introduced in+    `template-haskell-2.18.*`.+  * `_TypedBracketE` and `_TypedSpliceE` `Prism`s for the `Exp` data type, whose+    corresponding data constructors were introduced in+    `template-haskell-2.21.*`.+  * `_BndrReq` and `_BndrInvis` `Prism`s for the `BndrVis` data type, which was+    added in `template-haskell-2.21.*`.+* Add a `generateRecordSyntax` option to `Control.Lens.TH`, which controls+  whether to generate lenses using record update syntax or not. By default, this+  option is disabled.+* Fix a bug in which the `declare*` Template Haskell functions would fail if a+  data type's field has a type that is defined in the same Template Haskell+  quotation.+* Add `altOf`, which collects targets into any `Alternative`.++5.2.2 [2023.03.18]+------------------+* Fix a bug in which calling `ix i` (where `i` is a negative number) on `Text`+  or `ByteString` would return the `Just` the first character instead of+  returning `Nothing`.++5.2.1 [2023.02.27]+------------------+* Allow building with GHC 9.6.+* Allow building with GHC backends where `HTYPE_SIG_ATOMIC_T` is not defined,+  such as the WASM backend.+* Support building with `th-abstraction-0.5.*`.+* Define `_TypeDataD` in `Language.Haskell.TH.Lens` when building with+  `template-haskell-2.20.0.0` (GHC 9.6) or later.+ 5.2 [2022.08.11] ---------------- * Allow building with GHC 9.4.
README.markdown view
@@ -9,7 +9,7 @@  The [FAQ](https://github.com/ekmett/lens/wiki/FAQ), which provides links to a large number of different resources for learning about lenses and an overview of the [derivation](https://github.com/ekmett/lens/wiki/Derivation) of these types can be found on the [Lens Wiki](https://github.com/ekmett/lens/wiki) along with a brief [overview](https://github.com/ekmett/lens/wiki/Overview) and some [examples](https://github.com/ekmett/lens/wiki/Examples). -Documentation is available through [github](http://ekmett.github.com/lens/frames.html) (for HEAD) or [hackage](http://hackage.haskell.org/package/lens) for the current and preceding releases.+Documentation is available through [github](https://ekmett.github.io/lens/frames.html) (for HEAD) or [hackage](http://hackage.haskell.org/package/lens) for the current and preceding releases.  Field Guide -----------
benchmarks/folds.hs view
@@ -31,6 +31,10 @@       [ bench "native"     $ nf (V.toList . V.indexed) v       , bench "itraversed" $ nf (itoListOf itraversed) v       ]+    , bgroup "sum"+      [ bench "native" $ whnf V.sum v+      , bench "each"   $ whnf (sumOf each) v+      ]     ]   , bgroup "unboxed-vector"     [ bgroup "toList"@@ -41,6 +45,10 @@       [ bench "native"     $ nf (U.toList . U.indexed) u       , bench "vTraverse" $ nf (itoListOf vectorTraverse) u       ]+    , bgroup "sum"+      [ bench "native" $ whnf U.sum u+      , bench "each"   $ whnf (sumOf each) u+      ]     ]   , bgroup "sequence"     [ bgroup "toList"@@ -71,6 +79,10 @@     , bgroup "itoList"       [ bench "native"     $ nf (zip [(0::Int)..]) l       , bench "itraversed" $ nf (itoListOf itraversed) l+      ]+    , bgroup "sum"+      [ bench "native" $ whnf sum l+      , bench "each"   $ whnf (sumOf each) l       ]     ]   , bgroup "map"
benchmarks/plated.hs view
@@ -4,13 +4,6 @@ {-# OPTIONS_GHC -funbox-strict-fields #-} module Main (main) where -#ifndef MIN_VERSION_base-#define MIN_VERSION_base(x,y,z) 1-#endif--import Prelude ()-import Prelude.Compat- import           Control.Lens import           Control.DeepSeq import           Criterion.Main
examples/lens-examples.cabal view
@@ -23,11 +23,17 @@              , GHC == 8.8.4              , GHC == 8.10.7              , GHC == 9.0.2-             , GHC == 9.2.2+             , GHC == 9.2.8+             , GHC == 9.4.8+             , GHC == 9.6.7+             , GHC == 9.8.4+             , GHC == 9.10.3+             , GHC == 9.12.2+             , GHC == 9.14.1  source-repository head   type: git-  location: git://github.com/ekmett/lens.git+  location: https://github.com/ekmett/lens.git  flag pong   default: True@@ -39,10 +45,9 @@     Turtle   build-depends:     aeson,-    base       >= 4.5      && < 5,-    bytestring >= 0.9.1.10 && < 0.12,+    base       >= 4.9      && < 5,+    bytestring >= 0.9.1.10 && < 0.13,     data-default-class,-    ghc-prim,     lens   default-language: Haskell2010   ghc-options: -Wall@@ -52,12 +57,12 @@     buildable: False    build-depends:-    base       >= 4.5   && < 5,-    containers >= 0.4   && < 0.7,+    base       >= 4.9   && < 5,+    containers >= 0.4   && < 0.9,     gloss      >= 1.12  && < 1.14,     lens,     mtl        >= 2.0.1 && < 2.4,-    random     >= 1.0   && < 1.3,+    random     >= 1.0   && < 1.4,     streams    >= 3.3   && < 4   main-is: Pong.hs   default-language: Haskell2010
lens-properties/lens-properties.cabal view
@@ -20,7 +20,13 @@              , GHC == 8.8.4              , GHC == 8.10.7              , GHC == 9.0.2-             , GHC == 9.2.2+             , GHC == 9.2.8+             , GHC == 9.4.8+             , GHC == 9.6.7+             , GHC == 9.8.4+             , GHC == 9.10.3+             , GHC == 9.12.2+             , GHC == 9.14.1  extra-source-files:   .hlint.yaml@@ -28,13 +34,13 @@  source-repository head   type: git-  location: git://github.com/ekmett/lens.git+  location: https://github.com/ekmett/lens.git  library   build-depends:     base         >= 4.9 && < 5,     lens         >= 4   && < 6,-    QuickCheck   >= 2.4 && < 2.15,+    QuickCheck   >= 2.4 && < 2.18,     transformers >= 0.2 && < 0.7    exposed-modules:
lens.cabal view
@@ -1,6 +1,6 @@ name:          lens category:      Data, Lenses, Generics-version:       5.2+version:       5.3.6 license:       BSD2 cabal-version: 1.18 license-file:  LICENSE@@ -19,7 +19,13 @@              , GHC == 8.8.4              , GHC == 8.10.7              , GHC == 9.0.2-             , GHC == 9.2.2+             , GHC == 9.2.8+             , GHC == 9.4.8+             , GHC == 9.6.7+             , GHC == 9.8.4+             , GHC == 9.10.3+             , GHC == 9.12.2+             , GHC == 9.14.1 synopsis:      Lenses, Folds and Traversals description:   This package comes \"Batteries Included\" with many useful lenses for the types@@ -32,7 +38,7 @@   .   An overview, with a large number of examples can be found in the <https://github.com/ekmett/lens#lens-lenses-folds-and-traversals README>.   .-  An introductory video on the style of code used in this library by Simon Peyton Jones is available from <http://skillsmatter.com/podcast/scala/lenses-compositional-data-access-and-manipulation Skills Matter>.+  An introductory video on the style of code used in this library by Simon Peyton Jones is available from <https://archive.org/details/lenses-compositional-data-access-and-manipulation-simon-peyton-jones-at-haskell- Internet Archive>.   .   A video on how to use lenses and how they are constructed is available on <http://youtu.be/cefnmjtAolY?hd=1 youtube>.   .@@ -48,9 +54,7 @@   With some signatures simplified, the core of the hierarchy of lens-like constructions looks like:   .   .-  <<http://i.imgur.com/ALlbPRa.png>>-  .-  <images/Hierarchy.png (Local Copy)>+  <<https://raw.githubusercontent.com/ekmett/lens/master/images/Hierarchy.png>>   .   You can compose any two elements of the hierarchy above using @(.)@ from the @Prelude@, and you can   use any element of the hierarchy as any type it linked to above it.@@ -171,37 +175,35 @@ library   build-depends:     array                         >= 0.5.0.0  && < 0.6,-    assoc                         >= 1.0.2    && < 1.1,+    assoc                         >= 1.0.2    && < 1.2,     base                          >= 4.9      && < 5,     base-orphans                  >= 0.5.2    && < 1,     bifunctors                    >= 5.5.7    && < 6,-    bytestring                    >= 0.10.4.0 && < 0.12,+    bytestring                    >= 0.10.4.0 && < 0.13,     call-stack                    >= 0.1      && < 0.5,     comonad                       >= 5.0.7    && < 6,-    containers                    >= 0.5.5.1  && < 0.7,+    containers                    >= 0.5.5.1  && < 0.9,     contravariant                 >= 1.4      && < 2,     distributive                  >= 0.5.1    && < 1,     exceptions                    >= 0.8.2.1  && < 1,-    filepath                      >= 1.2.0.0  && < 1.5,+    filepath                      >= 1.2.0.0  && < 1.6,     free                          >= 5.1.5    && < 6,-    ghc-prim,-    hashable                      >= 1.2.7.0  && < 1.5,+    hashable                      >= 1.2.7.0  && < 1.6,     indexed-traversable           >= 0.1      && < 0.2,     indexed-traversable-instances >= 0.1      && < 0.2,     kan-extensions                >= 5        && < 6,     mtl                           >= 2.2.1    && < 2.4,-    parallel                      >= 3.2.1.0  && < 3.3,+    parallel                      >= 3.2.1.0  && < 3.4,     profunctors                   >= 5.5.2    && < 6,     reflection                    >= 2.1      && < 3,-    semigroupoids                 >= 5.0.1    && < 6,-    strict                        >= 0.4      && < 0.5,+    semigroupoids                 >= 5.0.1    && < 7,+    strict                        >= 0.4      && < 0.6,     tagged                        >= 0.8.6    && < 1,-    template-haskell              >= 2.11.1.0 && < 2.20,-    text                          >= 1.2.3.0  && < 2.1,-    th-abstraction                >= 0.4.1    && < 0.5,-    these                         >= 1.1.1.1  && < 1.2,+    template-haskell              >= 2.11.1.0 && < 2.25,+    text                          >= 1.2.3.0  && < 2.2,+    th-abstraction                >= 0.4.1    && < 0.8,+    these                         >= 1.1.1.1  && < 1.3,     transformers                  >= 0.5.0.0  && < 0.7,-    transformers-compat           >= 0.5.0.4  && < 1,     unordered-containers          >= 0.2.10   && < 0.3,     vector                        >= 0.12.1.2 && < 0.14 @@ -227,6 +229,7 @@     Control.Lens.Internal.Context     Control.Lens.Internal.CTypes     Control.Lens.Internal.Deque+    Control.Lens.Internal.Doctest     Control.Lens.Internal.Exception     Control.Lens.Internal.FieldTH     Control.Lens.Internal.PrismTH@@ -324,9 +327,13 @@   type: exitcode-stdio-1.0   main-is: templates.hs   other-modules:+    BigRecord     T799     T917     T972+  if impl(ghc >= 9.2)+    other-modules:+      T1024   ghc-options: -Wall -threaded   hs-source-dirs: tests   default-language: Haskell2010@@ -357,9 +364,9 @@     build-depends:       base,       lens,-      QuickCheck                 >= 2.4,-      test-framework             >= 0.6,-      test-framework-quickcheck2 >= 0.2,+      QuickCheck >= 2.4,+      tasty >= 1.4 && < 1.6,+      tasty-quickcheck >= 0.10 && < 0.12,       transformers  test-suite hunit@@ -375,11 +382,12 @@     build-depends:       base,       containers,-      HUnit >= 1.2,       lens,       mtl,-      test-framework       >= 0.6,-      test-framework-hunit >= 0.2+      text,+      bytestring,+      tasty >= 1.4 && < 1.6,+      tasty-hunit >= 0.10 && < 0.11  -- We need this dummy test-suite to add simple-reflect to the install plan --@@ -391,7 +399,7 @@   hs-source-dirs:    tests   default-language:  Haskell2010 -  build-depends: base, deepseq, simple-reflect >= 0.3.1+  build-depends: base <5, deepseq, simple-reflect >= 0.3.1  -- Basic benchmarks for the uniplate-style combinators benchmark plated@@ -402,7 +410,6 @@   default-language: Haskell2010   build-depends:     base,-    base-compat >=0.11.0 && <0.13,     comonad,     criterion,     deepseq,
src/Control/Exception/Lens.hs view
@@ -29,7 +29,7 @@ -- be found in "System.IO.Error.Lens". -- -- The combinators in this module have been generalized to work with--- 'MonadCatch' instead of just 'IO'. This enables them to be used+-- 'MonadCatch' instead of just 'Prelude.IO'. This enables them to be used -- more easily in 'Monad' transformer stacks. ---------------------------------------------------------------------------- module Control.Exception.Lens@@ -166,21 +166,27 @@   , Bool(..)   ) --- $setup--- >>> :set -XNoOverloadedStrings--- >>> import Control.Lens--- >>> import Control.Applicative--- >>> :m + Control.Exception Control.Monad Data.List Prelude+{-+$setup+>>> :set -XNoOverloadedStrings+>>> :set -XScopedTypeVariables+>>> import Control.Lens+>>> import Control.Applicative+>>> :m + Control.Exception Control.Monad Data.List Prelude+#if MIN_VERSION_base(4,20,0)+>>> :m + Control.Exception.Context+#endif+-}  ------------------------------------------------------------------------------ -- Exceptions as Prisms ------------------------------------------------------------------------------ --- | Traverse the strongly typed 'Exception' contained in 'SomeException' where the type of your function matches--- the desired 'Exception'.+-- | Traverse the strongly typed t'Exception' contained in 'SomeException' where the type of your function matches+-- the desired t'Exception'. -- -- @--- 'exception' :: ('Applicative' f, 'Exception' a)+-- 'exception' :: ('Applicative' f, t'Exception' a) --           => (a -> f a) -> 'SomeException' -> f 'SomeException' -- @ exception :: Exception a => Prism' SomeException a@@ -195,7 +201,7 @@ -- Catching ------------------------------------------------------------------------------ --- | Catch exceptions that match a given 'Prism' (or any 'Fold', really).+-- | Catch exceptions that match a given t'Prism' (or any t'Fold', really). -- -- >>> catching _AssertionFailed (assert False (return "uncaught")) $ \ _ -> return "caught" -- "caught"@@ -205,16 +211,16 @@ -- 'catching' :: 'MonadCatch' m => 'Lens'' 'SomeException' a      -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadCatch' m => 'Iso'' 'SomeException' a       -> m r -> (a -> m r) -> m r--- 'catching' :: 'MonadCatch' m => 'Getter' 'SomeException' a     -> m r -> (a -> m r) -> m r--- 'catching' :: 'MonadCatch' m => 'Fold' 'SomeException' a       -> m r -> (a -> m r) -> m r+-- 'catching' :: 'MonadCatch' m => t'Getter' 'SomeException' a    -> m r -> (a -> m r) -> m r+-- 'catching' :: 'MonadCatch' m => t'Fold' 'SomeException' a      -> m r -> (a -> m r) -> m r -- @ catching :: MonadCatch m => Getting (First a) SomeException a -> m r -> (a -> m r) -> m r catching l = catchJust (preview l) {-# INLINE catching #-} --- | Catch exceptions that match a given 'Prism' (or any 'Getter'), discarding+-- | Catch exceptions that match a given t'Prism' (or any t'Getter'), discarding -- the information about the match. This is particularly useful when you have--- a @'Prism'' e ()@ where the result of the 'Prism' or 'Fold' isn't+-- a @'Prism'' e ()@ where the result of the t'Prism' or t'Fold' isn't -- particularly valuable, just the fact that it matches. -- -- >>> catching_ _AssertionFailed (assert False (return "uncaught")) $ return "caught"@@ -225,8 +231,8 @@ -- 'catching_' :: 'MonadCatch' m => 'Lens'' 'SomeException' a      -> m r -> m r -> m r -- 'catching_' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> m r -> m r -> m r -- 'catching_' :: 'MonadCatch' m => 'Iso'' 'SomeException' a       -> m r -> m r -> m r--- 'catching_' :: 'MonadCatch' m => 'Getter' 'SomeException' a     -> m r -> m r -> m r--- 'catching_' :: 'MonadCatch' m => 'Fold' 'SomeException' a       -> m r -> m r -> m r+-- 'catching_' :: 'MonadCatch' m => t'Getter' 'SomeException' a    -> m r -> m r -> m r+-- 'catching_' :: 'MonadCatch' m => t'Fold' 'SomeException' a      -> m r -> m r -> m r -- @ catching_ :: MonadCatch m => Getting (First a) SomeException a -> m r -> m r -> m r catching_ l a b = catchJust (preview l) a (const b)@@ -247,8 +253,8 @@ -- 'handling' :: 'MonadCatch' m => 'Lens'' 'SomeException' a      -> (a -> m r) -> m r -> m r -- 'handling' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> (a -> m r) -> m r -> m r -- 'handling' :: 'MonadCatch' m => 'Iso'' 'SomeException' a       -> (a -> m r) -> m r -> m r--- 'handling' :: 'MonadCatch' m => 'Fold' 'SomeException' a       -> (a -> m r) -> m r -> m r--- 'handling' :: 'MonadCatch' m => 'Getter' 'SomeException' a     -> (a -> m r) -> m r -> m r+-- 'handling' :: 'MonadCatch' m => t'Fold' 'SomeException' a      -> (a -> m r) -> m r -> m r+-- 'handling' :: 'MonadCatch' m => t'Getter' 'SomeException' a    -> (a -> m r) -> m r -> m r -- @ handling :: MonadCatch m => Getting (First a) SomeException a -> (a -> m r) -> m r -> m r handling l = flip (catching l)@@ -265,8 +271,8 @@ -- 'handling_' :: 'MonadCatch' m => 'Lens'' 'SomeException' a      -> m r -> m r -> m r -- 'handling_' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> m r -> m r -> m r -- 'handling_' :: 'MonadCatch' m => 'Iso'' 'SomeException' a       -> m r -> m r -> m r--- 'handling_' :: 'MonadCatch' m => 'Getter' 'SomeException' a     -> m r -> m r -> m r--- 'handling_' :: 'MonadCatch' m => 'Fold' 'SomeException' a       -> m r -> m r -> m r+-- 'handling_' :: 'MonadCatch' m => t'Getter' 'SomeException' a    -> m r -> m r -> m r+-- 'handling_' :: 'MonadCatch' m => t'Fold' 'SomeException' a      -> m r -> m r -> m r -- @ handling_ :: MonadCatch m => Getting (First a) SomeException a -> m r -> m r -> m r handling_ l = flip (catching_ l)@@ -276,17 +282,17 @@ -- Trying ------------------------------------------------------------------------------ --- | A variant of 'Control.Exception.try' that takes a 'Prism' (or any 'Fold') to select which+-- | A variant of 'Control.Exception.try' that takes a t'Prism' (or any t'Fold') to select which -- exceptions are caught (c.f. 'Control.Exception.tryJust', 'Control.Exception.catchJust'). If the--- 'Exception' does not match the predicate, it is re-thrown.+-- t'Exception' does not match the predicate, it is re-thrown. -- -- @ -- 'trying' :: 'MonadCatch' m => 'Prism''     'SomeException' a -> m r -> m ('Either' a r) -- 'trying' :: 'MonadCatch' m => 'Lens''      'SomeException' a -> m r -> m ('Either' a r) -- 'trying' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> m r -> m ('Either' a r) -- 'trying' :: 'MonadCatch' m => 'Iso''       'SomeException' a -> m r -> m ('Either' a r)--- 'trying' :: 'MonadCatch' m => 'Getter'     'SomeException' a -> m r -> m ('Either' a r)--- 'trying' :: 'MonadCatch' m => 'Fold'       'SomeException' a -> m r -> m ('Either' a r)+-- 'trying' :: 'MonadCatch' m => t'Getter'    'SomeException' a -> m r -> m ('Either' a r)+-- 'trying' :: 'MonadCatch' m => t'Fold'      'SomeException' a -> m r -> m ('Either' a r) -- @ trying :: MonadCatch m => Getting (First a) SomeException a -> m r -> m (Either a r) trying l = tryJust (preview l)@@ -299,8 +305,8 @@ -- 'trying_' :: 'MonadCatch' m => 'Lens''      'SomeException' a -> m r -> m (Maybe r) -- 'trying_' :: 'MonadCatch' m => 'Traversal'' 'SomeException' a -> m r -> m (Maybe r) -- 'trying_' :: 'MonadCatch' m => 'Iso''       'SomeException' a -> m r -> m (Maybe r)--- 'trying_' :: 'MonadCatch' m => 'Getter'     'SomeException' a -> m r -> m (Maybe r)--- 'trying_' :: 'MonadCatch' m => 'Fold'       'SomeException' a -> m r -> m (Maybe r)+-- 'trying_' :: 'MonadCatch' m => t'Getter'    'SomeException' a -> m r -> m (Maybe r)+-- 'trying_' :: 'MonadCatch' m => t'Fold'      'SomeException' a -> m r -> m (Maybe r) -- @ trying_ :: MonadCatch m => Getting (First a) SomeException a -> m r -> m (Maybe r) trying_ l m = preview _Right `liftM` trying l m@@ -310,8 +316,8 @@ -- Throwing ------------------------------------------------------------------------------ --- | Throw an 'Exception' described by a 'Prism'. Exceptions may be thrown from--- purely functional code, but may only be caught within the 'IO' 'Monad'.+-- | Throw an t'Exception' described by a t'Prism'. Exceptions may be thrown from+-- purely functional code, but may only be caught within the 'Prelude.IO' 'Monad'. -- -- @ -- 'throwing' l ≡ 'reviews' l 'throw'@@ -331,15 +337,15 @@ -- @ -- data MyError = Foo | Bar -- makePrisms ''MyError--- 'throwing_' _Foo :: 'MonadError' MyError m => m a+-- 'throwing_' _Foo :: 'Control.Monad.Error.Class.MonadError' MyError m => m a -- @ throwing_ :: AReview SomeException () -> m x throwing_ l = throwing l () {-# INLINE throwing_ #-} --- | A variant of 'throwing' that can only be used within the 'IO' 'Monad'--- (or any other 'MonadCatch' instance) to throw an 'Exception' described--- by a 'Prism'.+-- | A variant of 'throwing' that can only be used within the 'Prelude.IO' 'Monad'+-- (or any other 'MonadCatch' instance) to throw an t'Exception' described+-- by a t'Prism'. -- -- Although 'throwingM' has a type that is a specialization of the type of -- 'throwing', the two functions are subtly different:@@ -349,10 +355,10 @@ -- 'throwingM' l e \`seq\` x ≡ x -- @ ----- The first example will cause the 'Exception' @e@ to be raised, whereas the--- second one won't. In fact, 'throwingM' will only cause an 'Exception' to+-- The first example will cause the t'Exception' @e@ to be raised, whereas the+-- second one won't. In fact, 'throwingM' will only cause an t'Exception' to -- be raised when it is used within the 'MonadCatch' instance. The 'throwingM'--- variant should be used in preference to 'throwing' to raise an 'Exception'+-- variant should be used in preference to 'throwing' to raise an t'Exception' -- within the 'Monad' because it guarantees ordering with respect to other -- monadic operations, whereas 'throwing' does not. --@@ -368,7 +374,7 @@ throwingM l = reviews l throwM {-# INLINE throwingM #-} --- | 'throwingTo' raises an 'Exception' specified by a 'Prism' in the target thread.+-- | 'throwingTo' raises an t'Exception' specified by a t'Prism' in the target thread. -- -- @ -- 'throwingTo' thread l ≡ 'reviews' l ('throwTo' thread)@@ -386,14 +392,14 @@ -- Mapping ---------------------------------------------------------------------------- --- | This 'Setter' can be used to purely map over the 'Exception's an+-- | This t'Setter' can be used to purely map over the t'Exception's an -- arbitrary expression might throw; it is a variant of 'mapException' in -- the same way that 'mapped' is a variant of 'fmap'. -- -- > 'mapException' ≡ 'over' 'mappedException' -- -- This view that every Haskell expression can be regarded as carrying a bag--- of 'Exception's is detailed in “A Semantics for Imprecise Exceptions” by+-- of t'Exception's is detailed in “A Semantics for Imprecise Exceptions” by -- Peyton Jones & al. at PLDI ’99. -- -- The following maps failed assertions to arithmetic overflow:@@ -405,7 +411,7 @@ {-# INLINE mappedException #-}  -- | This is a type restricted version of 'mappedException', which avoids--- the type ambiguity in the input 'Exception' when using 'set'.+-- the type ambiguity in the input t'Exception' when using 'set'. -- -- The following maps any exception to arithmetic overflow: --@@ -419,14 +425,14 @@ -- IOException ---------------------------------------------------------------------------- --- | Exceptions that occur in the 'IO' 'Monad'. An 'IOException' records a+-- | Exceptions that occur in the 'Prelude.IO' 'Monad'. An 'IOException' records a -- more specific error type, a descriptive string and maybe the handle that was -- used when the error was flagged. -- -- Due to their richer structure relative to other exceptions, these have -- a more carefully overloaded signature. class AsIOException t where-  -- | Unfortunately the name 'ioException' is taken by @base@ for+  -- | Unfortunately the name 'GHC.IO.Exception.ioException' is taken by @base@ for   -- throwing IOExceptions.   --   -- @@@ -674,15 +680,21 @@   -- @   __AssertionFailed :: Prism' t AssertionFailed -  -- | This 'Exception' contains provides information about what assertion failed in the 'String'.-  --+  {- | This t'Exception' contains provides information about what assertion failed in the 'String'.++  @+  '_AssertionFailed' :: 'Prism'' 'AssertionFailed' 'String'+  '_AssertionFailed' :: 'Prism'' 'SomeException'   'String'+  @++#if MIN_VERSION_base(4,20,0)+  >>> handling exception (\ (ExceptionWithContext ctxt (_ :: AssertionFailed)) -> "caught" <$ guard ("<interactive>" `isInfixOf` displayExceptionContext ctxt) ) $ assert False (return "uncaught")+  "caught"+#else   -- >>> handling _AssertionFailed (\ xs -> "caught" <$ guard ("<interactive>" `isInfixOf` xs) ) $ assert False (return "uncaught")   -- "caught"-  ---  -- @-  -- '_AssertionFailed' :: 'Prism'' 'AssertionFailed' 'String'-  -- '_AssertionFailed' :: 'Prism'' 'SomeException'   'String'-  -- @+#endif+  -}   _AssertionFailed :: Prism' t String   _AssertionFailed = __AssertionFailed._AssertionFailed   {-# INLINE _AssertionFailed #-}@@ -732,7 +744,7 @@ pattern AsyncException_ e <- (preview _AsyncException -> Just e) where   AsyncException_ e = review _AsyncException e --- | The current thread's stack exceeded its limit. Since an 'Exception' has+-- | The current thread's stack exceeded its limit. Since an t'Exception' has -- been raised, the thread's stack will certainly be below its limit again, -- but the programmer should take remedial action immediately. --@@ -755,7 +767,7 @@ -- -- Notes: ----- * It is undefined which thread receives this 'Exception'.+-- * It is undefined which thread receives this t'Exception'. -- -- * GHC currently does not throw 'HeapOverflow' exceptions. --@@ -773,7 +785,7 @@ pattern HeapOverflow_ <- (has _HeapOverflow -> True) where   HeapOverflow_ = review _HeapOverflow () --- | This 'Exception' is raised by another thread calling+-- | This t'Exception' is raised by another thread calling -- 'Control.Concurrent.killThread', or by the system if it needs to terminate -- the thread for some reason. --@@ -791,7 +803,7 @@ pattern ThreadKilled_ <- (has _ThreadKilled -> True) where   ThreadKilled_ = review _ThreadKilled () --- | This 'Exception' is raised by default in the main thread of the program when+-- | This t'Exception' is raised by default in the main thread of the program when -- the user requests to terminate the program via the usual mechanism(s) -- (/e.g./ Control-C in the console). --@@ -824,7 +836,7 @@   -- @   __NonTermination :: Prism' t NonTermination -  -- | There is no additional information carried in a 'NonTermination' 'Exception'.+  -- | There is no additional information carried in a 'NonTermination' t'Exception'.   --   -- @   -- '_NonTermination' :: 'Prism'' 'NonTermination' ()@@ -867,7 +879,7 @@   -- @   __NestedAtomically :: Prism' t NestedAtomically -  -- | There is no additional information carried in a 'NestedAtomically' 'Exception'.+  -- | There is no additional information carried in a 'NestedAtomically' t'Exception'.   --   -- @   -- '_NestedAtomically' :: 'Prism'' 'NestedAtomically' ()@@ -911,7 +923,7 @@   -- @   __BlockedIndefinitelyOnMVar :: Prism' t BlockedIndefinitelyOnMVar -  -- | There is no additional information carried in a 'BlockedIndefinitelyOnMVar' 'Exception'.+  -- | There is no additional information carried in a 'BlockedIndefinitelyOnMVar' t'Exception'.   --   -- @   -- '_BlockedIndefinitelyOnMVar' :: 'Prism'' 'BlockedIndefinitelyOnMVar' ()@@ -955,7 +967,7 @@   -- @   __BlockedIndefinitelyOnSTM :: Prism' t BlockedIndefinitelyOnSTM -  -- | There is no additional information carried in a 'BlockedIndefinitelyOnSTM' 'Exception'.+  -- | There is no additional information carried in a 'BlockedIndefinitelyOnSTM' t'Exception'.   --   -- @   -- '_BlockedIndefinitelyOnSTM' :: 'Prism'' 'BlockedIndefinitelyOnSTM' ()@@ -989,7 +1001,7 @@ ----------------------------------------------------------------------------  -- | There are no runnable threads, so the program is deadlocked. The--- 'Deadlock' 'Exception' is raised in the main thread only.+-- 'Deadlock' t'Exception' is raised in the main thread only. class AsDeadlock t where   -- |   -- @@@ -998,7 +1010,7 @@   -- @   __Deadlock :: Prism' t Deadlock -  -- | There is no information carried in a 'Deadlock' 'Exception'.+  -- | There is no information carried in a 'Deadlock' t'Exception'.   --   -- @   -- '_Deadlock' :: 'Prism'' 'Deadlock'      ()@@ -1304,7 +1316,7 @@   __AllocationLimitExceeded :: Prism' t AllocationLimitExceeded    -- | There is no additional information carried in an-  -- 'AllocationLimitExceeded' 'Exception'.+  -- 'AllocationLimitExceeded' t'Exception'.   --   -- @   -- '_AllocationLimitExceeded' :: 'Prism'' 'AllocationLimitExceeded' ()@@ -1425,7 +1437,7 @@ -- HandlingException ------------------------------------------------------------------------------ --- | This 'Exception' is thrown by @lens@ when the user somehow manages to rethrow+-- | This t'Exception' is thrown by @lens@ when the user somehow manages to rethrow -- an internal 'HandlingException'. class AsHandlingException t where   -- |@@ -1470,4 +1482,3 @@  trivial :: t -> Iso' t () trivial t = const () `iso` const t-
src/Control/Lens.hs view
@@ -14,7 +14,7 @@ -- -- @ -- import Control.Lens--- +-- -- data FooBar a --   = Foo { _x :: ['Int'], _y :: a } --   | Bar { _x :: ['Int'] }@@ -25,7 +25,7 @@ -- -- @ -- x :: 'Lens'' (FooBar a) ['Int']--- y :: 'Traversal' (FooBar a) (FooBar b) a b+-- y :: t'Traversal' (FooBar a) (FooBar b) a b -- @ -- -- You can then access the value of @_x@ with ('^.'), the value of @_y@ –
src/Control/Lens/At.hs view
@@ -85,6 +85,9 @@ import qualified Data.Vector.Storable as Storable import qualified Data.Vector.Unboxed as Unboxed import Data.Vector.Unboxed (Unbox)+#if MIN_VERSION_vector(0,13,2)+import qualified Data.Vector.Strict as VectorStrict+#endif import Data.Word import Foreign.Storable (Storable) @@ -113,6 +116,9 @@ type instance Index (Prim.Vector a) = Int type instance Index (Storable.Vector a) = Int type instance Index (Unboxed.Vector a) = Int+#if MIN_VERSION_vector(0,13,2)+type instance Index (VectorStrict.Vector a) = Int+#endif type instance Index (Complex a) = Int type instance Index (Identity a) = () type instance Index (Maybe a) = ()@@ -396,37 +402,54 @@     | otherwise                      = pure v   {-# INLINE ix #-} +#if MIN_VERSION_vector(0,13,2)+type instance IxValue (VectorStrict.Vector a) = a+instance Ixed (VectorStrict.Vector a) where+  ix i f v+    | 0 <= i && i < VectorStrict.length v = f (v VectorStrict.! i) <&> \a -> v VectorStrict.// [(i, a)]+    | otherwise                           = pure v+  {-# INLINE ix #-}+#endif+ type instance IxValue StrictT.Text = Char instance Ixed StrictT.Text where-  ix e f s = case StrictT.splitAt e s of-     (l, mr) -> case StrictT.uncons mr of-       Nothing      -> pure s-       Just (c, xs) -> f c <&> \d -> StrictT.concat [l, StrictT.singleton d, xs]+  ix e f s +      | e < 0 = pure s+      | otherwise = case StrictT.splitAt e s of+            (l, mr) -> case StrictT.uncons mr of+                Nothing      -> pure s+                Just (c, xs) -> f c <&> \d -> StrictT.concat [l, StrictT.singleton d, xs]   {-# INLINE ix #-}  type instance IxValue LazyT.Text = Char instance Ixed LazyT.Text where-  ix e f s = case LazyT.splitAt e s of-     (l, mr) -> case LazyT.uncons mr of-       Nothing      -> pure s-       Just (c, xs) -> f c <&> \d -> LazyT.append l (LazyT.cons d xs)+  ix e f s +        | e < 0 = pure s+        | otherwise = case LazyT.splitAt e s of+            (l, mr) -> case LazyT.uncons mr of+              Nothing      -> pure s+              Just (c, xs) -> f c <&> \d -> LazyT.append l (LazyT.cons d xs)   {-# INLINE ix #-}  type instance IxValue StrictB.ByteString = Word8 instance Ixed StrictB.ByteString where-  ix e f s = case StrictB.splitAt e s of-     (l, mr) -> case StrictB.uncons mr of-       Nothing      -> pure s-       Just (c, xs) -> f c <&> \d -> StrictB.concat [l, StrictB.singleton d, xs]+  ix e f s +        | e < 0 = pure s+        | otherwise = case StrictB.splitAt e s of+          (l, mr) -> case StrictB.uncons mr of+            Nothing      -> pure s+            Just (c, xs) -> f c <&> \d -> StrictB.concat [l, StrictB.singleton d, xs]   {-# INLINE ix #-}  type instance IxValue LazyB.ByteString = Word8 instance Ixed LazyB.ByteString where   -- TODO: we could be lazier, returning each chunk as it is passed-  ix e f s = case LazyB.splitAt e s of-     (l, mr) -> case LazyB.uncons mr of-       Nothing      -> pure s-       Just (c, xs) -> f c <&> \d -> LazyB.append l (LazyB.cons d xs)+  ix e f s +        | e < 0 = pure s+        | otherwise =  case LazyB.splitAt e s of+          (l, mr) -> case LazyB.uncons mr of+            Nothing      -> pure s+            Just (c, xs) -> f c <&> \d -> LazyB.append l (LazyB.cons d xs)   {-# INLINE ix #-}
src/Control/Lens/Combinators.hs view
@@ -139,6 +139,18 @@   , (<?=)   , (<>~)   , (<>=)+  , (<>:~)+  , (<>:=)+  , (<<>:~)+  , (<<>:=)+  , (<|~)+  , (<|=)+  , (<<|~)+  , (<<|=)+  , (|>~)+  , (|>=)+  , (<|>~)+  , (<|>=)   , (%@~)   , (%@=)   , (:>)
src/Control/Lens/Cons.hs view
@@ -27,6 +27,7 @@   , cons   , uncons   , _head, _tail+  , (<|~), (<|=), (<<|~), (<<|=), (<<<|~), (<<<|=)   , pattern (:<)   -- * Snoc   , Snoc(..)@@ -34,14 +35,17 @@   , snoc   , unsnoc   , _init, _last+  , (|>~), (|>=), (<|>~), (<|>=), (<<|>~), (<<|>=)   , pattern (:>)    ) where  import Control.Lens.Equality (simply) import Control.Lens.Fold+import Control.Lens.Lens import Control.Lens.Prism import Control.Lens.Review+import Control.Lens.Setter import Control.Lens.Tuple import Control.Lens.Type import qualified Data.ByteString      as StrictB@@ -60,8 +64,12 @@ import qualified Data.Vector.Primitive as Prim import           Data.Vector.Unboxed (Unbox) import qualified Data.Vector.Unboxed as Unbox+#if MIN_VERSION_vector(0,13,2)+import qualified Data.Vector.Strict as VectorStrict+#endif import           Data.Word import           Control.Applicative (ZipList(..))+import           Control.Monad.State.Class as State import           Prelude  -- $setup@@ -77,6 +85,8 @@  infixr 5 <|, `cons` infixl 5 |>, `snoc`+infixr 4 <|~, |>~, <<|~, <|>~, <<<|~, <<|>~+infix  4 <|=, |>=, <<|=, <|>=, <<<|=, <<|>=  pattern (:<) :: Cons b b a a => a -> b -> b pattern (:<) a s <- (preview _Cons -> Just (a,s)) where@@ -173,6 +183,15 @@     else Right (Unbox.unsafeHead v, Unbox.unsafeTail v)   {-# INLINE _Cons #-} +#if MIN_VERSION_vector(0,13,2)+instance Cons (VectorStrict.Vector a) (VectorStrict.Vector b) a b where+  _Cons = prism (uncurry VectorStrict.cons) $ \v ->+    if VectorStrict.null v+    then Left VectorStrict.empty+    else Right (VectorStrict.unsafeHead v, VectorStrict.unsafeTail v)+  {-# INLINE _Cons #-}+#endif+ -- | 'cons' an element onto a container. -- -- This is an infix alias for 'cons'.@@ -323,6 +342,49 @@ _tail = _Cons._2 {-# INLINE _tail #-} +-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' using @('<|')@.+--+-- >>> (["world"], ["lens"]) & _1 <|~ "hello"+-- (["hello","world"],["lens"])+(<|~) :: Cons b b a a => ASetter s t b b -> a -> s -> t+l <|~ n = over l (n <|)+{-# INLINE (<|~) #-}++-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' using @('<|')@.+(<|=) :: (MonadState s m, Cons b b a a) => ASetter s s b b -> a -> m ()+l <|= a = State.modify (l <|~ a)+{-# INLINE (<|=) #-}++-- | ('<|') a value onto the target of a 'Lens' and return the result.+--+-- When you do not need the result of the operation, ('Control.Lens.Cons.<|~') is more flexible.+(<<|~) :: Cons b b a a => LensLike ((,) b) s t b b -> a -> s -> (b, t)+l <<|~ m = l <%~ (m <|)+{-# INLINE (<<|~) #-}++-- | ('<|') a value onto the target of a 'Lens' and return the /old/ result.+--+-- When you do not need the result of the operation, ('Control.Lens.Cons.<|~') is more flexible.+(<<<|~) :: Cons b b a a => LensLike' ((,) b) s b -> a -> s -> (b, s)+l <<<|~ m = l <<%~ (m <|)+{-# INLINE (<<<|~) #-}++-- | ('<|') a value onto the target of a 'Lens' into your 'Monad'\'s state and+-- return the result.+--+-- When you do not need the result of the operation, ('Control.Lens.Cons.<|=') is more flexible.+(<<|=) :: (MonadState s m, Cons b b a a) => LensLike ((,) b) s s b b -> a -> m b+l <<|= r = l <%= (r <|)+{-# INLINE (<<|=) #-}++-- | ('<|') a value onto the target of a 'Lens' into your 'Monad'\'s state and+-- return the /old/ result.+--+-- When you do not need the result of the operation, ('Control.Lens.Cons.<|=') is more flexible.+(<<<|=) :: (MonadState s m, Cons b b a a) => LensLike ((,) b) s s b b -> a -> m b+l <<<|= r = l <<%= (r <|)+{-# INLINE (<<<|=) #-}+ ------------------------------------------------------------------------------ -- Snoc ------------------------------------------------------------------------------@@ -492,7 +554,7 @@ _last = _Snoc._2 {-# INLINE _last #-} --- | 'snoc' an element onto the end of a container.+-- | 'snoc' an element onto a container. -- -- This is an infix alias for 'snoc'. --@@ -508,7 +570,7 @@ (|>) = curry (simply review _Snoc) {-# INLINE (|>) #-} --- | 'snoc' an element onto the end of a container.+-- | 'snoc' an element onto a container. -- -- >>> snoc (Seq.fromList []) a -- fromList [a]@@ -538,3 +600,46 @@ unsnoc :: Snoc s s a a => s -> Maybe (s, a) unsnoc = simply preview _Snoc {-# INLINE unsnoc #-}++-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' using @('|>')@.+--+-- >>> (["world"], ["lens"]) & _1 |>~ "hello"+-- (["world","hello"],["lens"])+(|>~) :: Snoc b b a a => ASetter s t b b -> a -> s -> t+l |>~ n = over l (|> n)+{-# INLINE (|>~) #-}++-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' using @('|>')@.+(|>=) :: (MonadState s m, Snoc b b a a) => ASetter s s b b -> a -> m ()+l |>= a = State.modify (l |>~ a)+{-# INLINE (|>=) #-}++-- | ('|>') a value onto the target of a 'Lens' and return the result.+--+-- When you do not need the result of the operation, ('Control.Lens.Cons.|>~') is more flexible.+(<|>~) :: Snoc b b p p => LensLike ((,) b) s t b b -> p -> s -> (b, t)+l <|>~ m = l <%~ (|> m)+{-# INLINE (<|>~) #-}++-- | ('|>') a value onto the target of a 'Lens' and return the /old/ result.+--+-- When you do not need the result of the operation, ('Control.Lens.Cons.|>~') is more flexible.+(<<|>~) :: Snoc b b p p => LensLike' ((,) b) s b -> p -> s -> (b, s)+l <<|>~ m = l <<%~ (|> m)+{-# INLINE (<<|>~) #-}++-- | ('|>') a value onto the target of a 'Lens' into your 'Monad'\'s state and+-- return the result.+--+-- When you do not need the result of the operation, ('Control.Lens.Cons.|>=') is more flexible.+(<|>=) :: (MonadState s m, Snoc b b p p) => LensLike ((,) b) s s b b -> p -> m b+l <|>= r = l <%= (|> r)+{-# INLINE (<|>=) #-}++-- | ('|>') a value onto the target of a 'Lens' into your 'Monad'\'s state and+-- return the /old/ result.+--+-- When you do not need the result of the operation, ('Control.Lens.Cons.|>=') is more flexible.+(<<|>=) :: (MonadState s m, Snoc b b p p) => LensLike ((,) b) s s b b -> p -> m b+l <<|>= r = l <<%= (|> r)+{-# INLINE (<<|>=) #-}
src/Control/Lens/Each.hs view
@@ -54,6 +54,9 @@ import qualified Data.Vector.Storable as Storable import Data.Vector.Storable (Storable) import qualified Data.Vector.Unboxed as Unboxed+#if MIN_VERSION_vector(0,13,2)+import qualified Data.Vector.Strict as VectorStrict+#endif import Data.Vector.Unboxed (Unbox) import Data.Word import qualified Data.Strict as S@@ -194,6 +197,13 @@ instance (Unbox a, Unbox b) => Each (Unboxed.Vector a) (Unboxed.Vector b) a b where   each = vectorTraverse   {-# INLINE each #-}++#if MIN_VERSION_vector(0,13,2)+-- | @'each' :: 'Traversal' ('Vector.Vector' a) ('Vector.Vector' b) a b@+instance Each (VectorStrict.Vector a) (VectorStrict.Vector b) a b where+  each = vectorTraverse+  {-# INLINE each #-}+#endif  -- | @'each' :: 'Traversal' 'StrictT.Text' 'StrictT.Text' 'Char' 'Char'@ instance (a ~ Char, b ~ Char) => Each StrictT.Text StrictT.Text a b where
src/Control/Lens/Empty.hs view
@@ -53,6 +53,10 @@ import qualified Data.Vector.Unboxed as Unboxed import Data.Vector.Unboxed (Unbox) import qualified Data.Vector.Storable as Storable+import qualified Data.Vector.Primitive as Prim+#if MIN_VERSION_vector(0,13,2)+import qualified Data.Vector.Strict as VectorStrict+#endif import Foreign.Storable (Storable)  #if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS)@@ -161,9 +165,19 @@   _Empty = nearly Unboxed.empty Unboxed.null   {-# INLINE _Empty #-} +instance Prim.Prim a => AsEmpty (Prim.Vector a) where+  _Empty = nearly Prim.empty Prim.null+  {-# INLINE _Empty #-}+ instance Storable a => AsEmpty (Storable.Vector a) where   _Empty = nearly Storable.empty Storable.null   {-# INLINE _Empty #-}++#if MIN_VERSION_vector(0,13,2)+instance AsEmpty (VectorStrict.Vector a) where+  _Empty = nearly VectorStrict.empty VectorStrict.null+  {-# INLINE _Empty #-}+#endif  instance AsEmpty (Seq.Seq a) where   _Empty = nearly Seq.empty Seq.null
src/Control/Lens/Equality.hs view
@@ -3,9 +3,14 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeInType #-} {-# LANGUAGE Trustworthy #-} +#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE PolyKinds #-}+#else+{-# LANGUAGE TypeInType #-}+#endif+ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Equality@@ -144,8 +149,6 @@ -- -- @fromLeibniz' :: (forall f. f s -> f a) -> Equality' s a@ fromLeibniz' :: (s :~: s -> s :~: a) -> Equality' s a--- Note: even though its type signature mentions (:~:), this function works just--- fine in base versions before 4.7.0; it just requires a polymorphic argument! fromLeibniz' f = case f Refl of Refl -> id {-# INLINE fromLeibniz' #-}
src/Control/Lens/Extras.hs view
@@ -22,7 +22,7 @@ -- >>> import Control.Lens -- >>> import Numeric.Lens (hex) --- | Check to see if this 'Prism' matches.+-- | Check to see if this t'Prism' matches. -- -- >>> is _Left (Right 12) -- False
src/Control/Lens/Fold.hs view
@@ -74,6 +74,7 @@   , foldMapOf, foldOf   , foldrOf, foldlOf   , toListOf, toNonEmptyOf+  , altOf   , anyOf, allOf, noneOf   , andOf, orOf   , productOf, sumOf@@ -162,7 +163,7 @@ import Data.Int (Int64) import Data.List (intercalate) import Data.Maybe (fromMaybe)-import Data.Monoid (First (..), All (..), Any (..))+import Data.Monoid (First (..), All (..), Alt (..), Any (..)) import Data.Reflection  import qualified Data.Semigroup as Semi@@ -196,8 +197,8 @@ -- -- This can be useful to lift operations from @Data.List@ and elsewhere into a 'Fold'. ----- >>> [1,2,3,4]^..folding tail--- [2,3,4]+-- >>> [1,2,3,4]^..folding reverse+-- [4,3,2,1] folding :: Foldable f => (s -> f a) -> Fold s a folding sfa agb = phantom . traverse_ agb . sfa {-# INLINE folding #-}@@ -638,11 +639,37 @@ -- 'toNonEmptyOf' :: 'Lens'' s a       -> s -> NonEmpty a -- 'toNonEmptyOf' :: 'Iso'' s a        -> s -> NonEmpty a -- 'toNonEmptyOf' :: 'Traversal1'' s a -> s -> NonEmpty a--- 'toNonEmptyOf' :: 'Prism'' s a      -> s -> NonEmpty a -- @ toNonEmptyOf :: Getting (NonEmptyDList a) s a -> s -> NonEmpty a toNonEmptyOf l = flip getNonEmptyDList [] . foldMapOf l (NonEmptyDList #. (:|)) +-- | Calls 'pure' on the target of a 'Lens', 'Getter', or 'Iso'.+--+-- Calls 'pure' on the targets of a 'Traversal', 'Fold', or 'Prism', and+-- combines them with '<|>' (or `empty` if none).  Intuitively, it collects+-- targets into an 'Alternative' until the container fills up or it runs out of+-- targets, whichever comes first.+--+-- Generalizes 'toListOf' and '(^?)'.+--+-- >>> altOf both ("hello", "world") :: [String]+-- ["hello","world"]+-- >>> altOf both ("hello", "world") :: Maybe String+-- Just "hello"+--+-- @+-- 'altOf' :: Applicative f => 'Lens'' s a      -> s -> f a+-- 'altOf' :: Applicative f => 'Getter' s a     -> s -> f a+-- 'altOf' :: Applicative f => 'Iso'' s a       -> s -> f a+--+-- 'altOf' :: Alternative f => 'Traversal'' s a -> s -> f a+-- 'altOf' :: Alternative f => 'Fold' s a       -> s -> f a+-- 'altOf' :: Alternative f => 'Prism'' s a     -> s -> f a+-- @+altOf :: Applicative f => Getting (Alt f a) s a -> s -> f a+altOf l = getAlt #. views l (Alt #. pure)+{-# INLINE altOf #-}+ -- | A convenient infix (flipped) version of 'toListOf'. -- -- >>> [[1,2],[3]]^..id@@ -1727,8 +1754,9 @@ -- 'foldr1Of' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a -- @ foldr1Of :: HasCallStack => Getting (Endo (Maybe a)) s a -> (a -> a -> a) -> s -> a-foldr1Of l f xs = fromMaybe (error "foldr1Of: empty structure")-                            (foldrOf l mf Nothing xs) where+-- See: NOTE: [Inlining and arity]+foldr1Of l f = fromMaybe (error "foldr1Of: empty structure")+             . foldrOf l mf Nothing where   mf x my = Just $ case my of     Nothing -> x     Just y -> f x y@@ -1753,7 +1781,8 @@ -- 'foldl1Of' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a -- @ foldl1Of :: HasCallStack => Getting (Dual (Endo (Maybe a))) s a -> (a -> a -> a) -> s -> a-foldl1Of l f xs = fromMaybe (error "foldl1Of: empty structure") (foldlOf l mf Nothing xs) where+-- See: NOTE: [Inlining and arity]+foldl1Of l f = fromMaybe (error "foldl1Of: empty structure") . foldlOf l mf Nothing where   mf mx y = Just $ case mx of     Nothing -> y     Just x  -> f x y@@ -1773,7 +1802,8 @@ -- 'foldrOf'' :: 'Traversal'' s a -> (a -> r -> r) -> r -> s -> r -- @ foldrOf' :: Getting (Dual (Endo (Endo r))) s a -> (a -> r -> r) -> r -> s -> r-foldrOf' l f z0 xs = foldlOf l f' (Endo id) xs `appEndo` z0+-- See: NOTE: [Inlining and arity]+foldrOf' l f z0 = \xs -> foldlOf l f' (Endo id) xs `appEndo` z0   where f' (Endo k) x = Endo $ \ z -> k $! f x z {-# INLINE foldrOf' #-} @@ -1791,7 +1821,8 @@ -- 'foldlOf'' :: 'Traversal'' s a -> (r -> a -> r) -> r -> s -> r -- @ foldlOf' :: Getting (Endo (Endo r)) s a -> (r -> a -> r) -> r -> s -> r-foldlOf' l f z0 xs = foldrOf l f' (Endo id) xs `appEndo` z0+-- See: NOTE: [Inlining and arity]+foldlOf' l f z0 = \xs -> foldrOf l f' (Endo id) xs `appEndo` z0   where f' x (Endo k) = Endo $ \z -> k $! f z x {-# INLINE foldlOf' #-} @@ -1811,7 +1842,8 @@ -- 'foldr1Of'' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a -- @ foldr1Of' :: HasCallStack => Getting (Dual (Endo (Endo (Maybe a)))) s a -> (a -> a -> a) -> s -> a-foldr1Of' l f xs = fromMaybe (error "foldr1Of': empty structure") (foldrOf' l mf Nothing xs) where+-- See: NOTE: [Inlining and arity]+foldr1Of' l f = fromMaybe (error "foldr1Of': empty structure") . foldrOf' l mf Nothing where   mf x Nothing = Just $! x   mf x (Just y) = Just $! f x y {-# INLINE foldr1Of' #-}@@ -1832,7 +1864,8 @@ -- 'foldl1Of'' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a -- @ foldl1Of' :: HasCallStack => Getting (Endo (Endo (Maybe a))) s a -> (a -> a -> a) -> s -> a-foldl1Of' l f xs = fromMaybe (error "foldl1Of': empty structure") (foldlOf' l mf Nothing xs) where+-- See: NOTE: [Inlining and arity]+foldl1Of' l f = fromMaybe (error "foldl1Of': empty structure") . foldlOf' l mf Nothing where   mf Nothing y = Just $! y   mf (Just x) y = Just $! f x y {-# INLINE foldl1Of' #-}@@ -1854,7 +1887,8 @@ foldrMOf :: Monad m          => Getting (Dual (Endo (r -> m r))) s a          -> (a -> r -> m r) -> r -> s -> m r-foldrMOf l f z0 xs = foldlOf l f' return xs z0+-- See: NOTE: [Inlining and arity]+foldrMOf l f z0 = \xs -> foldlOf l f' return xs z0   where f' k x z = f x z >>= k {-# INLINE foldrMOf #-} @@ -1875,9 +1909,25 @@ foldlMOf :: Monad m          => Getting (Endo (r -> m r)) s a          -> (r -> a -> m r) -> r -> s -> m r-foldlMOf l f z0 xs = foldrOf l f' return xs z0+-- See: NOTE: [Inlining and arity]+foldlMOf l f z0 = \xs -> foldrOf l f' return xs z0   where f' x k z = f z x >>= k {-# INLINE foldlMOf #-}++-- NOTE: [Inlining and arity]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- GHC uses the following inlining heuristic: a function body is inlined if+-- all its arguments on the LHS are applied. So the following two definitions+-- are not equivalent from the inliner's PoV:+--+-- > foldlOf' l f z0 xs = ...+-- > foldlOf' l f z0 = \xs -> ...+--+-- GHC will be less eager to inline the first one and this results in+-- worse code. For example, a simple list summation using `sumOf` will be 8x slower+-- with the first version.+  -- | Check to see if this 'Fold' or 'Traversal' matches 1 or more entries. --
src/Control/Lens/Getter.hs view
@@ -4,7 +4,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE Trustworthy #-} --- Disable the warnings generated by 'to', 'ito', 'like', 'ilike'.+-- Disable the warnings generated by 'Control.Lens.Getter.to', 'ito', 'like', 'ilike'. -- These functions are intended to produce 'Getters'. Without this constraint -- users would get warnings when annotating types at uses of these functions. {-# OPTIONS_GHC -Wno-redundant-constraints #-}@@ -108,11 +108,11 @@ -- | Build an (index-preserving) 'Getter' from an arbitrary Haskell function. -- -- @--- 'to' f '.' 'to' g ≡ 'to' (g '.' f)+-- 'Control.Lens.Getter.to' f '.' 'Control.Lens.Getter.to' g ≡ 'Control.Lens.Getter.to' (g '.' f) -- @ -- -- @--- a '^.' 'to' f ≡ f a+-- a '^.' 'Control.Lens.Getter.to' f ≡ f a -- @ -- -- >>> a ^.to f@@ -128,7 +128,7 @@ -- 5 -- -- @--- 'to' :: (s -> a) -> 'IndexPreservingGetter' s a+-- 'Control.Lens.Getter.to' :: (s -> a) -> 'IndexPreservingGetter' s a -- @ to :: (Profunctor p, Contravariant f) => (s -> a) -> Optic' p f s a to k = dimap k (contramap k)@@ -148,7 +148,7 @@ -- @ -- 'like' a '.' 'like' b ≡ 'like' b -- a '^.' 'like' b ≡ b--- a '^.' 'like' b ≡ a '^.' 'to' ('const' b)+-- a '^.' 'like' b ≡ a '^.' 'Control.Lens.Getter.to' ('const' b) -- @ -- -- This can be useful as a second case 'failing' a 'Fold'@@ -205,7 +205,7 @@ -- at a monoidal value. -- -- @--- 'view' '.' 'to' ≡ 'id'+-- 'view' '.' 'Control.Lens.Getter.to' ≡ 'id' -- @ -- -- >>> view (to f) a@@ -250,7 +250,7 @@ -- 'Control.Lens.Traversal.Traversal'. -- -- @--- 'views' l f ≡ 'view' (l '.' 'to' f)+-- 'views' l f ≡ 'view' (l '.' 'Control.Lens.Getter.to' f) -- @ -- -- >>> views (to f) g a
src/Control/Lens/Internal/Deque.hs view
@@ -193,7 +193,9 @@     if lf + lr == 0     then Left empty     else Right $ case f of-      []     -> (head r, empty)+      []     -> case r of+                  y:_ -> (y, empty)+                  []  -> error "Control.Lens.Internal.Deque._Cons: Internal check failed"       (x:xs) -> (x, check (lf - 1) xs lr r)   {-# INLINE _Cons #-} @@ -202,6 +204,8 @@     if lf + lr == 0     then Left empty     else Right $ case r of-      []     -> (empty, head f)+      []     -> case f of+                  y:_ -> (empty, y)+                  []  -> error "Control.Lens.Internal.Deque._Snoc: Internal check failed"       (x:xs) -> (check lf f (lr - 1) xs, x)   {-# INLINE _Snoc #-}
+ src/Control/Lens/Internal/Doctest.hs view
@@ -0,0 +1,43 @@+-- | This module exists for the sole purpose of redefining the 'head' and 'tail'+-- functions (which are normally provided by the 'Prelude') so that they can be+-- used in the doctests of 'Data.Data.Lens'.+--+-- The 'head' and 'tail' functions are partial, and as of GHC 9.8, there is a+-- @-Wx-partial@ warning (implied by @-Wall@) that triggers any time you use+-- either of these functions. This is a fairly reasonable default in most+-- settings, but there are a handful of doctests in 'Data.Data.Lens' that do in+-- fact rely on 'head' and 'tail' being partial functions. These doctests+-- demonstrate that various functions in 'Data.Data.Lens' can recover from+-- exceptions that are thrown due to partiality (see, for instance, the @upon@+-- function).+--+-- One possible workaround would be to disable @-Wx-partial@. We don't want to+-- disable the warning for /all/ code in @lens@, however—we only want to+-- disable it for a particular group of doctests. It is rather tricky to achieve+-- this level of granularity, unfortunately. This is because tools like+-- @cabal-docspec@ rely on GHCi to work, and the statefulness of GHCi's @:set@+-- command means that disabling @-Wx-partial@ might leak into other modules'+-- doctests, which we don't want.+--+-- Instead, we opt to redefine our own versions of 'head' and 'tail' here, which+-- do not trigger any @-Wx-partial@ warnings, and use them in the+-- 'Data.Data.Lens' doctests. This has no impact on anyone reading the doctests,+-- as these functions will look indistinguishable from the 'head' and 'tail'+-- functions in the 'Prelude'. One consequence of this design is that we must+-- export the 'Control.Lens.Internal.Doctest' module, as GHCi (and therefore+-- @cabal-docspec@) won't be able to import it otherwise. Despite this technical+-- oddity, this module should be thought of as internal to @lens@.+module Control.Lens.Internal.Doctest+  ( head+  , tail+  ) where++import Prelude hiding (head, tail)++head :: [a] -> a+head (x:_) = x+head []    = error "head: empty list"++tail :: [a] -> [a]+tail (_:xs) = xs+tail []     = error "tail: empty list"
src/Control/Lens/Internal/FieldTH.hs view
@@ -1,5 +1,10 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE PatternGuards #-}+#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE TemplateHaskellQuotes #-}+#else+{-# LANGUAGE TemplateHaskell #-}+#endif #ifdef TRUSTWORTHY # if MIN_VERSION_template_haskell(2,12,0) {-# LANGUAGE Safe #-}@@ -34,6 +39,7 @@  import Control.Lens.At import Control.Lens.Fold+import Control.Lens.Indexed import Control.Lens.Internal.TH import Control.Lens.Internal.Prelude import Control.Lens.Lens@@ -50,7 +56,7 @@ import qualified Language.Haskell.TH.Datatype as D import qualified Language.Haskell.TH.Datatype.TyVarBndr as D import Data.Maybe (fromMaybe,isJust,maybeToList)-import Data.List (nub, findIndices)+import Data.List (nub) import Data.Either (partitionEithers) import Data.Semigroup (Any (..)) import Data.Set.Lens@@ -84,7 +90,7 @@        fieldCons <- traverse normalizeConstructor cons        let allFields  = toListOf (folded . _2 . folded . _1 . folded) fieldCons        let defCons    = over normFieldLabels (expandName allFields) fieldCons-           allDefs    = setOf (normFieldLabels . folded) defCons+           allDefs    = setOf (normFieldLabels . folded . _1) defCons        T.sequenceA (Map.fromSet (buildScaffold rules s defCons) allDefs)       let defs = Map.toList perDef@@ -104,8 +110,8 @@   normFieldLabels = traverse . _2 . traverse . _1    -- Map a (possibly missing) field's name to zero-to-many optic definitions-  expandName :: [Name] -> Maybe Name -> [DefName]-  expandName allFields = concatMap (_fieldToDef rules tyName allFields) . maybeToList+  expandName :: [Name] -> Maybe Name -> [(DefName, Maybe Name)]+  expandName allFields mName = (\x -> (x, mName)) <$> (maybeToList mName >>= _fieldToDef rules tyName allFields)  -- | Normalized the Con type into a uniform positional representation, -- eliminating the variance between records, infix constructors, and normal@@ -141,15 +147,15 @@ -- type of clauses to generate and the type to annotate the declaration -- with. buildScaffold ::-  LensRules                                                                  ->-  Type                              {- ^ outer type                       -} ->-  [(Name, [([DefName], Type)])]     {- ^ normalized constructors          -} ->-  DefName                           {- ^ target definition                -} ->-  Q (OpticType, OpticStab, [(Name, Int, [Int])])+  LensRules                                                                            ->+  Type                                        {- ^ outer type                       -} ->+  [(Name, [([(DefName, Maybe Name)], Type)])] {- ^ normalized constructors          -} ->+  DefName                                     {- ^ target definition                -} ->+  Q (OpticType, OpticStab, [(Name, Int, [(Maybe Name, Int)])])               {- ^ optic type, definition type, field count, target fields -} buildScaffold rules s cons defName = -  do (s',t,a,b) <- buildStab s (concatMap snd consForDef)+  do (s',t,a,b) <- buildStab s (concatMap snd (consForDef <&> _2 . mapped . _Right %~ snd))       let defType            | Just (_,cx,a') <- preview _ForallT a =@@ -184,29 +190,27 @@       return (opticType, defType, scaffolds)   where-  consForDef :: [(Name, [Either Type Type])]+  consForDef :: [(Name, [Either Type (Maybe Name, Type)])]   consForDef = over (mapped . _2 . mapped) categorize cons -  scaffolds :: [(Name, Int, [Int])]-  scaffolds = [ (n, length ts, rightIndices ts) | (n,ts) <- consForDef ]--  rightIndices :: [Either Type Type] -> [Int]-  rightIndices = findIndices (has _Right)+  scaffolds :: [(Name, Int, [(Maybe Name, Int)])]+  scaffolds = [ (n, length ts, (\(a, b) -> (b, a)) <$> ts ^@.. folded <. _Right . _1) | (n,ts) <- consForDef ]    -- Right: types for this definition   -- Left : other types-  categorize :: ([DefName], Type) -> Either Type Type-  categorize (defNames, t)-    | defName `elem` defNames = Right t-    | otherwise               = Left  t+  categorize :: ([(DefName, Maybe Name)], Type) -> Either Type (Maybe Name, Type)+  categorize (defNames, t) =+    case lookup defName defNames of+    Just c -> Right (c, t)+    Nothing -> Left t    lensCase :: Bool   lensCase = all (\x -> lengthOf (_2 . folded . _Right) x == 1) consForDef    isoCase :: Bool   isoCase = case scaffolds of-              [(_,1,[0])] -> True-              _           -> False+              [(_,1,[(_, 0)])] -> True+              _                -> False   data OpticStab = OpticStab     Name Type Type Type Type@@ -301,7 +305,7 @@ -- used to enable the resulting lenses to be used on a bottom value. makeFieldOptic ::   LensRules ->-  (DefName, (OpticType, OpticStab, [(Name, Int, [Int])])) ->+  (DefName, (OpticType, OpticStab, [(Name, Int, [(Maybe Name, Int)])])) ->   HasFieldClasses [Dec] makeFieldOptic rules (defName, (opticType, defType, cons)) = do   locals <- get@@ -342,7 +346,7 @@   Name ->   Name ->   Type {- ^ Outer 's' type -} ->-  [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))] ->+  [(DefName, (OpticType, OpticStab, [(Name, Int, [(Maybe Name, Int)])]))] ->   HasFieldClasses [Dec] makeClassyDriver rules className methodName s defs = T.sequenceA (cls ++ inst) @@ -357,13 +361,13 @@   Name ->   Name ->   Type {- ^ Outer 's' type -} ->-  [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))] ->+  [(DefName, (OpticType, OpticStab, [(Name, Int, [(Maybe Name, Int)])]))] ->   DecQ makeClassyClass className methodName s defs = do   let ss   = map (stabToS . view (_2 . _2)) defs   (sub,s') <- unifyTypes (s : ss)   c <- newName "c"-  let vars     = D.freeVariablesWellScoped [s']+  let vars     = D.changeTVFlags bndrReq $ D.freeVariablesWellScoped [s']       varNames = map D.tvName vars       fd   | null vars = []            | otherwise = [FunDep [c] varNames]@@ -390,7 +394,7 @@   Name ->   Name ->   Type {- ^ Outer 's' type -} ->-  [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))] ->+  [(DefName, (OpticType, OpticStab, [(Name, Int, [(Maybe Name, Int)])]))] ->   HasFieldClasses Dec makeClassyInstance rules className methodName s defs = do   methodss <- traverse (makeFieldOptic rules') defs@@ -433,7 +437,16 @@    containsTypeFamilies = go <=< D.resolveTypeSynonyms     where-    go (ConT nm) = has (_FamilyI . _1 . _TypeFamilyD) <$> reify nm+    go :: Type -> Q Bool+    go (ConT nm) =+      -- Note that the call to `reify` can fail if `nm` is not yet defined.+      -- (This can actually happen if `nm` is declared in a Template Haskell+      -- quote.) If this fails, there is no way to tell if the type contains+      -- type families, so we recover and conservatively assume that is does not+      -- contain any.+      recover+        (pure False)+        (has (_FamilyI . _1 . _TypeFamilyD) <$> reify nm)     go ty = or <$> traverse go (ty ^.. plate)      -- We want to catch type families, but not *data* families. See #799.@@ -456,20 +469,21 @@ ------------------------------------------------------------------------  -makeFieldClauses :: LensRules -> OpticType -> [(Name, Int, [Int])] -> [ClauseQ]+makeFieldClauses :: LensRules -> OpticType -> [(Name, Int, [(Maybe Name, Int)])] -> [ClauseQ] makeFieldClauses rules opticType cons =   case opticType of      IsoType    -> [ makeIsoClause conName | (conName, _, _) <- cons ] -    GetterType -> [ makeGetterClause conName fieldCount fields+    GetterType -> [ makeGetterClause conName fieldCount (snd <$> fields)                     | (conName, fieldCount, fields) <- cons ] -    LensType   -> [ makeFieldOpticClause conName fieldCount fields irref+    LensType   -> [ makeFieldOpticClause conName fieldCount fields irref recSyn                     | (conName, fieldCount, fields) <- cons ]       where       irref = _lazyPatterns rules            && length cons == 1+      recSyn = _recordSyntax rules && length cons == 1   @@ -492,16 +506,20 @@ makeGetterClause conName fieldCount fields =   do f  <- newName "f"      xs <- newNames "x" (length fields)+     xs' <-+       case xs of+         (x:xs') -> pure (x :| xs')+         []      -> fail "makeGetterClause: Internal check failed"       let pats (i:is) (y:ys)            | i `elem` fields = varP y : pats is ys            | otherwise = wildP : pats is (y:ys)          pats is     _  = map (const wildP) is -         fxs   = [ appE (varE f) (varE x) | x <- xs ]+         (fx :| fxs) = fmap (appE (varE f) . varE) xs'          body  = foldl (\a b -> appsE [varE apValName, a, b])-                       (appE (varE phantomValName) (head fxs))-                       (tail fxs)+                       (appE (varE phantomValName) fx)+                       fxs       -- clause f (Con x1..xn) = coerce (f x1) <*> ... <*> f xn      clause [varP f, conP conName (pats [0..fieldCount - 1] xs)]@@ -511,15 +529,25 @@ -- | Build a clause that updates the field at the given indexes -- When irref is 'True' the value with me matched with an irrefutable -- pattern. This is suitable for Lens and Traversal construction-makeFieldOpticClause :: Name -> Int -> [Int] -> Bool -> ClauseQ-makeFieldOpticClause conName fieldCount [] _ =+makeFieldOpticClause :: Name -> Int -> [(Maybe Name, Int)] -> Bool -> Bool -> ClauseQ+makeFieldOpticClause conName fieldCount [] _ _ =   makePureClause conName fieldCount-makeFieldOpticClause conName fieldCount (field:fields) irref =+makeFieldOpticClause _ _ [(Just fieldName, _)] _ True =+  do f <- newName "f"+     r <- newName "r"+     x <- newName "x"+     let body = appsE [ [| fmap |]+                      , lamE [varP x] (recUpdE (varE r) [(,) fieldName <$> varE x])+                      , varE f `appE` (varE fieldName `appE` varE r)+                      ]+     clause [varP f, varP r] (normalB body) []+makeFieldOpticClause conName fieldCount ((_, field):fieldsWithNames) irref _ =   do f  <- newName "f"      xs <- newNames "x" fieldCount-     ys <- newNames "y" (1 + length fields)+     ys <- newNames "y" (1 + length fieldsWithNames) -     let xs' = foldr (\(i,x) -> set (ix i) x) xs (zip (field:fields) ys)+     let fields = snd <$> fieldsWithNames+         xs' = foldr (\(i,x) -> set (ix i) x) xs (zip (field:fields) ys)           mkFx i = appE (varE f) (varE (xs !! i)) @@ -625,6 +653,7 @@   , _allowIsos       :: Bool   , _allowUpdates    :: Bool -- ^ Allow Lens/Traversal (otherwise Getter/Fold)   , _lazyPatterns    :: Bool+  , _recordSyntax    :: Bool   , _fieldToDef      :: FieldNamer        -- ^ Type Name -> Field Names -> Target Field Name -> Definition Names   , _classyLenses    :: ClassyNamer
src/Control/Lens/Internal/Iso.hs view
@@ -33,6 +33,9 @@ import qualified Data.Vector.Storable  as Storable import qualified Data.Vector.Unboxed   as Unbox import Data.Vector.Unboxed (Unbox)+#if MIN_VERSION_vector(0,13,2)+import qualified Data.Vector.Strict as VectorStrict+#endif import qualified Data.Sequence         as Seq import Data.Sequence (Seq) import Foreign.Storable (Storable)@@ -100,3 +103,8 @@  instance Storable a => Reversing (Storable.Vector a) where   reversing = Storable.reverse++#if MIN_VERSION_vector(0,13,2)+instance Reversing (VectorStrict.Vector a) where+  reversing = VectorStrict.reverse+#endif
src/Control/Lens/Internal/PrismTH.hs view
@@ -433,7 +433,7 @@          ]    cons'         = map (over nconName prismName) cons-  vs            = D.freeVariablesWellScoped [t]+  vs            = D.changeTVFlags bndrReq $ D.freeVariablesWellScoped [t]   vNames        = map D.tvName vs   fds r     | null vs   = []
src/Control/Lens/Internal/TH.hs view
@@ -20,7 +20,13 @@ -- Portability :  non-portable -- -----------------------------------------------------------------------------module Control.Lens.Internal.TH where+module Control.Lens.Internal.TH+  ( module Control.Lens.Internal.TH+#if MIN_VERSION_template_haskell(2,21,0) || MIN_VERSION_th_abstraction(0,6,0)+  , D.TyVarBndrVis+  , D.bndrReq+#endif+  ) where  import Control.Lens.Iso import Control.Lens.Prism@@ -154,6 +160,16 @@ isDataFamily D.Newtype         = False isDataFamily D.DataInstance    = True isDataFamily D.NewtypeInstance = True+#if MIN_VERSION_th_abstraction(0,5,0)+isDataFamily D.TypeData        = False+#endif++#if !(MIN_VERSION_template_haskell(2,21,0)) && !(MIN_VERSION_th_abstraction(0,6,0))+type TyVarBndrVis = D.TyVarBndr_ ()++bndrReq :: ()+bndrReq = ()+#endif  ------------------------------------------------------------------------ -- TH-quoted names
src/Control/Lens/Iso.hs view
@@ -5,7 +5,12 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE Trustworthy #-}++#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE PolyKinds #-}+#else {-# LANGUAGE TypeInType #-}+#endif  #include "lens-common.h"
src/Control/Lens/Lens.hs view
@@ -6,7 +6,12 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Trustworthy #-}++#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE PolyKinds #-}+#else {-# LANGUAGE TypeInType #-}+#endif  #include "lens-common.h" @@ -82,18 +87,18 @@   -- * Setting Functionally with Passthrough   , (<%~), (<+~), (<-~), (<*~), (<//~)   , (<^~), (<^^~), (<**~)-  , (<||~), (<&&~), (<<>~)+  , (<||~), (<&&~), (<<>~), (<<>:~)   , (<<%~), (<<.~), (<<?~), (<<+~), (<<-~), (<<*~)   , (<<//~), (<<^~), (<<^^~), (<<**~)-  , (<<||~), (<<&&~), (<<<>~)+  , (<<||~), (<<&&~), (<<<>~), (<<<>:~)    -- * Setting State with Passthrough   , (<%=), (<+=), (<-=), (<*=), (<//=)   , (<^=), (<^^=), (<**=)-  , (<||=), (<&&=), (<<>=)+  , (<||=), (<&&=), (<<>=), (<<>:=)   , (<<%=), (<<.=), (<<?=), (<<+=), (<<-=), (<<*=)   , (<<//=), (<<^=), (<<^^=), (<<**=)-  , (<<||=), (<<&&=), (<<<>=)+  , (<<||=), (<<&&=), (<<<>=), (<<<>:=)   , (<<~)    -- * Cloning Lenses@@ -158,10 +163,10 @@ -- >>> let setter :: Expr -> Expr -> Expr; setter = fun "setter"  infixl 8 ^#-infixr 4 %%@~, <%@~, <<%@~, %%~, <+~, <*~, <-~, <//~, <^~, <^^~, <**~, <&&~, <||~, <<>~, <%~, <<%~, <<.~, <<?~, <#~, #~, #%~, <#%~, #%%~-       , <<+~, <<-~, <<*~, <<//~, <<^~, <<^^~, <<**~, <<||~, <<&&~, <<<>~-infix  4 %%@=, <%@=, <<%@=, %%=, <+=, <*=, <-=, <//=, <^=, <^^=, <**=, <&&=, <||=, <<>=, <%=, <<%=, <<.=, <<?=, <#=, #=, #%=, <#%=, #%%=-       , <<+=, <<-=, <<*=, <<//=, <<^=, <<^^=, <<**=, <<||=, <<&&=, <<<>=+infixr 4 %%@~, <%@~, <<%@~, %%~, <+~, <*~, <-~, <//~, <^~, <^^~, <**~, <&&~, <||~, <<>~, <<>:~, <%~, <<%~, <<.~, <<?~, <#~, #~, #%~, <#%~, #%%~+       , <<+~, <<-~, <<*~, <<//~, <<^~, <<^^~, <<**~, <<||~, <<&&~, <<<>~, <<<>:~+infix  4 %%@=, <%@=, <<%@=, %%=, <+=, <*=, <-=, <//=, <^=, <^^=, <**=, <&&=, <||=, <<>=, <<>:=, <%=, <<%=, <<.=, <<?=, <#=, #=, #%=, <#%=, #%%=+       , <<+=, <<-=, <<*=, <<//=, <<^=, <<^^=, <<**=, <<||=, <<&&=, <<<>=, <<<>:= infixr 2 <<~ infixl 1 ??, &~ @@ -1186,6 +1191,42 @@ (<<>=) :: (MonadState s m, Semigroup r) => LensLike' ((,)r) s r -> r -> m r l <<>= r = l <%= (<> r) {-# INLINE (<<>=) #-}++-- | ('<>') a 'Semigroup' value onto the front of the target of a 'Lens' and+-- return the result.+-- However, unlike ('<<>~'), it is prepended to the head side.+--+-- When you do not need the result of the operation, ('Control.Lens.Setter.<>:~') is more flexible.+(<<>:~) :: Semigroup m => LensLike ((,) m) s t m m -> m -> s -> (m, t)+l <<>:~ m = l <%~ (m <>)+{-# INLINE (<<>:~) #-}++-- | ('<>') a 'Semigroup' value onto the front of the target of a 'Lens' and+-- return the /old/ result.+-- However, unlike ('<<>~'), it is prepended to the head side.+--+-- When you do not need the result of the operation, ('Control.Lens.Setter.<>:~') is more flexible.+(<<<>:~) :: Semigroup m => LensLike' ((,) m) s m -> m -> s -> (m, s)+l <<<>:~ m = l <<%~ (m <>)+{-# INLINE (<<<>:~) #-}++-- | ('<>') a 'Semigroup' value onto the front of the target of a 'Lens' into+-- your 'Monad''s state and return the result.+-- However, unlike ('<<>='), it is prepended to the head side.+--+-- When you do not need the result of the operation, ('Control.Lens.Setter.<>:=') is more flexible.+(<<>:=) :: (MonadState s m, Semigroup r) => LensLike' ((,) r) s r -> r -> m r+l <<>:= r = l <%= (r <>)+{-# INLINE (<<>:=) #-}++-- | ('<>') a 'Semigroup' value onto the front of the target of a 'Lens' into+-- your 'Monad''s state and return the /old/ result.+-- However, unlike ('<<<>='), it is prepended to the head side.+--+-- When you do not need the result of the operation, ('Control.Lens.Setter.<>:=') is more flexible.+(<<<>:=) :: (MonadState s m, Semigroup r) => LensLike' ((,) r) s r -> r -> m r+l <<<>:= r = l <<%= (r <>)+{-# INLINE (<<<>:=) #-}  ------------------------------------------------------------------------------ -- Arrow operators
src/Control/Lens/Operators.hs view
@@ -18,6 +18,18 @@   -- * "Control.Lens.Cons"     (<|)   , (|>)+  , (<|~)+  , (<|=)+  , (<<|~)+  , (<<|=)+  , (<<<|~)+  , (<<<|=)+  , (|>~)+  , (|>=)+  , (<|>~)+  , (<|>=)+  , (<<|>~)+  , (<<|>=)   -- * "Control.Lens.Fold"   , (^..)   , (^?)@@ -62,6 +74,7 @@   , (<<||~)   , (<<&&~)   , (<<<>~)+  , (<<<>:~)   , (<%=)   , (<+=)   , (<-=)@@ -85,9 +98,12 @@   , (<<||=)   , (<<&&=)   , (<<<>=)+  , (<<<>:=)   , (<<~)   , (<<>~)   , (<<>=)+  , (<<>:~)+  , (<<>:=)   , (<%@~)   , (<<%@~)   , (%%@~)@@ -141,6 +157,8 @@   , (<?=)   , (<>~)   , (<>=)+  , (<>:~)+  , (<>:=)   , (.@~)   , (.@=)   , (%@~)
src/Control/Lens/Plated.hs view
@@ -680,7 +680,7 @@ -- -- @ -- 'composOpMonoid' ≡ 'foldMapOf' 'plate'--- 'composOpMPlus' f ≡ 'msumOf' ('plate' '.' 'to' f)+-- 'composOpMPlus' f ≡ 'msumOf' ('plate' '.' 'Control.Lens.Getter.to' f) -- 'composOp' ≡ 'descend' ≡ 'over' 'plate' -- 'composOpM' ≡ 'descendM' ≡ 'mapMOf' 'plate' -- 'composOpM_' ≡ 'descendM_' ≡ 'mapMOf_' 'plate'
src/Control/Lens/Reified.hs view
@@ -50,7 +50,7 @@ -- Lens ------------------------------------------------------------------------------ --- | Reify a 'Lens' so it can be stored safely in a container.+-- | Reify a t'Lens' so it can be stored safely in a container. newtype ReifiedLens s t a b = Lens { runLens :: Lens s t a b }  -- | @@@ -62,7 +62,7 @@ -- IndexedLens ------------------------------------------------------------------------------ --- | Reify an 'IndexedLens' so it can be stored safely in a container.+-- | Reify an t'IndexedLens' so it can be stored safely in a container. newtype ReifiedIndexedLens i s t a b = IndexedLens { runIndexedLens :: IndexedLens i s t a b }  -- | @@@ -74,7 +74,7 @@ -- IndexedTraversal ------------------------------------------------------------------------------ --- | Reify an 'IndexedTraversal' so it can be stored safely in a container.+-- | Reify an t'IndexedTraversal' so it can be stored safely in a container. newtype ReifiedIndexedTraversal i s t a b = IndexedTraversal { runIndexedTraversal :: IndexedTraversal i s t a b }  -- | @@@ -86,7 +86,7 @@ -- Traversal ------------------------------------------------------------------------------ --- | A form of 'Traversal' that can be stored monomorphically in a container.+-- | A form of t'Traversal' that can be stored monomorphically in a container. newtype ReifiedTraversal s t a b = Traversal { runTraversal :: Traversal s t a b }  -- | @@@ -98,7 +98,7 @@ -- Getter ------------------------------------------------------------------------------ --- | Reify a 'Getter' so it can be stored safely in a container.+-- | Reify a t'Getter' so it can be stored safely in a container. -- -- This can also be useful when combining getters in novel ways, as -- 'ReifiedGetter' is isomorphic to '(->)' and provides similar instances.@@ -249,7 +249,7 @@ -- IndexedGetter ------------------------------------------------------------------------------ --- | Reify an 'IndexedGetter' so it can be stored safely in a container.+-- | Reify an t'IndexedGetter' so it can be stored safely in a container. newtype ReifiedIndexedGetter i s a = IndexedGetter { runIndexedGetter :: IndexedGetter i s a }  instance Profunctor (ReifiedIndexedGetter i) where@@ -289,7 +289,7 @@ -- Fold ------------------------------------------------------------------------------ --- | Reify a 'Fold' so it can be stored safely in a container.+-- | Reify a t'Fold' so it can be stored safely in a container. -- -- This can also be useful for creatively combining folds as -- @'ReifiedFold' s@ is isomorphic to @ReaderT s []@ and provides similar@@ -490,7 +490,7 @@ -- Setter ------------------------------------------------------------------------------ --- | Reify a 'Setter' so it can be stored safely in a container.+-- | Reify a t'Setter' so it can be stored safely in a container. newtype ReifiedSetter s t a b = Setter { runSetter :: Setter s t a b }  -- | @@@ -502,7 +502,7 @@ -- IndexedSetter ------------------------------------------------------------------------------ --- | Reify an 'IndexedSetter' so it can be stored safely in a container.+-- | Reify an t'IndexedSetter' so it can be stored safely in a container. newtype ReifiedIndexedSetter i s t a b =   IndexedSetter { runIndexedSetter :: IndexedSetter i s t a b } @@ -515,7 +515,7 @@ -- Iso ------------------------------------------------------------------------------ --- | Reify an 'Iso' so it can be stored safely in a container.+-- | Reify an t'Iso' so it can be stored safely in a container. newtype ReifiedIso s t a b = Iso { runIso :: Iso s t a b }  -- | @@@ -527,7 +527,7 @@ -- Prism ------------------------------------------------------------------------------ --- | Reify a 'Prism' so it can be stored safely in a container.+-- | Reify a t'Prism' so it can be stored safely in a container. newtype ReifiedPrism s t a b = Prism { runPrism :: Prism s t a b }  -- | @
src/Control/Lens/Setter.hs view
@@ -49,11 +49,11 @@   , over   , set   , (.~), (%~)-  , (+~), (-~), (*~), (//~), (^~), (^^~), (**~), (||~), (<>~), (&&~), (<.~), (?~), (<?~)+  , (+~), (-~), (*~), (//~), (^~), (^^~), (**~), (||~), (<>~), (<>:~), (&&~), (<.~), (?~), (<?~)   -- * State Combinators   , assign, modifying   , (.=), (%=)-  , (+=), (-=), (*=), (//=), (^=), (^^=), (**=), (||=), (<>=), (&&=), (<.=), (?=), (<?=)+  , (+=), (-=), (*=), (//=), (^=), (^^=), (**=), (||=), (<>=), (<>:=), (&&=), (<.=), (?=), (<?=)   , (<~)   -- * Writer Combinators   , scribe@@ -80,8 +80,8 @@  import Control.Arrow import Control.Comonad-import Control.Lens.Internal.Prelude import Control.Lens.Internal.Indexed+import Control.Lens.Internal.Prelude import Control.Lens.Internal.Setter import Control.Lens.Type import Control.Monad (liftM)@@ -105,8 +105,8 @@ -- >>> let setter :: Expr -> Expr -> Expr; setter = fun "setter" -- >>> :set -XNoOverloadedStrings -infixr 4 %@~, .@~, .~, +~, *~, -~, //~, ^~, ^^~, **~, &&~, <>~, ||~, %~, <.~, ?~, <?~-infix  4 %@=, .@=, .=, +=, *=, -=, //=, ^=, ^^=, **=, &&=, <>=, ||=, %=, <.=, ?=, <?=+infixr 4 %@~, .@~, .~, +~, *~, -~, //~, ^~, ^^~, **~, &&~, <>~, <>:~, ||~, %~, <.~, ?~, <?~+infix  4 %@=, .@=, .=, +=, *=, -=, //=, ^=, ^^=, **=, &&=, <>=, <>:=, ||=, %=, <.=, ?=, <?= infixr 2 <~  ------------------------------------------------------------------------------@@ -1069,6 +1069,24 @@ (<>=) :: (MonadState s m, Semigroup a) => ASetter' s a -> a -> m () l <>= a = State.modify (l <>~ a) {-# INLINE (<>=) #-}++-- | Modify the target of a 'Semigroup' value by using @('<>')@.+-- However, unlike '<>~', it is prepend to the head side.+--+-- >>> ["world"] & id <>:~ ["hello"]+-- ["hello","world"]+--+-- >>> (["world"], ["lens"]) & _1 <>:~ ["hello"]+-- (["hello","world"],["lens"])+(<>:~) :: Semigroup b => ASetter s t b b -> b -> s -> t+l <>:~ n = over l (n <>)+{-# INLINE (<>:~) #-}++-- | Modify the target(s) of a 'Lens'', 'Iso', 'Setter' or 'Traversal' by using @('<>')@.+-- However, unlike '<>=', it is prepend to the head side.+(<>:=) :: (MonadState s m, Semigroup a) => ASetter' s a -> a -> m ()+l <>:= a = State.modify (l <>:~ a)+{-# INLINE (<>:=) #-}  ----------------------------------------------------------------------------- -- Writer Operations
src/Control/Lens/TH.hs view
@@ -28,6 +28,7 @@   , makeClassy, makeClassyFor, makeClassy_   , makeFields   , makeFieldsNoPrefix+  , makeFieldsId   -- ** Prisms   , makePrisms   , makeClassyPrisms@@ -58,6 +59,7 @@   , classUnderscoreNoPrefixFields   , underscoreFields   , abbreviatedFields+  , classIdFields   -- ** LensRules configuration accessors   , lensField   , FieldNamer@@ -69,6 +71,7 @@   , generateSignatures   , generateUpdateableOptics   , generateLazyPatterns+  , generateRecordSyntax   -- ** FieldNamers   , underscoreNoPrefixNamer   , lookingupNamer@@ -77,6 +80,7 @@   , classUnderscoreNoPrefixNamer   , underscoreNamer   , abbreviatedNamer+  , classIdNamer   ) where  import Prelude ()@@ -160,6 +164,10 @@ generateLazyPatterns f r =   fmap (\x -> r { _lazyPatterns = x}) (f (_lazyPatterns r)) +generateRecordSyntax :: Lens' LensRules Bool+generateRecordSyntax f r =+  fmap (\x -> r {_recordSyntax = x}) (f (_recordSyntax r))+ -- | Create the class if the constructor is 'Control.Lens.Type.Simple' and the -- 'lensClass' rule matches. createClass :: Lens' LensRules Bool@@ -185,6 +193,7 @@   , _allowIsos       = True   , _allowUpdates    = True   , _lazyPatterns    = False+  , _recordSyntax    = False   , _classyLenses    = const Nothing   , _fieldToDef      = underscoreNoPrefixNamer   }@@ -226,6 +235,7 @@   , _allowIsos       = False -- generating Isos would hinder "subtyping"   , _allowUpdates    = True   , _lazyPatterns    = False+  , _recordSyntax    = False   , _classyLenses    = \n ->         case nameBase n of           x:xs -> Just (mkName ("Has" ++ x:xs), mkName (toLower x:xs))@@ -627,6 +637,19 @@       methodName = fieldUnprefixed   return (MethodName (mkName className) (mkName methodName)) +-- | Field rules for fields whose names are to be used verbatim, with no+-- prefixes, no underscores, no transformations of any kind.+classIdFields :: LensRules+classIdFields =+  defaultFieldRules & lensField .~ classIdNamer++-- | A 'FieldNamer' for 'classIdFields'.+classIdNamer :: FieldNamer+classIdNamer _ _ field = [MethodName (mkName className) (mkName fieldName)]+  where+  fieldName = nameBase field+  className = "Has" ++ overHead toUpper fieldName+ -- | Field rules fields in the form @ prefixFieldname or _prefixFieldname @ -- If you want all fields to be lensed, then there is no reason to use an @_@ before the prefix. -- If any of the record fields leads with an @_@ then it is assume a field without an @_@ should not have a lens created.@@ -737,6 +760,42 @@ makeFieldsNoPrefix :: Name -> DecsQ makeFieldsNoPrefix = makeFieldOptics classUnderscoreNoPrefixFields +-- | Generate overloaded field accessors, using exactly the same names as the+-- underlying fields. Intended for use with the @NoFieldSelectors@ and+-- @DuplicateRecordFields@ language extensions.+--+-- As an example:+--+-- @+-- data Foo a  = Foo { x :: 'Int', y :: a }+-- newtype Bar = Bar { x :: 'Char' }+-- makeFieldsId ''Foo+-- makeFieldsId ''Bar+-- @+--+-- will create classes+--+-- @+-- class HasX s a | s -> a where+--   x :: Lens' s a+-- class HasY s a | s -> a where+--   y :: Lens' s a+-- @+--+-- together with instances+--+-- @+-- instance HasX (Foo a) Int+-- instance HasY (Foo a) a where+-- instance HasX Bar Char where+-- @+--+-- @+-- makeFieldsId = 'makeLensesWith' 'classIdFields'+-- @+makeFieldsId :: Name -> DecsQ+makeFieldsId = makeFieldOptics classIdFields+ defaultFieldRules :: LensRules defaultFieldRules = LensRules   { _simpleLenses    = True@@ -745,6 +804,7 @@   , _allowIsos       = False -- generating Isos would hinder field class reuse   , _allowUpdates    = True   , _lazyPatterns    = False+  , _recordSyntax    = False   , _classyLenses    = const Nothing   , _fieldToDef      = camelCaseNamer   }
src/Control/Lens/Traversal.hs view
@@ -162,7 +162,7 @@ import Data.Semigroup.Traversable import Data.Semigroup.Bitraversable import Data.Tuple (swap)-import GHC.Magic (inline)+import GHC.Exts (inline)  -- $setup -- >>> :set -XNoOverloadedStrings -XFlexibleContexts
src/Control/Lens/Type.hs view
@@ -5,8 +5,13 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeInType #-} {-# LANGUAGE Trustworthy #-}++#if __GLASGOW_HASKELL__ >= 806+{-# LANGUAGE PolyKinds #-}+#else+{-# LANGUAGE TypeInType #-}+#endif ------------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Type@@ -230,7 +235,7 @@ type IndexedTraversal1 i s t a b = forall p f. (Indexable i p, Apply f) => p a (f b) -> s -> f t type IndexedTraversal1' i s a = IndexedTraversal1 i s s a a --- | An 'IndexPreservingLens' leaves any index it is composed with alone.+-- | An 'IndexPreservingTraversal' leaves any index it is composed with alone. type IndexPreservingTraversal s t a b = forall p f. (Conjoined p, Applicative f) => p a (f b) -> p s (f t)  -- | @
src/Control/Lens/Unsound.hs view
@@ -18,7 +18,7 @@ -- Portability :  Rank2Types -- -- One commonly asked question is: can we combine two lenses,--- @`Lens'` a b@ and @`Lens'` a c@ into @`Lens'` a (b, c)@.+-- @'Lens'' a b@ and @'Lens'' a c@ into @'Lens'' a (b, c)@. -- This is fair thing to ask, but such operation is unsound in general. -- See `lensProduct`. --@@ -39,7 +39,7 @@ -- >>> import Control.Lens  -- | A lens product. There is no law-abiding way to do this in general.--- Result is only a valid 'Lens' if the input lenses project disjoint parts of+-- Result is only a valid t'Lens' if the input lenses project disjoint parts of -- the structure @s@. Otherwise "you get what you put in" law -- -- @
src/Control/Lens/Wrapped.hs view
@@ -30,7 +30,7 @@ -- Stability   :  experimental -- Portability :  Rank2, MPTCs, fundeps ----- The 'Wrapped' class provides similar functionality as @Control.Newtype@,+-- The t'Wrapped' class provides similar functionality as @Control.Newtype@, -- from the @newtype@ package, but in a more convenient and efficient form. -- -- There are a few functions from @newtype@ that are not provided here, because@@ -150,6 +150,9 @@ import           Data.Set (Set) import           Data.Tagged import qualified Data.Vector as Vector+#if MIN_VERSION_vector(0,13,2)+import qualified Data.Vector.Strict as VectorStrict+#endif import qualified Data.Vector.Primitive as Prim import           Data.Vector.Primitive (Prim) import qualified Data.Vector.Unboxed as Unboxed@@ -169,7 +172,7 @@ -- >>> import Data.Foldable (foldMap) -- >>> import Data.Monoid (Sum (..), Product (..), All (..), Any (..)) --- | 'Wrapped' provides isomorphisms to wrap and unwrap newtypes or+-- | t'Wrapped' provides isomorphisms to wrap and unwrap newtypes or -- data types with one constructor. class Wrapped s where   type Unwrapped s :: Type@@ -568,14 +571,14 @@  -- * unordered-containers --- | Use @'wrapping' 'HashMap.fromList'@. Unwrapping returns some permutation of the list.+-- | Use @'_Wrapping' 'HashMap.fromList'@. Unwrapping returns some permutation of the list. instance (t ~ HashMap k' a', Hashable k, Eq k) => Rewrapped (HashMap k a) t instance (Hashable k, Eq k) => Wrapped (HashMap k a) where   type Unwrapped (HashMap k a) = [(k, a)]   _Wrapped' = iso HashMap.toList HashMap.fromList   {-# INLINE _Wrapped' #-} --- | Use @'wrapping' 'HashSet.fromList'@. Unwrapping returns some permutation of the list.+-- | Use @'_Wrapping' 'HashSet.fromList'@. Unwrapping returns some permutation of the list. instance (t ~ HashSet a', Hashable a, Eq a) => Rewrapped (HashSet a) t instance (Hashable a, Eq a) => Wrapped (HashSet a) where   type Unwrapped (HashSet a) = [a]@@ -584,28 +587,28 @@  -- * containers --- | Use @'wrapping' 'IntMap.fromList'@. unwrapping returns a /sorted/ list.+-- | Use @'_Wrapping' 'IntMap.fromList'@. unwrapping returns a /sorted/ list. instance (t ~ IntMap a') => Rewrapped (IntMap a) t instance Wrapped (IntMap a) where   type Unwrapped (IntMap a) = [(Int, a)]   _Wrapped' = iso IntMap.toAscList IntMap.fromList   {-# INLINE _Wrapped' #-} --- | Use @'wrapping' 'IntSet.fromList'@. unwrapping returns a /sorted/ list.+-- | Use @'_Wrapping' 'IntSet.fromList'@. unwrapping returns a /sorted/ list. instance (t ~ IntSet) => Rewrapped IntSet t instance Wrapped IntSet where   type Unwrapped IntSet = [Int]   _Wrapped' = iso IntSet.toAscList IntSet.fromList   {-# INLINE _Wrapped' #-} --- | Use @'wrapping' 'Map.fromList'@. unwrapping returns a /sorted/ list.+-- | Use @'_Wrapping' 'Map.fromList'@. unwrapping returns a /sorted/ list. instance (t ~ Map k' a', Ord k) => Rewrapped (Map k a) t instance Ord k => Wrapped (Map k a) where   type Unwrapped (Map k a) = [(k, a)]   _Wrapped' = iso Map.toAscList Map.fromList   {-# INLINE _Wrapped' #-} --- | Use @'wrapping' 'Set.fromList'@. unwrapping returns a /sorted/ list.+-- | Use @'_Wrapping' 'Set.fromList'@. unwrapping returns a /sorted/ list. instance (t ~ Set a', Ord a) => Rewrapped (Set a) t instance Ord a => Wrapped (Set a) where   type Unwrapped (Set a) = [a]@@ -676,6 +679,14 @@   _Wrapped' = iso Storable.toList Storable.fromList   {-# INLINE _Wrapped' #-} +#if MIN_VERSION_vector(0,13,2)+instance (t ~ Vector.Vector a') => Rewrapped (VectorStrict.Vector a) t+instance Wrapped (VectorStrict.Vector a) where+  type Unwrapped (VectorStrict.Vector a) = [a]+  _Wrapped' = iso VectorStrict.toList VectorStrict.fromList+  {-# INLINE _Wrapped' #-}+#endif+ -- * semigroupoids  instance (t ~ WrappedApplicative f' a') => Rewrapped (WrappedApplicative f a) t@@ -873,7 +884,11 @@ #endif  getErrorCall :: ErrorCall -> String+#if MIN_VERSION_base(4,21,0)+getErrorCall (ErrorCall x) = x+#else getErrorCall (ErrorCallWithLocation x _) = x+#endif {-# INLINE getErrorCall #-}  getRecUpdError :: RecUpdError -> String@@ -1000,7 +1015,12 @@  instance Rewrapped CSigAtomic t instance Wrapped CSigAtomic where-  type Unwrapped CSigAtomic = HTYPE_SIG_ATOMIC_T+  type Unwrapped CSigAtomic =+#if defined(HTYPE_SIG_ATOMIC_T)+    HTYPE_SIG_ATOMIC_T+#else+    Int32+#endif   _Wrapped' = iso (\(CSigAtomic x) -> x) CSigAtomic   {-# INLINE _Wrapped' #-} @@ -1268,10 +1288,10 @@ # endif #endif --- | Given the constructor for a 'Wrapped' type, return a+-- | Given the constructor for a t'Wrapped' type, return a -- deconstructor that is its inverse. ----- Assuming the 'Wrapped' instance is legal, these laws hold:+-- Assuming the t'Wrapped' instance is legal, these laws hold: -- -- @ -- 'op' f '.' f ≡ 'id'
src/Control/Lens/Zoom.hs view
@@ -46,6 +46,9 @@ import Control.Monad.Trans.Writer.Strict as Strict import Control.Monad.Trans.RWS.Lazy as Lazy import Control.Monad.Trans.RWS.Strict as Strict+#if MIN_VERSION_mtl(2,3,0)+import Control.Monad.Trans.RWS.CPS as CPS+#endif import Control.Monad.Trans.Except import Control.Monad.Trans.Identity import Control.Monad.Trans.Maybe@@ -102,6 +105,9 @@ 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+#if MIN_VERSION_mtl(2,3,0)+type instance Magnified (CPS.RWST a w s m) = EffectRWS w s m+#endif type instance Magnified (IdentityT m) = Magnified m  ------------------------------------------------------------------------------@@ -273,6 +279,12 @@ instance (Monad m, Monoid w) => Magnify (Lazy.RWST b w s m) (Lazy.RWST a w s m) b a where   magnify l (Lazy.RWST m) = Lazy.RWST $ getEffectRWS #. l (EffectRWS #. m)   {-# INLINE magnify #-}++#if MIN_VERSION_mtl(2,3,0)+instance (Monad m, Monoid w, MonadReader b (CPS.RWST b w s m)) => Magnify (CPS.RWST b w s m) (CPS.RWST a w s m) b a where+  magnify l m = CPS.rwsT $ getEffectRWS #. l (EffectRWS #. CPS.runRWST m)+  {-# INLINE magnify #-}+#endif  instance Magnify m n b a => Magnify (IdentityT m) (IdentityT n) b a where   magnify l (IdentityT m) = IdentityT (magnify l m)
src/Control/Monad/Error/Lens.hs view
@@ -44,23 +44,23 @@ -- Catching ------------------------------------------------------------------------------ --- | Catch exceptions that match a given 'Prism' (or any 'Getter', really).+-- | Catch exceptions that match a given t'Prism' (or any t'Getter', really). -- -- @ -- 'catching' :: 'MonadError' e m => 'Prism'' e a     -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadError' e m => 'Lens'' e a      -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadError' e m => 'Traversal'' e a -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadError' e m => 'Iso'' e a       -> m r -> (a -> m r) -> m r--- 'catching' :: 'MonadError' e m => 'Getter' e a     -> m r -> (a -> m r) -> m r--- 'catching' :: 'MonadError' e m => 'Fold' e a       -> m r -> (a -> m r) -> m r+-- 'catching' :: 'MonadError' e m => t'Getter' e a    -> m r -> (a -> m r) -> m r+-- 'catching' :: 'MonadError' e m => t'Fold' e a      -> m r -> (a -> m r) -> m r -- @ catching :: MonadError e m => Getting (M.First a) e a -> m r -> (a -> m r) -> m r catching l = catchJust (preview l) {-# INLINE catching #-} --- | Catch exceptions that match a given 'Prism' (or any 'Getter'), discarding+-- | Catch exceptions that match a given t'Prism' (or any t'Getter'), discarding -- the information about the match. This is particularly useful when you have--- a @'Prism'' e ()@ where the result of the 'Prism' or 'Fold' isn't+-- a @'Prism'' e ()@ where the result of the t'Prism' or t'Fold' isn't -- particularly valuable, just the fact that it matches. -- -- @@@ -68,8 +68,8 @@ -- 'catching_' :: 'MonadError' e m => 'Lens'' e a      -> m r -> m r -> m r -- 'catching_' :: 'MonadError' e m => 'Traversal'' e a -> m r -> m r -> m r -- 'catching_' :: 'MonadError' e m => 'Iso'' e a       -> m r -> m r -> m r--- 'catching_' :: 'MonadError' e m => 'Getter' e a     -> m r -> m r -> m r--- 'catching_' :: 'MonadError' e m => 'Fold' e a       -> m r -> m r -> m r+-- 'catching_' :: 'MonadError' e m => t'Getter' e a    -> m r -> m r -> m r+-- 'catching_' :: 'MonadError' e m => t'Fold' e a      -> m r -> m r -> m r -- @ catching_ :: MonadError e m => Getting (M.First a) e a -> m r -> m r -> m r catching_ l a b = catchJust (preview l) a (const b)@@ -87,8 +87,8 @@ -- 'handling' :: 'MonadError' e m => 'Lens'' e a      -> (a -> m r) -> m r -> m r -- 'handling' :: 'MonadError' e m => 'Traversal'' e a -> (a -> m r) -> m r -> m r -- 'handling' :: 'MonadError' e m => 'Iso'' e a       -> (a -> m r) -> m r -> m r--- 'handling' :: 'MonadError' e m => 'Fold' e a       -> (a -> m r) -> m r -> m r--- 'handling' :: 'MonadError' e m => 'Getter' e a     -> (a -> m r) -> m r -> m r+-- 'handling' :: 'MonadError' e m => t'Fold' e a      -> (a -> m r) -> m r -> m r+-- 'handling' :: 'MonadError' e m => t'Getter' e a    -> (a -> m r) -> m r -> m r -- @ handling :: MonadError e m => Getting (M.First a) e a -> (a -> m r) -> m r -> m r handling l = flip (catching l)@@ -102,8 +102,8 @@ -- 'handling_' :: 'MonadError' e m => 'Lens'' e a      -> m r -> m r -> m r -- 'handling_' :: 'MonadError' e m => 'Traversal'' e a -> m r -> m r -> m r -- 'handling_' :: 'MonadError' e m => 'Iso'' e a       -> m r -> m r -> m r--- 'handling_' :: 'MonadError' e m => 'Getter' e a     -> m r -> m r -> m r--- 'handling_' :: 'MonadError' e m => 'Fold' e a       -> m r -> m r -> m r+-- 'handling_' :: 'MonadError' e m => t'Getter' e a    -> m r -> m r -> m r+-- 'handling_' :: 'MonadError' e m => t'Fold' e a      -> m r -> m r -> m r -- @ handling_ :: MonadError e m => Getting (M.First a) e a -> m r -> m r -> m r handling_ l = flip (catching_ l)@@ -113,16 +113,16 @@ -- Trying ------------------------------------------------------------------------------ --- | 'trying' takes a 'Prism' (or any 'Getter') to select which exceptions are caught--- If the 'Exception' does not match the predicate, it is re-thrown.+-- | 'trying' takes a t'Prism' (or any t'Getter') to select which exceptions are caught+-- If the exception does not match the predicate, it is re-thrown. -- -- @ -- 'trying' :: 'MonadError' e m => 'Prism'' e a     -> m r -> m ('Either' a r) -- 'trying' :: 'MonadError' e m => 'Lens'' e a      -> m r -> m ('Either' a r) -- 'trying' :: 'MonadError' e m => 'Traversal'' e a -> m r -> m ('Either' a r) -- 'trying' :: 'MonadError' e m => 'Iso'' e a       -> m r -> m ('Either' a r)--- 'trying' :: 'MonadError' e m => 'Getter' e a     -> m r -> m ('Either' a r)--- 'trying' :: 'MonadError' e m => 'Fold' e a       -> m r -> m ('Either' a r)+-- 'trying' :: 'MonadError' e m => t'Getter' e a    -> m r -> m ('Either' a r)+-- 'trying' :: 'MonadError' e m => t'Fold' e a      -> m r -> m ('Either' a r) -- @ trying :: MonadError e m => Getting (M.First a) e a -> m r -> m (Either a r) trying l m = catching l (liftM Right m) (return . Left)@@ -206,13 +206,13 @@ -- Throwing ------------------------------------------------------------------------------ --- | Throw an 'Exception' described by a 'Prism'.+-- | Throw an exception described by a t'Prism'. -- -- @'throwing' l ≡ 'reviews' l 'throwError'@ -- -- @--- 'throwing' :: 'MonadError' e m => 'Prism'' e t -> t -> a--- 'throwing' :: 'MonadError' e m => 'Iso'' e t   -> t -> a+-- 'throwing' :: 'MonadError' e m => 'Prism'' e t -> t -> m a+-- 'throwing' :: 'MonadError' e m => 'Iso'' e t   -> t -> m a -- @ throwing :: MonadError e m => AReview e t -> t -> m x throwing l = reviews l throwError
src/Control/Parallel/Strategies/Lens.hs view
@@ -14,7 +14,7 @@ -- Stability   :  provisional -- Portability :  portable ----- A 'Lens' or 'Traversal' can be used to take the role of 'Traversable' in+-- A t'Lens' or t'Traversal' can be used to take the role of 'Traversable' in -- @Control.Parallel.Strategies@, enabling those combinators to work with -- monomorphic containers. ----------------------------------------------------------------------------@@ -28,7 +28,7 @@ import Control.Lens import Control.Parallel.Strategies --- | Evaluate the targets of a 'Lens' or 'Traversal' into a data structure+-- | Evaluate the targets of a t'Lens' or t'Traversal' into a data structure -- according to the given 'Strategy'. -- -- @@@ -45,7 +45,7 @@ evalOf l = l {-# INLINE evalOf #-} --- | Evaluate the targets of a 'Lens' or 'Traversal' according into a+-- | Evaluate the targets of a t'Lens' or t'Traversal' according into a -- data structure according to a given 'Strategy' in parallel. -- -- @'parTraversable' = 'parOf' 'traverse'@@@ -59,7 +59,7 @@ parOf l s = l (rparWith s) {-# INLINE parOf #-} --- | Transform a 'Lens', 'Fold', 'Getter', 'Setter' or 'Traversal' to+-- | Transform a t'Lens', t'Fold', t'Getter', t'Setter' or t'Traversal' to -- first evaluates its argument according to a given 'Strategy' /before/ proceeding. -- -- @@@ -69,7 +69,7 @@ after s l f = l f $| s {-# INLINE after #-} --- | Transform a 'Lens', 'Fold', 'Getter', 'Setter' or 'Traversal' to+-- | Transform a t'Lens', t'Fold', t'Getter', t'Setter' or t'Traversal' to -- evaluate its argument according to a given 'Strategy' /in parallel with/ evaluating. -- -- @
src/Control/Seq/Lens.hs view
@@ -7,7 +7,7 @@ -- Stability   :  provisional -- Portability :  portable ----- A 'Fold' can be used to take the role of 'Foldable' in @Control.Seq@.+-- A t'Fold' can be used to take the role of 'Foldable' in @Control.Seq@. ---------------------------------------------------------------------------- module Control.Seq.Lens   ( seqOf@@ -17,8 +17,8 @@ import Control.Seq import Data.Monoid --- | Evaluate the elements targeted by a 'Lens', 'Traversal', 'Iso',--- 'Getter' or 'Fold' according to the given strategy.+-- | Evaluate the elements targeted by a t'Lens', t'Traversal', t'Iso',+-- t'Getter' or t'Fold' according to the given strategy. -- -- @'seqFoldable' = 'seqOf' 'folded'@ seqOf :: Getting (Endo [a]) s a -> Strategy a -> Strategy s
src/Data/Array/Lens.hs view
@@ -18,10 +18,10 @@ import Control.Lens import Data.Array.IArray hiding (index) --- | This 'setter' can be used to derive a new 'IArray' from an old 'IAarray' by+-- | This t'Setter' can be used to derive a new 'IArray' from an old 'IArray' by -- applying a function to each of the indices to look it up in the old 'IArray'. ----- This is a /contravariant/ 'Setter'.+-- This is a /contravariant/ t'Setter'. -- -- @ -- 'ixmap' ≡ 'over' '.' 'ixmapped'
src/Data/Bits/Lens.hs view
@@ -37,31 +37,31 @@ infixr 4 .|.~, .&.~, <.|.~, <.&.~, <<.|.~, <<.&.~ infix 4 .|.=, .&.=, <.|.=, <.&.=, <<.|.=, <<.&.= --- | Bitwise '.|.' the target(s) of a 'Lens' or 'Setter'.+-- | Bitwise '.|.' the target(s) of a t'Lens' or t'Setter'. -- -- >>> _2 .|.~ 6 $ ("hello",3) -- ("hello",7) -- -- @--- ('.|.~') :: 'Bits' a             => 'Setter' s t a a    -> a -> s -> t--- ('.|.~') :: 'Bits' a             => 'Iso' s t a a       -> a -> s -> t--- ('.|.~') :: 'Bits' a             => 'Lens' s t a a      -> a -> s -> t--- ('.|.~') :: ('Data.Monoid.Monoid' a, 'Bits' a) => 'Traversal' s t a a -> a -> s -> t+-- ('.|.~') :: 'Bits' a             => t'Setter' s t a a    -> a -> s -> t+-- ('.|.~') :: 'Bits' a             => t'Iso' s t a a       -> a -> s -> t+-- ('.|.~') :: 'Bits' a             => t'Lens' s t a a      -> a -> s -> t+-- ('.|.~') :: ('Data.Monoid.Monoid' a, 'Bits' a) => t'Traversal' s t a a -> a -> s -> t -- @ (.|.~):: Bits a => ASetter s t a a -> a -> s -> t l .|.~ n = over l (.|. n) {-# INLINE (.|.~) #-} --- | Bitwise '.&.' the target(s) of a 'Lens' or 'Setter'.+-- | Bitwise '.&.' the target(s) of a t'Lens' or t'Setter'. -- -- >>> _2 .&.~ 7 $ ("hello",254) -- ("hello",6) -- -- @--- ('.&.~') :: 'Bits' a             => 'Setter' s t a a    -> a -> s -> t--- ('.&.~') :: 'Bits' a             => 'Iso' s t a a       -> a -> s -> t--- ('.&.~') :: 'Bits' a             => 'Lens' s t a a      -> a -> s -> t--- ('.&.~') :: ('Data.Monoid.Monoid' a, 'Bits' a) => 'Traversal' s t a a -> a -> s -> t+-- ('.&.~') :: 'Bits' a             => t'Setter' s t a a    -> a -> s -> t+-- ('.&.~') :: 'Bits' a             => t'Iso' s t a a       -> a -> s -> t+-- ('.&.~') :: 'Bits' a             => t'Lens' s t a a      -> a -> s -> t+-- ('.&.~') :: ('Data.Monoid.Monoid' a, 'Bits' a) => t'Traversal' s t a a -> a -> s -> t -- @ (.&.~) :: Bits a => ASetter s t a a -> a -> s -> t l .&.~ n = over l (.&. n)@@ -82,7 +82,7 @@ l .&.= a = modify (l .&.~ a) {-# INLINE (.&.=) #-} --- | Modify the target(s) of a 'Lens'', 'Setter' or 'Traversal' by computing its bitwise '.|.' with another value.+-- | Modify the target(s) of a 'Lens'', t'Setter' or t'Traversal' by computing its bitwise '.|.' with another value. -- -- >>> execState (do _1 .|.= 15; _2 .|.= 3) (7,7) -- (15,7)@@ -97,31 +97,31 @@ l .|.= a = modify (l .|.~ a) {-# INLINE (.|.=) #-} --- | Bitwise '.|.' the target(s) of a 'Lens' (or 'Traversal'), returning the result+-- | Bitwise '.|.' the target(s) of a t'Lens' (or t'Traversal'), returning the result -- (or a monoidal summary of all of the results). -- -- >>> _2 <.|.~ 6 $ ("hello",3) -- (7,("hello",7)) -- -- @--- ('<.|.~') :: 'Bits' a             => 'Iso' s t a a       -> a -> s -> (a, t)--- ('<.|.~') :: 'Bits' a             => 'Lens' s t a a      -> a -> s -> (a, t)--- ('<.|.~') :: ('Bits' a, 'Data.Monoid.Monoid' a) => 'Traversal' s t a a -> a -> s -> (a, t)+-- ('<.|.~') :: 'Bits' a             => t'Iso' s t a a       -> a -> s -> (a, t)+-- ('<.|.~') :: 'Bits' a             => t'Lens' s t a a      -> a -> s -> (a, t)+-- ('<.|.~') :: ('Bits' a, 'Data.Monoid.Monoid' a) => t'Traversal' s t a a -> a -> s -> (a, t) -- @ (<.|.~):: Bits a => LensLike ((,) a) s t a a -> a -> s -> (a, t) l <.|.~ n = l <%~ (.|. n) {-# INLINE (<.|.~) #-} --- | Bitwise '.&.' the target(s) of a 'Lens' or 'Traversal', returning the result+-- | Bitwise '.&.' the target(s) of a t'Lens' or t'Traversal', returning the result -- (or a monoidal summary of all of the results). -- -- >>> _2 <.&.~ 7 $ ("hello",254) -- (6,("hello",6)) -- -- @--- ('<.&.~') :: 'Bits' a             => 'Iso'       s t a a -> a -> s -> (a, t)--- ('<.&.~') :: 'Bits' a             => 'Lens'      s t a a -> a -> s -> (a, t)--- ('<.&.~') :: ('Bits' a, 'Data.Monoid.Monoid' a) => 'Traversal' s t a a -> a -> s -> (a, t)+-- ('<.&.~') :: 'Bits' a             => t'Iso'       s t a a -> a -> s -> (a, t)+-- ('<.&.~') :: 'Bits' a             => t'Lens'      s t a a -> a -> s -> (a, t)+-- ('<.&.~') :: ('Bits' a, 'Data.Monoid.Monoid' a) => t'Traversal' s t a a -> a -> s -> (a, t) -- @ (<.&.~) :: Bits a => LensLike ((,) a) s t a a -> a -> s -> (a, t) l <.&.~ n = l <%~ (.&. n)@@ -141,7 +141,7 @@ l <.&.= b = l <%= (.&. b) {-# INLINE (<.&.=) #-} --- | Modify the target(s) of a 'Lens'', (or 'Traversal') by computing its bitwise '.|.' with another value,+-- | Modify the target(s) of a 'Lens'', (or t'Traversal') by computing its bitwise '.|.' with another value, -- returning the result (or a monoidal summary of all of the results traversed). -- -- >>> runState (_1 <.|.= 7) (28,0)@@ -155,7 +155,7 @@ l <.|.= b = l <%= (.|. b) {-# INLINE (<.|.=) #-} --- | Bitwise '.&.' the target(s) of a 'Lens' or 'Traversal', and return the+-- | Bitwise '.&.' the target(s) of a t'Lens' or t'Traversal', and return the -- original value, or a monoidal summary of the original values. -- -- When you do not need the old value, ('.&.~') is more flexible.@@ -164,15 +164,15 @@ -- (254,("hello",6)) -- -- @--- ('<<.&.~') ::  'Bits' a            => 'Iso' s t a a       -> a -> s -> (a, t)--- ('<<.&.~') ::  'Bits' a            => 'Lens' s t a a      -> a -> s -> (a, t)--- ('<<.&.~') :: ('Bits' a, 'Data.Monoid.Monoid' a) => 'Traversal' s t a a -> a -> s -> (a, t)+-- ('<<.&.~') ::  'Bits' a            => t'Iso' s t a a       -> a -> s -> (a, t)+-- ('<<.&.~') ::  'Bits' a            => t'Lens' s t a a      -> a -> s -> (a, t)+-- ('<<.&.~') :: ('Bits' a, 'Data.Monoid.Monoid' a) => t'Traversal' s t a a -> a -> s -> (a, t) -- @ (<<.&.~) :: Bits a => Optical' (->) q ((,)a) s a -> a -> q s (a, s) l <<.&.~ b = l $ \a -> (a, a .&. b) {-# INLINE (<<.&.~) #-} --- | Bitwise '.|.' the target(s) of a 'Lens' or 'Traversal', and return the+-- | Bitwise '.|.' the target(s) of a t'Lens' or t'Traversal', and return the -- original value, or a monoidal summary of the original values. -- -- When you do not need the old value, ('.|.~') is more flexible.@@ -181,9 +181,9 @@ -- (3,("hello",7)) -- -- @--- ('<<.|.~') ::  'Bits' a            => 'Iso' s t a a       -> a -> s -> (a, t)--- ('<<.|.~') ::  'Bits' a            => 'Lens' s t a a      -> a -> s -> (a, t)--- ('<<.|.~') :: ('Bits' a, 'Data.Monoid.Monoid' a) => 'Traversal' s t a a -> a -> s -> (a, t)+-- ('<<.|.~') ::  'Bits' a            => t'Iso' s t a a       -> a -> s -> (a, t)+-- ('<<.|.~') ::  'Bits' a            => t'Lens' s t a a      -> a -> s -> (a, t)+-- ('<<.|.~') :: ('Bits' a, 'Data.Monoid.Monoid' a) => t'Traversal' s t a a -> a -> s -> (a, t) -- @ (<<.|.~) :: Bits a => Optical' (->) q ((,)a) s a -> a -> q s (a, s) l <<.|.~ b = l $ \a -> (a, a .|. b)@@ -223,9 +223,9 @@ l <<.|.= b = l %%= \a -> (a, a .|. b) {-# INLINE (<<.|.=) #-} --- | This 'Lens' can be used to access the value of the nth bit in a number.+-- | This t'Lens' can be used to access the value of the nth bit in a number. ----- @'bitAt' n@ is only a legal 'Lens' into @b@ if @0 '<=' n '<' 'bitSize' ('undefined' :: b)@.+-- @'bitAt' n@ is only a legal t'Lens' into @b@ if @0 '<=' n '<' 'bitSize' ('undefined' :: b)@. -- -- >>> 16^.bitAt 4 -- True@@ -244,7 +244,7 @@  -- | Get the nth byte, counting from the low end. ----- @'byteAt' n@ is a legal 'Lens' into @b@ iff @0 '<=' n '<' 'div' ('bitSize' ('undefined' :: b)) 8@+-- @'byteAt' n@ is a legal t'Lens' into @b@ iff @0 '<=' n '<' 'div' ('bitSize' ('undefined' :: b)) 8@ -- -- >>> (0xff00 :: Word16)^.byteAt 0 -- 0@@ -271,7 +271,7 @@ -- >>> toListOf bits (5 :: Word8) -- [True,False,True,False,False,False,False,False] ----- If you supply this an 'Integer', the result will be an infinite 'Traversal', which+-- If you supply this an 'Integer', the result will be an infinite t'Traversal', which -- can be productively consumed, but not reassembled. bits :: (Num b, Bits b) => IndexedTraversal' Int b Bool bits f b = foldr step 0 <$> traverse g bs where@@ -289,7 +289,7 @@ -- >>> toListOf bytewise (1312301580 :: Word32) -- [12,34,56,78] ----- If you supply this an 'Integer', the result will be an infinite 'Traversal',+-- If you supply this an 'Integer', the result will be an infinite t'Traversal', -- which can be productively consumed, but not reassembled. -- -- Why isn't this function called @bytes@ to match 'bits'? Alas, there
src/Data/ByteString/Lazy/Lens.hs view
@@ -65,7 +65,7 @@  -- | Traverse the individual bytes in a 'ByteString'. ----- This 'Traversal' walks each strict 'ByteString' chunk in a tree-like fashion+-- This t'Traversal' walks each strict 'ByteString' chunk in a tree-like fashion -- enable zippers to seek to locations more quickly and accelerate -- many monoidal queries, but up to associativity (and constant factors) it is -- equivalent to the much slower:@@ -77,7 +77,7 @@ -- >>> anyOf bytes (== 0x80) (Char8.pack "hello") -- False ----- Note that when just using this as a 'Setter', @'setting' 'Data.ByteString.Lazy.map'@+-- Note that when just using this as a t'Setter', @'setting' 'Data.ByteString.Lazy.map'@ -- can be more efficient. bytes :: IndexedTraversal' Int64 ByteString Word8 bytes = traversedLazy@@ -122,7 +122,7 @@ -- When writing back to the 'ByteString' it is assumed that every 'Char' -- lies between @'\x00'@ and @'\xff'@. ----- This 'Traversal' walks each strict 'ByteString' chunk in a tree-like fashion+-- This t'Traversal' walks each strict 'ByteString' chunk in a tree-like fashion -- enable zippers to seek to locations more quickly and accelerate -- many monoidal queries, but up to associativity (and constant factors) it is -- equivalent to:
src/Data/ByteString/Lens.hs view
@@ -53,7 +53,7 @@   -- | Traverse each 'Word8' in a strict or lazy 'ByteString'   --   ---  -- This 'Traversal' walks each strict 'ByteString' chunk in a tree-like fashion+  -- This t'Traversal' walks each strict 'ByteString' chunk in a tree-like fashion   -- enable zippers to seek to locations more quickly and accelerate   -- many monoidal queries, but up to associativity (and constant factors) it is   -- equivalent to the much slower:@@ -74,7 +74,7 @@   -- When writing back to the 'ByteString' it is assumed that every 'Char'   -- lies between @'\x00'@ and @'\xff'@.   ---  -- This 'Traversal' walks each strict 'ByteString' chunk in a tree-like fashion+  -- This t'Traversal' walks each strict 'ByteString' chunk in a tree-like fashion   -- enable zippers to seek to locations more quickly and accelerate   -- many monoidal queries, but up to associativity (and constant factors) it is   -- equivalent to the much slower:
src/Data/ByteString/Strict/Lens.hs view
@@ -63,7 +63,7 @@  -- | Traverse each 'Word8' in a 'ByteString'. ----- This 'Traversal' walks the 'ByteString' in a tree-like fashion+-- This t'Traversal' walks the 'ByteString' in a tree-like fashion -- enable zippers to seek to locations in logarithmic time and accelerating -- many monoidal queries, but up to associativity (and constant factors) -- it is equivalent to the much slower:@@ -75,7 +75,7 @@ -- >>> anyOf bytes (== 0x80) (Char8.pack "hello") -- False ----- Note that when just using this as a 'Setter', @'setting' 'Data.ByteString.map'@+-- Note that when just using this as a t'Setter', @'setting' 'Data.ByteString.map'@ -- can be more efficient. bytes :: IndexedTraversal' Int ByteString Word8 bytes = traversedStrictTree@@ -120,7 +120,7 @@ -- When writing back to the 'ByteString' it is assumed that every 'Char' -- lies between @'\x00'@ and @'\xff'@. ----- This 'Traversal' walks the 'ByteString' in a tree-like fashion+-- This t'Traversal' walks the 'ByteString' in a tree-like fashion -- enable zippers to seek to locations in logarithmic time and accelerating -- many monoidal queries, but up to associativity (and constant factors) -- it is equivalent to the much slower:
src/Data/Complex/Lens.hs view
@@ -67,7 +67,7 @@ _imagPart f (a :+ b) = (a :+) <$> f b {-# INLINE _imagPart #-} --- | This isn't /quite/ a legal 'Lens'. Notably the+-- | This isn't /quite/ a legal t'Lens'. Notably the -- -- @'view' l ('set' l b a) = b@ --@@ -76,7 +76,7 @@ -- which flips the 'phase' and retains a positive 'magnitude'. So don't do -- that! ----- Otherwise, this is a perfectly cromulent 'Lens'.+-- Otherwise, this is a perfectly cromulent t'Lens'. _polar :: RealFloat a => Iso' (Complex a) (a,a) _polar = iso polar (uncurry mkPolar) {-# INLINE _polar #-}@@ -96,14 +96,14 @@ -- >>> (10.0 :+ 20.0) & _magnitude *~ 2 -- 20.0 :+ 40.0 ----- This isn't /quite/ a legal 'Lens'. Notably the+-- This isn't /quite/ a legal t'Lens'. Notably the -- -- @'view' l ('set' l b a) = b@ -- -- law is violated when you set a negative 'magnitude'. This flips the 'phase' -- and retains a positive 'magnitude'. So don't do that! ----- Otherwise, this is a perfectly cromulent 'Lens'.+-- Otherwise, this is a perfectly cromulent t'Lens'. -- -- Setting the 'magnitude' of a zero 'Complex' number assumes the 'phase' is 0. _magnitude :: RealFloat a => Lens' (Complex a) a@@ -118,14 +118,14 @@ -- >>> (mkPolar 10 (2-pi) & _phase +~ pi & view _phase) ≈ 2 -- True ----- This isn't /quite/ a legal 'Lens'. Notably the+-- This isn't /quite/ a legal t'Lens'. Notably the -- -- @'view' l ('set' l b a) = b@ -- -- law is violated when you set a 'phase' outside the range @(-'pi', 'pi']@. -- The phase is always in that range when queried. So don't do that! ----- Otherwise, this is a perfectly cromulent 'Lens'.+-- Otherwise, this is a perfectly cromulent t'Lens'. _phase :: RealFloat a => Lens' (Complex a) a _phase f c = setPhase <$> f theta   where setPhase theta' = c * cis (theta' - theta)
src/Data/Data/Lens.hs view
@@ -12,12 +12,6 @@ {-# LANGUAGE Trustworthy #-} #endif {-# OPTIONS_GHC -fno-full-laziness #-}-#if __GLASGOW_HASKELL__ >= 810--- Use -fbyte-code explicitly to ensure that -fobject-code isn't automatically--- implied on GHCi 8.10+ by the use of UnboxedTuples, as this breaks the--- doctests. See #874 for more details.-{-# OPTIONS_GHC -fbyte-code #-}-#endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.Data.Lens@@ -77,6 +71,8 @@ -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens+-- >>> import Control.Lens.Internal.Doctest+-- >>> import Prelude hiding (head, tail)  ------------------------------------------------------------------------------- -- Generic Traversal
src/Data/Dynamic/Lens.hs view
@@ -22,16 +22,16 @@ import Control.Lens import Data.Dynamic --- | Any 'Dynamic' can be thrown as an 'Exception'+-- | Any t'Dynamic' can be thrown as an t'Exception' class AsDynamic t where-  -- | This 'Prism' allows you to traverse the typed value contained in a-  -- 'Dynamic' where the type required by your function matches that-  -- of the contents of the 'Dynamic', or construct a 'Dynamic' value-  -- out of whole cloth. It can also be used to catch or throw a 'Dynamic'+  -- | This t'Prism' allows you to traverse the typed value contained in a+  -- t'Dynamic' where the type required by your function matches that+  -- of the contents of the t'Dynamic', or construct a t'Dynamic' value+  -- out of whole cloth. It can also be used to catch or throw a t'Dynamic'   -- value as 'SomeException'.   --   -- @-  -- '_Dynamic' :: 'Typeable' a => 'Prism'' 'Dynamic'       a+  -- '_Dynamic' :: 'Typeable' a => 'Prism'' t'Dynamic'      a   -- '_Dynamic' :: 'Typeable' a => 'Prism'' 'SomeException' a   -- @   _Dynamic :: Typeable a => Prism' t a
src/Data/IntSet/Lens.hs view
@@ -24,7 +24,7 @@ -- >>> import Control.Lens -- >>> import qualified Data.IntSet as IntSet --- | IntSet isn't Foldable, but this 'Fold' can be used to access the members of an 'IntSet'.+-- | IntSet isn't Foldable, but this t'Fold' can be used to access the members of an 'IntSet'. -- -- >>> sumOf members $ setOf folded [1,2,3,4] -- 10@@ -32,10 +32,10 @@ members = folding IntSet.toAscList {-# INLINE members #-} --- | This 'Setter' can be used to change the contents of an 'IntSet' by mapping+-- | This t'Setter' can be used to change the contents of an 'IntSet' by mapping -- the elements to new values. ----- Sadly, you can't create a valid 'Traversal' for a 'Set', because the number of+-- Sadly, you can't create a valid t'Traversal' for an 'IntSet', because the number of -- elements might change but you can manipulate it by reading using 'folded' and -- reindexing it via 'setmapped'. --@@ -45,7 +45,7 @@ setmapped = setting IntSet.map {-# INLINE setmapped #-} --- | Construct an 'IntSet' from a 'Getter', 'Fold', 'Traversal', 'Lens' or 'Iso'.+-- | Construct an 'IntSet' from a t'Getter', t'Fold', t'Traversal', t'Lens' or t'Iso'. -- -- >>> setOf folded [1,2,3,4] -- fromList [1,2,3,4]@@ -54,11 +54,11 @@ -- fromList [1,2,3] -- -- @--- 'setOf' :: 'Getter' s 'Int'     -> s -> 'IntSet'--- 'setOf' :: 'Fold' s 'Int'       -> s -> 'IntSet'--- 'setOf' :: 'Iso'' s 'Int'       -> s -> 'IntSet'--- 'setOf' :: 'Lens'' s 'Int'      -> s -> 'IntSet'--- 'setOf' :: 'Traversal'' s 'Int' -> s -> 'IntSet'+-- 'setOf' :: t'Getter' s 'Int'     -> s -> 'IntSet'+-- 'setOf' :: t'Fold' s 'Int'       -> s -> 'IntSet'+-- 'setOf' :: t'Iso'' s 'Int'       -> s -> 'IntSet'+-- 'setOf' :: t'Lens'' s 'Int'      -> s -> 'IntSet'+-- 'setOf' :: t'Traversal'' s 'Int' -> s -> 'IntSet' -- @ setOf :: Getting IntSet s Int -> s -> IntSet setOf l = views l IntSet.singleton
src/Data/Sequence/Lens.hs view
@@ -122,7 +122,7 @@      (m, r) -> itraverse (indexed f . (+i)) m <&> \n -> l >< n >< r {-# INLINE sliced #-} --- | Construct a 'Seq' from a 'Getter', 'Control.Lens.Fold.Fold', 'Control.Lens.Traversal.Traversal', 'Control.Lens.Lens.Lens' or 'Control.Lens.Iso.Iso'.+-- | Construct a 'Seq' from a t'Getter', 'Control.Lens.Fold.Fold', 'Control.Lens.Traversal.Traversal', 'Control.Lens.Lens.Lens' or 'Control.Lens.Iso.Iso'. -- -- >>> seqOf folded ["hello","world"] -- fromList ["hello","world"]@@ -131,8 +131,8 @@ -- fromList [1,2,3] -- -- @--- 'seqOf' :: 'Getter' s a     -> s -> 'Seq' a--- 'seqOf' :: 'Fold' s a       -> s -> 'Seq' a+-- 'seqOf' :: t'Getter' s a    -> s -> 'Seq' a+-- 'seqOf' :: t'Fold' s a      -> s -> 'Seq' a -- 'seqOf' :: 'Iso'' s a       -> s -> 'Seq' a -- 'seqOf' :: 'Lens'' s a      -> s -> 'Seq' a -- 'seqOf' :: 'Traversal'' s a -> s -> 'Seq' a
src/Data/Tree/Lens.hs view
@@ -27,7 +27,7 @@ -- >>> import Control.Lens -- >>> import Data.Tree --- | A 'Lens' that focuses on the root of a 'Tree'.+-- | A t'Lens' that focuses on the root of a 'Tree'. -- -- >>> view root $ Node 42 [] -- 42@@ -35,7 +35,7 @@ root f (Node a as) = (`Node` as) <$> f a {-# INLINE root #-} --- | A 'Lens' returning the direct descendants of the root of a 'Tree'+-- | A t'Lens' returning the direct descendants of the root of a 'Tree' -- -- @'view' 'branches' ≡ 'subForest'@ branches :: Lens' (Tree a) [Tree a]
src/Data/Vector/Lens.hs view
@@ -40,14 +40,14 @@ -- >>> import qualified Data.Vector as Vector -- >>> import Control.Lens --- | @sliced i n@ provides a 'Lens' that edits the @n@ elements starting--- at index @i@ from a 'Lens'.+-- | @sliced i n@ provides a t'Lens' that edits the @n@ elements starting+-- at index @i@ from a t'Lens'. ----- This is only a valid 'Lens' if you do not change the length of the+-- This is only a valid t'Lens' if you do not change the length of the -- resulting 'Vector'. -- -- Attempting to return a longer or shorter vector will result in--- violations of the 'Lens' laws.+-- violations of the t'Lens' laws. -- -- >>> Vector.fromList [1..10] ^. sliced 2 5 == Vector.fromList [3,4,5,6,7] -- True@@ -88,7 +88,7 @@ forced = iso V.force V.force {-# INLINE forced #-} --- | This 'Traversal' will ignore any duplicates in the supplied list+-- | This t'Traversal' will ignore any duplicates in the supplied list -- of indices. -- -- >>> toListOf (ordinals [1,3,2,5,9,10]) $ Vector.fromList [2,4..40]
src/Language/Haskell/TH/Lens.hs view
@@ -128,6 +128,9 @@ #if MIN_VERSION_template_haskell(2,19,0)   , _DefaultD #endif+#if MIN_VERSION_template_haskell(2,20,0)+  , _TypeDataD+#endif #if MIN_VERSION_template_haskell(2,12,0)   -- ** PatSynDir Prisms   , _Unidir@@ -145,6 +148,12 @@   , _ForallC   , _GadtC   , _RecGadtC+#if MIN_VERSION_template_haskell(2,22,0)+  -- ** NamespaceSpecifier Prisms+  , _NoNamespaceSpecifier+  , _TypeNamespaceSpecifier+  , _DataNamespaceSpecifier+#endif   -- ** Overlap Prisms   ,_Overlappable   ,_Overlapping@@ -188,6 +197,12 @@ #if MIN_VERSION_template_haskell(2,19,0)   , _OpaqueP #endif+#if MIN_VERSION_template_haskell(2,22,0)+  , _SCCP+#endif+#if MIN_VERSION_template_haskell(2,24,0)+  , _SpecialiseEP+#endif   -- ** Inline Prisms   , _NoInline   , _Inline@@ -255,9 +270,25 @@   , _MDoE   , _ImplicitParamVarE #endif+#if MIN_VERSION_template_haskell(2,18,0)+  , _GetFieldE+  , _ProjectionE+#endif #if MIN_VERSION_template_haskell(2,19,0)   , _LamCasesE #endif+#if MIN_VERSION_template_haskell(2,21,0)+  , _TypedBracketE+  , _TypedSpliceE+#endif+#if MIN_VERSION_template_haskell(2,22,0)+  , _TypeE+#endif+#if MIN_VERSION_template_haskell(2,23,0)+  , _ForallE+  , _ForallVisE+  , _ConstrainedE+#endif   -- ** Body Prisms   , _GuardedB   , _NormalB@@ -311,6 +342,13 @@   , _ListP   , _SigP   , _ViewP+#if MIN_VERSION_template_haskell(2,22,0)+  , _TypeP+  , _InvisP+#endif+#if MIN_VERSION_template_haskell(2,23,0)+  , _OrP+#endif   -- ** Type Prisms   , _ForallT   , _AppT@@ -355,6 +393,11 @@   , _SpecifiedSpec   , _InferredSpec #endif+#if MIN_VERSION_template_haskell(2,21,0)+  -- ** BndrVis Prisms+  , _BndrReq+  , _BndrInvis+#endif   -- ** TyVarBndr Prisms   , _PlainTV   , _KindedTV@@ -386,6 +429,7 @@ import Control.Lens.Getter import Control.Lens.Setter import Control.Lens.Fold+import Control.Lens.Internal.TH import Control.Lens.Iso (Iso', iso) import Control.Lens.Lens import Control.Lens.Prism@@ -403,9 +447,11 @@ import Language.Haskell.TH.Syntax import Data.Word #if MIN_VERSION_template_haskell(2,15,0)-import Control.Lens.Internal.TH (unfoldType) import Data.Foldable as F (foldl') #endif+#if MIN_VERSION_template_haskell(2,18,0)+import Data.List.NonEmpty (NonEmpty)+#endif import Prelude  -- | Has a 'Name'@@ -427,10 +473,18 @@   name f (InfixC l n r)        = (\n' -> InfixC l n' r) <$> f n   name f (ForallC bds ctx con) = ForallC bds ctx <$> name f con   name f (GadtC ns argTys retTy) =-    (\n -> GadtC [n] argTys retTy) <$> f (head ns)+    (\n -> GadtC [n] argTys retTy) <$> f (headGadtConName ns)   name f (RecGadtC ns argTys retTy) =-    (\n -> RecGadtC [n] argTys retTy) <$> f (head ns)+    (\n -> RecGadtC [n] argTys retTy) <$> f (headGadtConName ns) +-- @template-haskell@ maintains the invariant that the list of constructor+-- @Name@s in a 'GadtC' or 'RecGadtC' will always be non-empty.+headGadtConName :: [Name] -> Name+headGadtConName conNames =+  case conNames of+    conName:_ -> conName+    [] -> error "headGadtConName: Unexpected empty list of GADT constructor names"+ instance HasName Foreign where   name f (ImportF cc saf str n ty) =     (\n' -> ImportF cc saf str n' ty) <$> f n@@ -756,7 +810,7 @@   g (TypeFamilyHead n _    _  _ )   = n   s (TypeFamilyHead _ tvbs rs ia) n = TypeFamilyHead n tvbs rs ia -typeFamilyHeadTyVarBndrs :: Lens' TypeFamilyHead [TyVarBndrUnit]+typeFamilyHeadTyVarBndrs :: Lens' TypeFamilyHead [TyVarBndrVis] typeFamilyHeadTyVarBndrs = lens g s where   g (TypeFamilyHead _ tvbs _  _ )      = tvbs   s (TypeFamilyHead n _    rs ia) tvbs = TypeFamilyHead n tvbs rs ia@@ -883,7 +937,7 @@       remitter (ValD x y z) = Just (x, y, z)       remitter _ = Nothing -_TySynD :: Prism' Dec (Name, [TyVarBndrUnit], Type)+_TySynD :: Prism' Dec (Name, [TyVarBndrVis], Type) _TySynD   = prism' reviewer remitter   where@@ -891,7 +945,7 @@       remitter (TySynD x y z) = Just (x, y, z)       remitter _ = Nothing -_ClassD :: Prism' Dec (Cxt, Name, [TyVarBndrUnit], [FunDep], [Dec])+_ClassD :: Prism' Dec (Cxt, Name, [TyVarBndrVis], [FunDep], [Dec]) _ClassD   = prism' reviewer remitter   where@@ -907,6 +961,32 @@       remitter (InstanceD x y z w) = Just (x, y, z, w)       remitter _ = Nothing +#if MIN_VERSION_template_haskell(2,22,0)+_NoNamespaceSpecifier :: Prism' NamespaceSpecifier ()+_NoNamespaceSpecifier+  = prism' reviewer remitter+  where+      reviewer () = NoNamespaceSpecifier+      remitter NoNamespaceSpecifier = Just ()+      remitter _ = Nothing++_TypeNamespaceSpecifier :: Prism' NamespaceSpecifier ()+_TypeNamespaceSpecifier+  = prism' reviewer remitter+  where+      reviewer () = TypeNamespaceSpecifier+      remitter TypeNamespaceSpecifier = Just ()+      remitter _ = Nothing++_DataNamespaceSpecifier :: Prism' NamespaceSpecifier ()+_DataNamespaceSpecifier+  = prism' reviewer remitter+  where+      reviewer () = DataNamespaceSpecifier+      remitter DataNamespaceSpecifier = Just ()+      remitter _ = Nothing+#endif+ _Overlappable  :: Prism' Overlap  () _Overlappable  = prism' reviewer remitter   where@@ -951,6 +1031,20 @@       remitter (ForeignD x) = Just x       remitter _ = Nothing +-- |+-- @+-- _InfixD :: 'Prism'' 'Dec' ('Fixity', 'NamespaceSpecifier', 'Name') -- template-haskell-2.22++-- _InfixD :: 'Prism'' 'Dec' ('Fixity', 'Name')                     -- Earlier versions+-- @+#if MIN_VERSION_template_haskell(2,22,0)+_InfixD :: Prism' Dec (Fixity, NamespaceSpecifier, Name)+_InfixD+  = prism' reviewer remitter+  where+      reviewer (x, y, z) = InfixD x y z+      remitter (InfixD x y z) = Just (x, y, z)+      remitter _ = Nothing+#else _InfixD :: Prism' Dec (Fixity, Name) _InfixD   = prism' reviewer remitter@@ -958,6 +1052,7 @@       reviewer (x, y) = InfixD x y       remitter (InfixD x y) = Just (x, y)       remitter _ = Nothing+#endif  _PragmaD :: Prism' Dec Pragma _PragmaD@@ -1097,7 +1192,7 @@ -- _DataD :: 'Prism'' 'Dec' ('Cxt', 'Name', ['TyVarBndrUnit'], 'Maybe' 'Kind', ['Con'], ['DerivClause']) -- template-haskell-2.12+ -- _DataD :: 'Prism'' 'Dec' ('Cxt', 'Name', ['Type'],          'Maybe' 'Kind', ['Con'], 'Cxt')           -- Earlier versions -- @-_DataD :: DataPrism' [TyVarBndrUnit] [Con]+_DataD :: DataPrism' [TyVarBndrVis] [Con] _DataD   = prism' reviewer remitter   where@@ -1110,7 +1205,7 @@ -- _NewtypeD :: 'Prism'' 'Dec' ('Cxt', 'Name', ['TyVarBndrUnit'], 'Maybe' 'Kind', 'Con', ['DerivClause']) -- template-haskell-2.12+ -- _NewtypeD :: 'Prism'' 'Dec' ('Cxt', 'Name', ['Type'],          'Maybe' 'Kind', 'Con', 'Cxt')           -- Earlier versions -- @-_NewtypeD :: DataPrism' [TyVarBndrUnit] Con+_NewtypeD :: DataPrism' [TyVarBndrVis] Con _NewtypeD   = prism' reviewer remitter   where@@ -1118,7 +1213,7 @@       remitter (NewtypeD x y z w u v) = Just (x, y, z, w, u, v)       remitter _ = Nothing -_DataFamilyD :: Prism' Dec (Name, [TyVarBndrUnit], Maybe Kind)+_DataFamilyD :: Prism' Dec (Name, [TyVarBndrVis], Maybe Kind) _DataFamilyD   = prism' reviewer remitter   where@@ -1172,6 +1267,16 @@       remitter _ = Nothing #endif +#if MIN_VERSION_template_haskell(2,20,0)+_TypeDataD :: Prism' Dec (Name, [TyVarBndrVis], Maybe Kind, [Con])+_TypeDataD+  = prism' reviewer remitter+  where+      reviewer (x, y, z, u) = TypeDataD x y z u+      remitter (TypeDataD x y z u) = Just (x, y, z, u)+      remitter _ = Nothing+#endif+ #if MIN_VERSION_template_haskell(2,12,0) _Unidir :: Prism' PatSynDir () _Unidir@@ -1507,6 +1612,26 @@       remitter _ = Nothing #endif +#if MIN_VERSION_template_haskell(2,22,0)+_SCCP :: Prism' Pragma (Name, Maybe String)+_SCCP+  = prism' reviewer remitter+  where+      reviewer (x, y) = SCCP x y+      remitter (SCCP x y) = Just (x, y)+      remitter _ = Nothing+#endif++#if MIN_VERSION_template_haskell(2,24,0)+_SpecialiseEP :: Prism' Pragma (Maybe [TyVarBndr ()], [RuleBndr], Exp, Maybe Inline, Phases)+_SpecialiseEP+  = prism' reviewer remitter+  where+    reviewer (x, y, z, w, u) = SpecialiseEP x y z w u+    remitter (SpecialiseEP x y z w u) = Just (x, y, z, w, u)+    remitter _ = Nothing+#endif+ _NoInline :: Prism' Inline () _NoInline   = prism' reviewer remitter@@ -1977,6 +2102,24 @@       remitter _ = Nothing #endif +#if MIN_VERSION_template_haskell(2,18,0)+_GetFieldE :: Prism' Exp (Exp, String)+_GetFieldE+  = prism' reviewer remitter+  where+      reviewer (x, y) = GetFieldE x y+      remitter (GetFieldE x y) = Just (x, y)+      remitter _ = Nothing++_ProjectionE :: Prism' Exp (NonEmpty String)+_ProjectionE+  = prism' reviewer remitter+  where+      reviewer = ProjectionE+      remitter (ProjectionE x) = Just x+      remitter _ = Nothing+#endif+ #if MIN_VERSION_template_haskell(2,19,0) _LamCasesE :: Prism' Exp [Clause] _LamCasesE@@ -1987,6 +2130,60 @@       remitter _ = Nothing #endif +#if MIN_VERSION_template_haskell(2,21,0)+_TypedBracketE :: Prism' Exp Exp+_TypedBracketE+  = prism' reviewer remitter+  where+      reviewer = TypedBracketE+      remitter (TypedBracketE x) = Just x+      remitter _ = Nothing++_TypedSpliceE :: Prism' Exp Exp+_TypedSpliceE+  = prism' reviewer remitter+  where+      reviewer = TypedSpliceE+      remitter (TypedSpliceE x) = Just x+      remitter _ = Nothing+#endif++#if MIN_VERSION_template_haskell(2,22,0)+_TypeE :: Prism' Exp Type+_TypeE+  = prism' reviewer remitter+  where+      reviewer = TypeE+      remitter (TypeE x) = Just x+      remitter _ = Nothing+#endif++#if MIN_VERSION_template_haskell(2,23,0)+_ForallE :: Prism' Exp ([TyVarBndr Specificity], Exp)+_ForallE+  = prism' reviewer remitter+  where+      reviewer (x, y) = ForallE x y+      remitter (ForallE x y) = Just (x, y)+      remitter _ = Nothing++_ForallVisE :: Prism' Exp ([TyVarBndr ()], Exp)+_ForallVisE+  = prism' reviewer remitter+  where+      reviewer (x, y) = ForallVisE x y+      remitter (ForallVisE x y) = Just (x, y)+      remitter _ = Nothing++_ConstrainedE :: Prism' Exp ([Exp], Exp)+_ConstrainedE+  = prism' reviewer remitter+  where+      reviewer (x, y) = ConstrainedE x y+      remitter (ConstrainedE x y) = Just (x, y)+      remitter _ = Nothing+#endif+ _GuardedB :: Prism' Body [(Guard, Exp)] _GuardedB   = prism' reviewer remitter@@ -2336,6 +2533,34 @@       remitter (ViewP x y) = Just (x, y)       remitter _ = Nothing +#if MIN_VERSION_template_haskell(2,22,0)+_TypeP :: Prism' Pat Type+_TypeP+  = prism' reviewer remitter+  where+      reviewer = TypeP+      remitter (TypeP x) = Just x+      remitter _ = Nothing++_InvisP :: Prism' Pat Type+_InvisP+  = prism' reviewer remitter+  where+      reviewer = InvisP+      remitter (InvisP x) = Just x+      remitter _ = Nothing+#endif++#if MIN_VERSION_template_haskell(2,23,0)+_OrP :: Prism' Pat (NonEmpty Pat)+_OrP+  = prism' reviewer remitter+  where+      reviewer = OrP+      remitter (OrP x) = Just x+      remitter _ = Nothing+#endif+ _ForallT :: Prism' Type ([TyVarBndrSpec], Cxt, Type) _ForallT   = prism' reviewer remitter@@ -2585,6 +2810,24 @@   where       reviewer () = InferredSpec       remitter InferredSpec = Just ()+      remitter _ = Nothing+#endif++#if MIN_VERSION_template_haskell(2,21,0)+_BndrReq :: Prism' BndrVis ()+_BndrReq+  = prism' reviewer remitter+  where+      reviewer () = BndrReq+      remitter BndrReq = Just ()+      remitter _ = Nothing++_BndrInvis :: Prism' BndrVis ()+_BndrInvis+  = prism' reviewer remitter+  where+      reviewer () = BndrInvis+      remitter BndrInvis = Just ()       remitter _ = Nothing #endif
src/Numeric/Lens.hs view
@@ -42,10 +42,10 @@ -- >>> import Control.Lens -- >>> import Data.Monoid (Sum(..)) --- | This 'Prism' can be used to model the fact that every 'Integral'+-- | This t'Prism' can be used to model the fact that every t'Integral' -- type is a subset of 'Integer'. ----- Embedding through the 'Prism' only succeeds if the 'Integer' would pass+-- Embedding through the t'Prism' only succeeds if the 'Integer' would pass -- through unmodified when re-extracted. integral :: (Integral a, Integral b) => Prism Integer Integer a b integral = prism toInteger $ \ i -> let a = fromInteger i in
src/System/FilePath/Lens.hs view
@@ -61,10 +61,10 @@ -- True -- -- @--- ('</>~') :: 'Setter' s a 'FilePath' 'FilePath' -> 'FilePath' -> s -> a--- ('</>~') :: 'Iso' s a 'FilePath' 'FilePath' -> 'FilePath' -> s -> a--- ('</>~') :: 'Lens' s a 'FilePath' 'FilePath' -> 'FilePath' -> s -> a--- ('</>~') :: 'Traversal' s a 'FilePath' 'FilePath' -> 'FilePath' -> s -> a+-- ('</>~') :: t'Setter' s a 'FilePath' 'FilePath' -> 'FilePath' -> s -> a+-- ('</>~') :: t'Iso' s a 'FilePath' 'FilePath' -> 'FilePath' -> s -> a+-- ('</>~') :: t'Lens' s a 'FilePath' 'FilePath' -> 'FilePath' -> s -> a+-- ('</>~') :: t'Traversal' s a 'FilePath' 'FilePath' -> 'FilePath' -> s -> a -- @ (</>~) :: ASetter s t FilePath FilePath -> FilePath -> s -> t l </>~ n = over l (</> n)@@ -87,7 +87,7 @@ {-# INLINE (</>=) #-}  --- | Add a path onto the end of the target of a 'Lens' and return the result+-- | Add a path onto the end of the target of a t'Lens' and return the result -- -- When you do not need the result of the operation, ('</>~') is more flexible. (<</>~) :: LensLike ((,)FilePath) s a FilePath FilePath -> FilePath -> s -> (FilePath, a)@@ -95,7 +95,7 @@ {-# INLINE (<</>~) #-}  --- | Add a path onto the end of the target of a 'Lens' into+-- | Add a path onto the end of the target of a t'Lens' into -- your monad's state and return the result. -- -- When you do not need the result of the operation, ('</>=') is more flexible.@@ -104,7 +104,7 @@ {-# INLINE (<</>=) #-}  --- | Add a path onto the end of the target of a 'Lens' and return the original+-- | Add a path onto the end of the target of a t'Lens' and return the original -- value. -- -- When you do not need the original value, ('</>~') is more flexible.@@ -112,7 +112,7 @@ l <<</>~ b = l $ \a -> (a, a </> b) {-# INLINE (<<</>~) #-} --- | Add a path onto the end of a target of a 'Lens' into your monad's state+-- | Add a path onto the end of a target of a t'Lens' into your monad's state -- and return the old value. -- -- When you do not need the result of the operation, ('</>=') is more flexible.@@ -126,10 +126,10 @@ -- ("hello.txt","world.txt") -- -- @--- ('<.>~') :: 'Setter' s a 'FilePath' 'FilePath' -> 'String' -> s -> a--- ('<.>~') :: 'Iso' s a 'FilePath' 'FilePath' -> 'String' -> s -> a--- ('<.>~') :: 'Lens' s a 'FilePath' 'FilePath' -> 'String' -> s -> a--- ('<.>~') :: 'Traversal' s a 'FilePath' 'FilePath' -> 'String' -> s -> a+-- ('<.>~') :: t'Setter' s a 'FilePath' 'FilePath' -> 'String' -> s -> a+-- ('<.>~') :: t'Iso' s a 'FilePath' 'FilePath' -> 'String' -> s -> a+-- ('<.>~') :: t'Lens' s a 'FilePath' 'FilePath' -> 'String' -> s -> a+-- ('<.>~') :: t'Traversal' s a 'FilePath' 'FilePath' -> 'String' -> s -> a -- @ (<.>~) :: ASetter s a FilePath FilePath -> String -> s -> a l <.>~ n = over l (<.> n)@@ -150,7 +150,7 @@ l <.>= b = State.modify (l <.>~ b) {-# INLINE (<.>=) #-} --- | Add an extension onto the end of the target of a 'Lens' and return the result+-- | Add an extension onto the end of the target of a t'Lens' and return the result -- -- >>> _1 <<.>~ "txt" $ ("hello","world") -- ("hello.txt",("hello.txt","world"))@@ -161,7 +161,7 @@ {-# INLINE (<<.>~) #-}  --- | Add an extension onto the end of the target of a 'Lens' into+-- | Add an extension onto the end of the target of a t'Lens' into -- your monad's state and return the result. -- -- >>> evalState (_1 <<.>= "txt") ("hello","world")@@ -172,7 +172,7 @@ l <<.>= r = l <%= (<.> r) {-# INLINE (<<.>=) #-} --- | Add an extension onto the end of the target of a 'Lens' but+-- | Add an extension onto the end of the target of a t'Lens' but -- return the old value -- -- >>> _1 <<<.>~ "txt" $ ("hello","world")@@ -183,7 +183,7 @@ l <<<.>~ b = l $ \a -> (a, a <.> b) {-# INLINE (<<<.>~) #-} --- | Add an extension onto the end of the target of a 'Lens' into your monad's+-- | Add an extension onto the end of the target of a t'Lens' into your monad's -- state and return the old value. -- -- >>> runState (_1 <<<.>= "txt") ("hello","world")@@ -194,9 +194,9 @@ l <<<.>= b = l %%= \a -> (a, a <.> b) {-# INLINE (<<<.>=) #-} --- | A 'Lens' for reading and writing to the basename+-- | A t'Lens' for reading and writing to the basename ----- Note: This is 'not' a legal 'Lens' unless the outer 'FilePath' has both a directory+-- Note: This is /not/ a legal t'Lens' unless the outer 'FilePath' has both a directory -- and filename component and the generated basenames are not null and contain no directory -- separators. --@@ -207,9 +207,9 @@ {-# INLINE basename #-}  --- | A 'Lens' for reading and writing to the directory+-- | A t'Lens' for reading and writing to the directory ----- Note: this is /not/ a legal 'Lens' unless the outer 'FilePath' already has a directory component,+-- Note: this is /not/ a legal t'Lens' unless the outer 'FilePath' already has a directory component, -- and generated directories are not null. -- -- >>> (("long" </> "path" </> "name.txt") ^. directory) == "long" </> "path"@@ -219,9 +219,9 @@ {-# INLINE directory #-}  --- | A 'Lens' for reading and writing to the extension+-- | A t'Lens' for reading and writing to the extension ----- Note: This is /not/ a legal 'Lens', unless you are careful to ensure that generated+-- Note: This is /not/ a legal t'Lens', unless you are careful to ensure that generated -- extension 'FilePath' components are either null or start with 'System.FilePath.extSeparator' -- and do not contain any internal 'System.FilePath.extSeparator's. --@@ -234,9 +234,9 @@ {-# INLINE extension #-}  --- | A 'Lens' for reading and writing to the full filename+-- | A t'Lens' for reading and writing to the full filename ----- Note: This is /not/ a legal 'Lens', unless you are careful to ensure that generated+-- Note: This is /not/ a legal t'Lens', unless you are careful to ensure that generated -- filename 'FilePath' components are not null and do not contain any -- elements of 'System.FilePath.pathSeparators's. --
+ tests/BigRecord.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE TemplateHaskell #-}++module BigRecord where++import Control.Lens++data Big = Big+  { _a0 :: Int , _a1 :: Int , _a2 :: Int , _a3 :: Int , _a4 :: Int , _a5 :: Int , _a6 :: Int , _a7 :: Int+  , _a8 :: Int , _a9 :: Int , _a10 :: Int , _a11 :: Int , _a12 :: Int , _a13 :: Int , _a14 :: Int , _a15 :: Int+  , _a16 :: Int , _a17 :: Int , _a18 :: Int , _a19 :: Int , _a20 :: Int , _a21 :: Int , _a22 :: Int , _a23 :: Int+  , _a24 :: Int , _a25 :: Int , _a26 :: Int , _a27 :: Int , _a28 :: Int , _a29 :: Int , _a30 :: Int , _a31 :: Int+  , _a32 :: Int , _a33 :: Int , _a34 :: Int , _a35 :: Int , _a36 :: Int , _a37 :: Int , _a38 :: Int , _a39 :: Int+  , _a40 :: Int , _a41 :: Int , _a42 :: Int , _a43 :: Int , _a44 :: Int , _a45 :: Int , _a46 :: Int , _a47 :: Int+  , _a48 :: Int , _a49 :: Int , _a50 :: Int , _a51 :: Int , _a52 :: Int , _a53 :: Int , _a54 :: Int , _a55 :: Int+  , _a56 :: Int , _a57 :: Int , _a58 :: Int , _a59 :: Int , _a60 :: Int , _a61 :: Int , _a62 :: Int , _a63 :: Int+  , _a64 :: Int , _a65 :: Int , _a66 :: Int , _a67 :: Int , _a68 :: Int , _a69 :: Int , _a70 :: Int , _a71 :: Int+  , _a72 :: Int , _a73 :: Int , _a74 :: Int , _a75 :: Int , _a76 :: Int , _a77 :: Int , _a78 :: Int , _a79 :: Int+  , _a80 :: Int , _a81 :: Int , _a82 :: Int , _a83 :: Int , _a84 :: Int , _a85 :: Int , _a86 :: Int , _a87 :: Int+  , _a88 :: Int , _a89 :: Int , _a90 :: Int , _a91 :: Int , _a92 :: Int , _a93 :: Int , _a94 :: Int , _a95 :: Int+  , _a96 :: Int , _a97 :: Int , _a98 :: Int , _a99 :: Int+  }++data Bigger = Bigger+  { _b0 :: Int , _b1 :: Int , _b2 :: Int , _b3 :: Int , _b4 :: Int , _b5 :: Int , _b6 :: Int , _b7 :: Int+  , _b8 :: Int , _b9 :: Int , _b10 :: Int , _b11 :: Int , _b12 :: Int , _b13 :: Int , _b14 :: Int , _b15 :: Int+  , _b16 :: Int , _b17 :: Int , _b18 :: Int , _b19 :: Int , _b20 :: Int , _b21 :: Int , _b22 :: Int , _b23 :: Int+  , _b24 :: Int , _b25 :: Int , _b26 :: Int , _b27 :: Int , _b28 :: Int , _b29 :: Int , _b30 :: Int , _b31 :: Int+  , _b32 :: Int , _b33 :: Int , _b34 :: Int , _b35 :: Int , _b36 :: Int , _b37 :: Int , _b38 :: Int , _b39 :: Int+  , _b40 :: Int , _b41 :: Int , _b42 :: Int , _b43 :: Int , _b44 :: Int , _b45 :: Int , _b46 :: Int , _b47 :: Int+  , _b48 :: Int , _b49 :: Int , _b50 :: Int , _b51 :: Int , _b52 :: Int , _b53 :: Int , _b54 :: Int , _b55 :: Int+  , _b56 :: Int , _b57 :: Int , _b58 :: Int , _b59 :: Int , _b60 :: Int , _b61 :: Int , _b62 :: Int , _b63 :: Int+  , _b64 :: Int , _b65 :: Int , _b66 :: Int , _b67 :: Int , _b68 :: Int , _b69 :: Int , _b70 :: Int , _b71 :: Int+  , _b72 :: Int , _b73 :: Int , _b74 :: Int , _b75 :: Int , _b76 :: Int , _b77 :: Int , _b78 :: Int , _b79 :: Int+  , _b80 :: Int , _b81 :: Int , _b82 :: Int , _b83 :: Int , _b84 :: Int , _b85 :: Int , _b86 :: Int , _b87 :: Int+  , _b88 :: Int , _b89 :: Int , _b90 :: Int , _b91 :: Int , _b92 :: Int , _b93 :: Int , _b94 :: Int , _b95 :: Int+  , _b96 :: Int , _b97 :: Int , _b98 :: Int , _b99 :: Int , _b100 :: Int , _b101 :: Int , _b102 :: Int , _b103 :: Int+  , _b104 :: Int , _b105 :: Int , _b106 :: Int , _b107 :: Int , _b108 :: Int , _b109 :: Int , _b110 :: Int , _b111 :: Int+  , _b112 :: Int , _b113 :: Int , _b114 :: Int , _b115 :: Int , _b116 :: Int , _b117 :: Int , _b118 :: Int , _b119 :: Int+  , _b120 :: Int , _b121 :: Int , _b122 :: Int , _b123 :: Int , _b124 :: Int , _b125 :: Int , _b126 :: Int , _b127 :: Int+  , _b128 :: Int , _b129 :: Int , _b130 :: Int , _b131 :: Int , _b132 :: Int , _b133 :: Int , _b134 :: Int , _b135 :: Int+  , _b136 :: Int , _b137 :: Int , _b138 :: Int , _b139 :: Int , _b140 :: Int , _b141 :: Int , _b142 :: Int , _b143 :: Int+  , _b144 :: Int , _b145 :: Int , _b146 :: Int , _b147 :: Int , _b148 :: Int , _b149 :: Int , _b150 :: Int , _b151 :: Int+  , _b152 :: Int , _b153 :: Int , _b154 :: Int , _b155 :: Int , _b156 :: Int , _b157 :: Int , _b158 :: Int , _b159 :: Int+  , _b160 :: Int , _b161 :: Int , _b162 :: Int , _b163 :: Int , _b164 :: Int , _b165 :: Int , _b166 :: Int , _b167 :: Int+  , _b168 :: Int , _b169 :: Int , _b170 :: Int , _b171 :: Int , _b172 :: Int , _b173 :: Int , _b174 :: Int , _b175 :: Int+  , _b176 :: Int , _b177 :: Int , _b178 :: Int , _b179 :: Int , _b180 :: Int , _b181 :: Int , _b182 :: Int , _b183 :: Int+  , _b184 :: Int , _b185 :: Int , _b186 :: Int , _b187 :: Int , _b188 :: Int , _b189 :: Int , _b190 :: Int , _b191 :: Int+  , _b192 :: Int , _b193 :: Int , _b194 :: Int , _b195 :: Int , _b196 :: Int , _b197 :: Int , _b198 :: Int , _b199 :: Int+  , _b200 :: Int , _b201 :: Int , _b202 :: Int , _b203 :: Int , _b204 :: Int , _b205 :: Int , _b206 :: Int , _b207 :: Int+  , _b208 :: Int , _b209 :: Int , _b210 :: Int , _b211 :: Int , _b212 :: Int , _b213 :: Int , _b214 :: Int , _b215 :: Int+  , _b216 :: Int , _b217 :: Int , _b218 :: Int , _b219 :: Int , _b220 :: Int , _b221 :: Int , _b222 :: Int , _b223 :: Int+  , _b224 :: Int , _b225 :: Int , _b226 :: Int , _b227 :: Int , _b228 :: Int , _b229 :: Int , _b230 :: Int , _b231 :: Int+  , _b232 :: Int , _b233 :: Int , _b234 :: Int , _b235 :: Int , _b236 :: Int , _b237 :: Int , _b238 :: Int , _b239 :: Int+  , _b240 :: Int , _b241 :: Int , _b242 :: Int , _b243 :: Int , _b244 :: Int , _b245 :: Int , _b246 :: Int , _b247 :: Int+  , _b248 :: Int , _b249 :: Int , _b250 :: Int , _b251 :: Int , _b252 :: Int , _b253 :: Int , _b254 :: Int , _b255 :: Int+  , _b256 :: Int , _b257 :: Int , _b258 :: Int , _b259 :: Int , _b260 :: Int , _b261 :: Int , _b262 :: Int , _b263 :: Int+  , _b264 :: Int , _b265 :: Int , _b266 :: Int , _b267 :: Int , _b268 :: Int , _b269 :: Int , _b270 :: Int , _b271 :: Int+  , _b272 :: Int , _b273 :: Int , _b274 :: Int , _b275 :: Int , _b276 :: Int , _b277 :: Int , _b278 :: Int , _b279 :: Int+  , _b280 :: Int , _b281 :: Int , _b282 :: Int , _b283 :: Int , _b284 :: Int , _b285 :: Int , _b286 :: Int , _b287 :: Int+  , _b288 :: Int , _b289 :: Int , _b290 :: Int , _b291 :: Int , _b292 :: Int , _b293 :: Int , _b294 :: Int , _b295 :: Int+  , _b296 :: Int , _b297 :: Int , _b298 :: Int , _b299 :: Int+  }++makeLensesWith (lensRules & generateRecordSyntax .~ True) ''Big+makeLensesWith (lensRules & generateRecordSyntax .~ True) ''Bigger
+ tests/T1024.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NoFieldSelectors #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeSynonymInstances #-}++-- | Test 'makeFieldsId', which requires NoFieldSelectors and+-- DuplicateRecordFields. This test consequently only works on GHC >= 9.2.+module T1024 where++import Control.Lens++data Taco = Taco+  { hardShell :: Bool+  , sauce :: Int+  , filling :: String+  }+data Burrito = Burrito+  { sauce :: Int+  , filling :: String+  }+makeFieldsId ''Taco+makeFieldsId ''Burrito++checkTacoHardShell :: Lens' Taco Bool+checkTacoHardShell = hardShell++checkBurritoFilling :: Lens' Burrito String+checkBurritoFilling = filling
tests/hunit.hs view
@@ -23,15 +23,18 @@ import Control.Lens import Control.Monad.State import Data.Char+import qualified Data.Text as StrictT+import qualified Data.Text.Lazy as LazyT+import qualified Data.ByteString as StrictB+import qualified Data.ByteString.Lazy as LazyB import qualified Data.List as List import qualified Data.Map as Map import Data.Map (Map) #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid #endif-import Test.Framework.Providers.HUnit-import Test.Framework-import Test.HUnit hiding (test)+import Test.Tasty (defaultMain, testGroup)+import Test.Tasty.HUnit ((@?=), testCase)   data Point =@@ -227,16 +230,96 @@     test = points <<>= [ origin ]     trig' = trig { _points = (trig & _points) <> [ origin ] } +case_prepend_to_record_field =+  (trig & points <>:~ [ origin ])+    @?= trig { _points = [ origin ] <> (trig & _points) }++case_prepend_to_state_record_field = do+  runState test trig @?= ((), trig')+  where+    test = points <>:= [ origin ]+    trig' = trig { _points = [ origin ] <> (trig & _points) }++case_prepend_to_record_field_and_access_new_value =+  (trig & points <<>:~ [ origin ])+    @?= ([ origin ] <> _points trig, trig { _points = [ origin ] <> (trig & _points) })++case_prepend_to_state_record_field_and_access_new_value = do+  runState test trig @?= ([ origin ] <> _points trig, trig')+  where+    test = points <<>:= [ origin ]+    trig' = trig { _points = [ origin ] <> (trig & _points) }++case_cons_to_record_field =+  (trig & points <|~ origin)+    @?= trig { _points = origin : (trig & _points) }++case_cons_to_state_record_field = do+  runState test trig @?= ((), trig')+  where+    test = points <|= origin+    trig' = trig { _points = origin : (trig & _points) }++case_cons_to_record_field_and_access_new_value =+  (trig & points <<|~ origin)+    @?= (origin : _points trig, trig { _points = origin : (trig & _points) })++case_cons_to_state_record_field_and_access_new_value =+  runState test trig @?= ([ origin ] <> _points trig, trig')+  where+    test = points <<|= origin+    trig' = trig { _points = origin : (trig & _points) }++case_snoc_to_record_field =+  (trig & points |>~ origin)+    @?= trig { _points = (trig & _points) `snoc` origin }++case_snoc_to_state_record_field = do+  runState test trig @?= ((), trig')+  where+    test = points |>= origin+    trig' = trig { _points = (trig & _points) `snoc` origin }++case_snoc_to_record_field_and_access_new_value =+  (trig & points <|>~ origin)+    @?= (_points trig `snoc` origin, trig { _points = (trig & _points) `snoc` origin })++case_snoc_to_state_record_field_and_access_new_value =+  runState test trig @?= (_points trig <> [ origin ], trig')+  where+    test = points <|>= origin+    trig' = trig { _points = (trig & _points) `snoc` origin }+ case_append_to_record_field_and_access_old_value =-  (trig & points <<%~ (<>[origin]))+  (trig & points <<<>~ [ origin ])     @?= (_points trig, trig { _points = (trig & _points) <> [ origin ] })  case_append_to_state_record_field_and_access_old_value = do   runState test trig @?= (_points trig, trig')   where-    test = points <<%= (<>[origin])+    test = points <<<>= [ origin ]     trig' = trig { _points = (trig & _points) <> [ origin ] } +case_cons_to_record_field_and_access_old_value =+  (trig & points <<<|~ origin)+    @?= (_points trig, trig { _points = origin : (trig & _points) })++case_cons_to_state_record_field_and_access_old_value =+  runState test trig @?= (_points trig, trig')+  where+    test = points <<<|= origin+    trig' = trig { _points = origin : (trig & _points) }++case_snoc_to_record_field_and_access_old_value =+  (trig & points <<|>~ origin)+    @?= (_points trig, trig { _points = (trig & _points) `snoc` origin })++case_snoc_to_state_record_field_and_access_old_value =+  runState test trig @?= (_points trig, trig')+  where+    test = points <<|>= origin+    trig' = trig { _points = (trig & _points) `snoc` origin }+ case_read_maybe_map_entry = trig^.labels.at origin @?= Just "Origin"  case_read_maybe_state_map_entry =@@ -279,43 +362,78 @@                          , Point { _x = 4, _y = 7 }                          , Point { _x = 8, _y = 0 } ] } +case_correct_indexing_strict_text =+  map (\i -> StrictT.pack "12" ^? ix i) [-1..2]+    @?= [Nothing, Just '1', Just '2', Nothing]++case_correct_indexing_lazy_text =+  map (\i -> LazyT.pack "12" ^? ix i) [-1..2]+    @?= [Nothing, Just '1', Just '2', Nothing]++case_correct_indexing_strict_bytestring =+  map (\i -> StrictB.pack [1,2] ^? ix i) [-1..2]+    @?= [Nothing, Just 1, Just 2, Nothing]++case_correct_indexing_lazy_bytestring =+  map (\i -> LazyB.pack [1,2] ^? ix i) [-1..2]+    @?= [Nothing, Just 1, Just 2, Nothing]+ main :: IO ()-main = defaultMain-  [ testGroup "Main"-    [ testCase "read record field" case_read_record_field-    , testCase "read state record field" case_read_state_record_field-    , testCase "read record field and apply function" case_read_record_field_and_apply_function-    , testCase "read state record field and apply function" case_read_state_record_field_and_apply_function-    , testCase "write record field" case_write_record_field-    , testCase "write state record field" case_write_state_record_field-    , testCase "write record field and access new value" case_write_record_field_and_access_new_value-    , testCase "write state record field and access new value" case_write_state_record_field_and_access_new_value-    , testCase "write record field and access old value" case_write_record_field_and_access_old_value-    , testCase "write state record field and access old value" case_write_state_record_field_and_access_old_value-    , testCase "modify record field" case_modify_record_field-    , testCase "modify state record field" case_modify_state_record_field-    , testCase "modify record field and access new value" case_modify_record_field_and_access_new_value-    , testCase "modify state record field and access new value" case_modify_state_record_field_and_access_new_value-    , testCase "modify record field and access old value" case_modify_record_field_and_access_old_value-    , testCase "modify state record field and access old value" case_modify_state_record_field_and_access_old_value-    , testCase "modify record field and access side result" case_modify_record_field_and_access_side_result-    , testCase "increment record field" case_increment_record_field-    , testCase "increment state record field" case_increment_state_record_field-    , testCase "append to record field" case_append_to_record_field-    , testCase "append to state record field" case_append_to_state_record_field-    , testCase "append to record field and access new value" case_append_to_record_field_and_access_new_value-    , testCase "append to state record field and access new value" case_append_to_state_record_field_and_access_new_value-    , testCase "append to record field and access old value" case_append_to_record_field_and_access_old_value-    , testCase "append to state record field and access old value" case_append_to_state_record_field_and_access_old_value-    , testCase "read maybe map entry" case_read_maybe_map_entry-    , testCase "read maybe state map entry" case_read_maybe_state_map_entry-    , testCase "read map entry" case_read_map_entry-    , testCase "read state map entry" case_read_state_map_entry-    , testCase "modify map entry" case_modify_map_entry-    , testCase "insert maybe map entry" case_insert_maybe_map_entry-    , testCase "delete maybe map entry" case_delete_maybe_map_entry-    , testCase "read list entry" case_read_list_entry-    , testCase "write list entry" case_write_list_entry-    , testCase "write through list entry" case_write_through_list_entry-    ]+main = defaultMain $+  testGroup "Main"+  [ testCase "read record field" case_read_record_field+  , testCase "read state record field" case_read_state_record_field+  , testCase "read record field and apply function" case_read_record_field_and_apply_function+  , testCase "read state record field and apply function" case_read_state_record_field_and_apply_function+  , testCase "write record field" case_write_record_field+  , testCase "write state record field" case_write_state_record_field+  , testCase "write record field and access new value" case_write_record_field_and_access_new_value+  , testCase "write state record field and access new value" case_write_state_record_field_and_access_new_value+  , testCase "write record field and access old value" case_write_record_field_and_access_old_value+  , testCase "write state record field and access old value" case_write_state_record_field_and_access_old_value+  , testCase "modify record field" case_modify_record_field+  , testCase "modify state record field" case_modify_state_record_field+  , testCase "modify record field and access new value" case_modify_record_field_and_access_new_value+  , testCase "modify state record field and access new value" case_modify_state_record_field_and_access_new_value+  , testCase "modify record field and access old value" case_modify_record_field_and_access_old_value+  , testCase "modify state record field and access old value" case_modify_state_record_field_and_access_old_value+  , testCase "modify record field and access side result" case_modify_record_field_and_access_side_result+  , testCase "increment record field" case_increment_record_field+  , testCase "increment state record field" case_increment_state_record_field+  , testCase "append to record field" case_append_to_record_field+  , testCase "append to state record field" case_append_to_state_record_field+  , testCase "prepend to record field" case_prepend_to_record_field+  , testCase "prepend to state record field" case_prepend_to_state_record_field+  , testCase "cons to record field" case_cons_to_record_field+  , testCase "cons to state record field" case_cons_to_state_record_field+  , testCase "snoc to record field" case_snoc_to_record_field+  , testCase "snoc to state record field" case_snoc_to_state_record_field+  , testCase "append to record field and access new value" case_append_to_record_field_and_access_new_value+  , testCase "append to state record field and access new value" case_append_to_state_record_field_and_access_new_value+  , testCase "prepend to record field and access new value" case_prepend_to_record_field_and_access_new_value+  , testCase "prepend to state record field and access new value" case_prepend_to_state_record_field_and_access_new_value+  , testCase "cons to record field and access new value" case_cons_to_record_field_and_access_new_value+  , testCase "cons to state record field and access new value" case_cons_to_state_record_field_and_access_new_value+  , testCase "snoc to record field and access new value" case_snoc_to_record_field_and_access_new_value+  , testCase "snoc to state record field and access new value" case_snoc_to_state_record_field_and_access_new_value+  , testCase "append to record field and access old value" case_append_to_record_field_and_access_old_value+  , testCase "append to state record field and access old value" case_append_to_state_record_field_and_access_old_value+  , testCase "cons to record field and access old value" case_cons_to_record_field_and_access_old_value+  , testCase "cons to state record field and access old value" case_cons_to_state_record_field_and_access_old_value+  , testCase "snoc to record field and access old value" case_snoc_to_record_field_and_access_old_value+  , testCase "snoc to state record field and access old value" case_snoc_to_state_record_field_and_access_old_value+  , testCase "read maybe map entry" case_read_maybe_map_entry+  , testCase "read maybe state map entry" case_read_maybe_state_map_entry+  , testCase "read map entry" case_read_map_entry+  , testCase "read state map entry" case_read_state_map_entry+  , testCase "modify map entry" case_modify_map_entry+  , testCase "insert maybe map entry" case_insert_maybe_map_entry+  , testCase "delete maybe map entry" case_delete_maybe_map_entry+  , testCase "read list entry" case_read_list_entry+  , testCase "write list entry" case_write_list_entry+  , testCase "write through list entry" case_write_through_list_entry+  , testCase "correct indexing strict text" case_correct_indexing_strict_text+  , testCase "correct indexing lazy text" case_correct_indexing_lazy_text+  , testCase "correct indexing strict bytestring" case_correct_indexing_strict_bytestring+  , testCase "correct indexing lazy bytestring" case_correct_indexing_lazy_bytestring   ]
tests/properties.hs view
@@ -26,8 +26,8 @@  import Control.Lens import Test.QuickCheck-import Test.Framework-import Test.Framework.Providers.QuickCheck2+import Test.Tasty (defaultMain, testGroup)+import Test.Tasty.QuickCheck (testProperty) import Data.Char (isAlphaNum, isAscii, toUpper) import qualified Data.Text.Strict.Lens as Text import GHC.Exts (Constraint)@@ -129,32 +129,31 @@   main :: IO ()-main = defaultMain-  [ testGroup "Main"-    [ testProperty "1" prop_1-    , testProperty "2" prop_2-    , testProperty "3" prop_3-    , testProperty "4" prop_4-    , testProperty "5" prop_5-    , testProperty "6" prop_6-    , testProperty "7" prop_7-    , testProperty "8" prop_8-    , testProperty "9" prop_9-    , testProperty "10" prop_10-    , testProperty "2 2" prop_2_2-    , testProperty "mapped" prop_mapped-    , testProperty "mapped mapped" prop_mapped_mapped-    , testProperty "both" prop_both-    , testProperty "traverseLeft" prop_traverseLeft-    , testProperty "traverseRight" prop_traverseRight-    , testProperty "simple" prop_simple-    , testProperty " Left" prop__Left-    , testProperty " Right" prop__Right-    , testProperty " Just" prop__Just-    , testProperty "prefixed" prop_prefixed-    , testProperty "text" prop_text-    , testProperty "base show" prop_base_show-    , testProperty "base read" prop_base_read-    , testProperty "base readFail" prop_base_readFail-    ]+main = defaultMain $+  testGroup "Main"+  [ testProperty "1" prop_1+  , testProperty "2" prop_2+  , testProperty "3" prop_3+  , testProperty "4" prop_4+  , testProperty "5" prop_5+  , testProperty "6" prop_6+  , testProperty "7" prop_7+  , testProperty "8" prop_8+  , testProperty "9" prop_9+  , testProperty "10" prop_10+  , testProperty "2 2" prop_2_2+  , testProperty "mapped" prop_mapped+  , testProperty "mapped mapped" prop_mapped_mapped+  , testProperty "both" prop_both+  , testProperty "traverseLeft" prop_traverseLeft+  , testProperty "traverseRight" prop_traverseRight+  , testProperty "simple" prop_simple+  , testProperty " Left" prop__Left+  , testProperty " Right" prop__Right+  , testProperty " Just" prop__Just+  , testProperty "prefixed" prop_prefixed+  , testProperty "text" prop_text+  , testProperty "base show" prop_base_show+  , testProperty "base read" prop_base_read+  , testProperty "base readFail" prop_base_readFail   ]
tests/templates.hs view
@@ -27,6 +27,7 @@  import Control.Lens -- import Test.QuickCheck (quickCheck)+import BigRecord () import T799 () import T917 () import T972 ()@@ -467,6 +468,13 @@   data family T997FamB b   newtype instance T997FamB b = MkT997FamB b   |])++-- Ensure that a data type defined in a TH quote can have a field whose type+-- references another data type defined in the same quote (#1032)+declareFields [d|+    data T1032A = T1032A { t1032ASubB :: T1032B }+    data T1032B = T1032B { t1032BB :: Int }+  |]  main :: IO () main = putStrLn "test/templates.hs: ok"