packages feed

lens 5.0.1 → 5.1

raw patch · 74 files changed

+600/−1245 lines, 74 filesdep −natsdep −semigroupsdep −voiddep ~basedep ~bifunctorsdep ~contravariant

Dependencies removed: nats, semigroups, void

Dependency ranges changed: base, bifunctors, contravariant, distributive, exceptions, generic-deriving, hashable, mtl, parallel, semigroupoids, tagged, template-haskell, text, transformers, transformers-compat, vector

Files

.hlint.yaml view
@@ -10,7 +10,7 @@ - ignore: {name: Use fewer imports} - ignore: {name: "Use :"} - ignore: {name: Use typeRep, within: [Control.Lens.Internal.Typeable, Control.Lens.Internal.Exception]}-- ignore: {name: Eta reduce, within: [Control.Lens.Zoom, Control.Lens.Equality, Control.Lens.Traversal]} # Breaks code+- ignore: {name: Eta reduce, within: [Control.Lens.At, Control.Lens.Zoom, Control.Lens.Equality, Control.Lens.Traversal]} # Breaks code - ignore: {name: Use id, within: [Control.Lens.Equality]} - ignore: {name: Use camelCase, within: [Control.Lens.Internal.TH]} - ignore: {name: Use list comprehension, within: [Control.Lens.Internal.FieldTH]}
CHANGELOG.markdown view
@@ -1,3 +1,29 @@+5.1 [2021.11.15]+----------------+* Allow building with GHC 9.2.+* Drop support for GHC 7.10 and older.+* The type of `_ConP` in `Language.Haskell.TH.Lens` is now+  `Prism' Pat (Name, [Type], [Pat])` instead of `Prism' Pat (Name, [Pat])`+  when building with `template-haskell-2.18` or later.+* Define `_CharTyLit` in `Language.Haskell.TH.Lens` when building with+  `template-haskell-2.18` or later.+* Add `Prefixed` and `Suffixed` classes to `Control.Lens.Prism`, which provide+  `prefixed` and `suffixed` prisms for prefixes and suffixes of sequence types.+  These classes generalize the `prefixed` and `suffixed` functions in+  `Data.List.Lens`, which were previously top-level functions. In addition to+  providing `Prefixed` and `Suffixed` instances for lists, instances for `Text`+  and `ByteString` types are also provided.++  At present, `Prefixed` and `Suffixed` are re-exported from `Data.List.Lens`+  for backwards compatibility. This may change in a future version of `lens`,+  however.+* Add a `traversal` function to `Control.Lens.Traversal`. This function, aside+  from acting as a `Traversal` counterpart to the `lens` and `prism` functions,+  provides documentation on how to define `Traversal`s.+* Add a `matching'` function to `Control.Lens.Prism`. `matching'` is like+  `matching`, but with a slightly more general type signature that allows it to+  work with combinations of `Lens`es, `Prism`s, and `Traversal`s.+ 5.0.1 [2021.02.24] ------------------ * Fix a bug in which `makeLenses` could produce ill kinded optics for
benchmarks/plated.hs view
@@ -30,7 +30,7 @@            |  Sub !Expr !Expr            |  Mul !Expr !Expr            |  Div !Expr !Expr-           deriving (Eq,Show,Data,Typeable,Generic)+           deriving (Eq,Show,Data,Generic)  instance NFData Expr where   rnf (Neg a)   = rnf a
benchmarks/traversals.hs view
@@ -3,7 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE BangPatterns #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} module Main (main) where  import qualified Data.ByteString as BS
cabal.project view
@@ -1,7 +1,3 @@ packages: .           ./examples           ./lens-properties--allow-newer:-  cassava:base,-  vector-binary-instances:base
examples/Plates.hs view
@@ -1,15 +1,12 @@-{-# LANGUAGE CPP, MultiParamTypeClasses, DeriveGeneric, DeriveDataTypeable #-}+{-# LANGUAGE MultiParamTypeClasses, DeriveGeneric, DeriveDataTypeable #-} module Plates where -#if !(MIN_VERSION_base(4,8,0))-import Control.Applicative-#endif import Control.Lens import GHC.Generics import Data.Data -data Expr = Var Int | Pos Expr String | Neg Expr | Add Expr Expr deriving (Eq,Ord,Show,Read,Generic,Data,Typeable)-data Stmt = Seq [Stmt] | Sel [Expr] | Let String Expr deriving (Eq,Ord,Show,Read,Generic,Data,Typeable)+data Expr = Var Int | Pos Expr String | Neg Expr | Add Expr Expr deriving (Eq,Ord,Show,Read,Generic,Data)+data Stmt = Seq [Stmt] | Sel [Expr] | Let String Expr deriving (Eq,Ord,Show,Read,Generic,Data)  instance Plated Expr where   plate _ (Var x  ) = pure (Var x)
examples/Pong.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, TemplateHaskell, Rank2Types, NoMonomorphismRestriction #-}+{-# LANGUAGE TemplateHaskell, Rank2Types, NoMonomorphismRestriction #-} ----------------------------------------------------------------------------- -- | -- Module      :  Main@@ -12,9 +12,6 @@ ----------------------------------------------------------------------------- module Main where -#if !(MIN_VERSION_base(4,8,0))-import Control.Applicative ((<$>))-#endif import Control.Lens hiding ((:>), at) import Control.Monad.State (State, execState, get) import Control.Monad (when)
examples/lens-examples.cabal view
@@ -16,15 +16,14 @@                Pong Example  build-type:    Simple-tested-with:   GHC == 7.8.4-             , GHC == 7.10.3-             , GHC == 8.0.2+tested-with:   GHC == 8.0.2              , GHC == 8.2.2              , GHC == 8.4.4              , GHC == 8.6.5              , GHC == 8.8.4-             , GHC == 8.10.4+             , GHC == 8.10.7              , GHC == 9.0.1+             , GHC == 9.2.1  source-repository head   type: git
include/lens-common.h view
@@ -19,32 +19,8 @@ #define MIN_VERSION_containers(x,y,z) 1 #endif -#ifndef MIN_VERSION_exceptions-#define MIN_VERSION_exceptions 1-#endif--#ifndef MIN_VERSION_free-#define MIN_VERSION_free(x,y,z) 1-#endif--#ifndef MIN_VERSION_mtl-#define MIN_VERSION_mtl(x,y,z) 1-#endif--#ifndef MIN_VERSION_parallel-#define MIN_VERSION_parallel(x,y,z) defined(__GLASGOW_HASKELL__)-#endif--#ifndef MIN_VERSION_reflection-#define MIN_VERSION_reflection(x,y,z) 1-#endif- #ifndef MIN_VERSION_template_haskell #define MIN_VERSION_template_haskell(x,y,z) 1-#endif--#ifndef MIN_VERSION_vector-#define MIN_VERSION_vector(x,y,z) 1 #endif  #endif
lens-properties/CHANGELOG.markdown view
@@ -1,3 +1,7 @@+next [????.??.??]+-----------------+* Drop support for GHC 7.10 and older.+ 4.11.1 ------ * Update version bounds.
lens-properties/lens-properties.cabal view
@@ -13,15 +13,14 @@ synopsis:      QuickCheck properties for lens description:   QuickCheck properties for lens. build-type:    Simple-tested-with:   GHC == 7.8.4-             , GHC == 7.10.3-             , GHC == 8.0.2+tested-with:   GHC == 8.0.2              , GHC == 8.2.2              , GHC == 8.4.4              , GHC == 8.6.5              , GHC == 8.8.4-             , GHC == 8.10.4+             , GHC == 8.10.7              , GHC == 9.0.1+             , GHC == 9.2.1  extra-source-files:   .hlint.yaml@@ -33,7 +32,7 @@  library   build-depends:-    base         >= 4.5 && < 5,+    base         >= 4.9 && < 5,     lens         >= 4   && < 6,     QuickCheck   >= 2.4 && < 2.15,     transformers >= 0.2 && < 0.6
lens-properties/src/Control/Lens/Properties.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE LiberalTypeSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -13,9 +12,6 @@     , isPrism     ) where -#if !(MIN_VERSION_base(4,8,0))-import Control.Applicative-#endif import Control.Lens import Data.Functor.Compose import Test.QuickCheck
lens.cabal view
@@ -1,6 +1,6 @@ name:          lens category:      Data, Lenses, Generics-version:       5.0.1+version:       5.1 license:       BSD2 cabal-version: 1.18 license-file:  LICENSE@@ -12,15 +12,14 @@ copyright:     Copyright (C) 2012-2016 Edward A. Kmett build-type:    Simple -- build-tools:   cpphs-tested-with:   GHC == 7.8.4-             , GHC == 7.10.3-             , GHC == 8.0.2+tested-with:   GHC == 8.0.2              , GHC == 8.2.2              , GHC == 8.4.4              , GHC == 8.6.5              , GHC == 8.8.4-             , GHC == 8.10.4+             , GHC == 8.10.7              , GHC == 9.0.1+             , GHC == 9.2.1 synopsis:      Lenses, Folds and Traversals description:   This package comes \"Batteries Included\" with many useful lenses for the types@@ -173,48 +172,38 @@   build-depends:     array                         >= 0.5.0.0  && < 0.6,     assoc                         >= 1.0.2    && < 1.1,-    base                          >= 4.7      && < 5,+    base                          >= 4.9      && < 5,     base-orphans                  >= 0.5.2    && < 1,-    bifunctors                    >= 5.1      && < 6,+    bifunctors                    >= 5.5.7    && < 6,     bytestring                    >= 0.10.4.0 && < 0.12,-    call-stack                    >= 0.1      && < 0.4,+    call-stack                    >= 0.1      && < 0.5,     comonad                       >= 5.0.7    && < 6,     containers                    >= 0.5.5.1  && < 0.7,-    contravariant                 >= 1.3      && < 2,-    distributive                  >= 0.3      && < 1,-    exceptions                    >= 0.1.1    && < 1,+    contravariant                 >= 1.4      && < 2,+    distributive                  >= 0.5.1    && < 1,+    exceptions                    >= 0.8.2.1  && < 1,     filepath                      >= 1.2.0.0  && < 1.5,     free                          >= 5.1.5    && < 6,     ghc-prim,-    hashable                      >= 1.1.2.3  && < 1.4,+    hashable                      >= 1.2.7.0  && < 1.5,     indexed-traversable           >= 0.1      && < 0.2,     indexed-traversable-instances >= 0.1      && < 0.2,     kan-extensions                >= 5        && < 6,-    mtl                           >= 2.0.1    && < 2.3,-    parallel                      >= 3.1.0.1  && < 3.3,+    mtl                           >= 2.2.1    && < 2.3,+    parallel                      >= 3.2.1.0  && < 3.3,     profunctors                   >= 5.5.2    && < 6,     reflection                    >= 2.1      && < 3,-    semigroupoids                 >= 5        && < 6,+    semigroupoids                 >= 5.0.1    && < 6,     strict                        >= 0.4      && < 0.5,-    tagged                        >= 0.4.4    && < 1,-    template-haskell              >= 2.9.0.0  && < 2.18,+    tagged                        >= 0.8.6    && < 1,+    template-haskell              >= 2.11.1.0 && < 2.19,     text                          >= 1.2.3.0  && < 1.3,     th-abstraction                >= 0.4.1    && < 0.5,     these                         >= 1.1.1.1  && < 1.2,-    transformers                  >= 0.3.0.0  && < 0.6,-    transformers-compat           >= 0.4      && < 1,+    transformers                  >= 0.5.0.0  && < 0.6,+    transformers-compat           >= 0.5.0.4  && < 1,     unordered-containers          >= 0.2.10   && < 0.3,-    vector                        >= 0.9      && < 0.13--  if !impl(ghc >= 8.0)-    build-depends:-      generic-deriving >= 1.10  && < 2,-      semigroups       >= 0.8.4 && < 1--  if !impl(ghc >= 7.10)-    build-depends:-      nats >= 0.1 && < 1.2,-      void >= 0.5 && < 1+    vector                        >= 0.12.1.2 && < 0.13    -- Control.Lens as the first module, so cabal repl loads it.   exposed-modules:@@ -235,7 +224,6 @@     Control.Lens.Internal     Control.Lens.Internal.Bazaar     Control.Lens.Internal.ByteString-    Control.Lens.Internal.Coerce     Control.Lens.Internal.Context     Control.Lens.Internal.CTypes     Control.Lens.Internal.Deque@@ -307,7 +295,6 @@    other-modules:     Control.Lens.Internal.Prelude-    Paths_lens    if flag(trustworthy) && impl(ghc)     other-extensions: Trustworthy@@ -316,19 +303,11 @@   if flag(inlining)     cpp-options: -DINLINING -  if impl(ghc >= 7.10)-    ghc-options: -fno-warn-trustworthy-safe--  if impl(ghc >= 8)-    ghc-options: -Wno-missing-pattern-synonym-signatures-    ghc-options: -Wno-redundant-constraints-   if flag(j)     ghc-options: -j4 -  ghc-options: -Wall -fwarn-tabs -O2 -fdicts-cheap -funbox-strict-fields -fmax-simplifier-iterations=10-  if impl(ghc >= 8.6)-    ghc-options: -Wno-star-is-type+  ghc-options: -Wall -Wtabs -O2 -fdicts-cheap -funbox-strict-fields -fmax-simplifier-iterations=10+               -Wno-trustworthy-safe -Wmissing-pattern-synonym-signatures -Wno-redundant-constraints    hs-source-dirs: src @@ -352,9 +331,6 @@   hs-source-dirs: tests   default-language: Haskell2010 -  if impl(ghc >= 8.6)-    ghc-options: -Wno-star-is-type-   if flag(dump-splices)     ghc-options: -ddump-splices @@ -426,7 +402,7 @@   default-language: Haskell2010   build-depends:     base,-    base-compat >=0.11.0 && <0.12,+    base-compat >=0.11.0 && <0.13,     comonad,     criterion,     deepseq,
src/Control/Exception/Lens.hs view
@@ -4,22 +4,15 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}  #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif -#if __GLASGOW_HASKELL__ >= 710-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ViewPatterns #-}-#endif- #include "lens-common.h" -#if !(MIN_VERSION_exceptions(0,4,0))-#define MonadThrow MonadCatch-#endif- ----------------------------------------------------------------------------- -- | -- Module      :  Control.Exception.Lens@@ -55,21 +48,16 @@   , mappedException, mappedException'   -- * Exceptions   , exception-#if __GLASGOW_HASKELL__ >= 710   , pattern Exception-#endif   -- * Exception Handlers   , Handleable(..)   -- ** IOExceptions   , AsIOException(..)-#if __GLASGOW_HASKELL__ >= 710   , pattern IOException_-#endif   -- ** Arithmetic Exceptions   , AsArithException(..)   , _Overflow, _Underflow, _LossOfPrecision, _DivideByZero, _Denormal   , _RatioZeroDenominator-#if __GLASGOW_HASKELL__ >= 710   , pattern ArithException_   , pattern Overflow_   , pattern Underflow_@@ -77,108 +65,79 @@   , pattern DivideByZero_   , pattern Denormal_   , pattern RatioZeroDenominator_-#endif   -- ** Array Exceptions   , AsArrayException(..)   , _IndexOutOfBounds   , _UndefinedElement-#if __GLASGOW_HASKELL__ >= 710   , pattern ArrayException_   , pattern IndexOutOfBounds_   , pattern UndefinedElement_-#endif   -- ** Assertion Failed   , AsAssertionFailed(..)-#if __GLASGOW_HASKELL__ >= 710   , pattern AssertionFailed__   , pattern AssertionFailed_-#endif   -- ** Async Exceptions   , AsAsyncException(..)   , _StackOverflow   , _HeapOverflow   , _ThreadKilled   , _UserInterrupt-#if __GLASGOW_HASKELL__ >= 710   , pattern AsyncException_   , pattern StackOverflow_   , pattern HeapOverflow_   , pattern ThreadKilled_   , pattern UserInterrupt_-#endif   -- ** Non-Termination   , AsNonTermination(..)-#if __GLASGOW_HASKELL__ >= 710   , pattern NonTermination__   , pattern NonTermination_-#endif   -- ** Nested Atomically   , AsNestedAtomically(..)-#if __GLASGOW_HASKELL__ >= 710   , pattern NestedAtomically__   , pattern NestedAtomically_-#endif   -- ** Blocked Indefinitely   -- *** on MVar   , AsBlockedIndefinitelyOnMVar(..)-#if __GLASGOW_HASKELL__ >= 710   , pattern BlockedIndefinitelyOnMVar__   , pattern BlockedIndefinitelyOnMVar_-#endif   -- *** on STM   , AsBlockedIndefinitelyOnSTM(..)-#if __GLASGOW_HASKELL__ >= 710   , pattern BlockedIndefinitelyOnSTM__   , pattern BlockedIndefinitelyOnSTM_-#endif   -- ** Deadlock   , AsDeadlock(..)-#if __GLASGOW_HASKELL__ >= 710   , pattern Deadlock__   , pattern Deadlock_-#endif   -- ** No Such Method   , AsNoMethodError(..)-#if __GLASGOW_HASKELL__ >= 710   , pattern NoMethodError__   , pattern NoMethodError_-#endif   -- ** Pattern Match Failure   , AsPatternMatchFail(..)-#if __GLASGOW_HASKELL__ >= 710   , pattern PatternMatchFail__   , pattern PatternMatchFail_-#endif   -- ** Record   , AsRecConError(..)   , AsRecSelError(..)   , AsRecUpdError(..)-#if __GLASGOW_HASKELL__ >= 710   , pattern RecConError__   , pattern RecConError_   , pattern RecSelError__   , pattern RecSelError_   , pattern RecUpdError__   , pattern RecUpdError_-#endif   -- ** Error Call   , AsErrorCall(..)-#if __GLASGOW_HASKELL__ >= 710   , pattern ErrorCall__   , pattern ErrorCall_-#endif-#if MIN_VERSION_base(4,8,0)   -- ** Allocation Limit Exceeded   , AsAllocationLimitExceeded(..)   , pattern AllocationLimitExceeded__   , pattern AllocationLimitExceeded_-#endif-#if MIN_VERSION_base(4,9,0)   -- ** Type Error   , AsTypeError(..)   , pattern TypeError__   , pattern TypeError_-#endif #if MIN_VERSION_base(4,10,0)   -- ** Compaction Failed   , AsCompactionFailed(..)@@ -187,10 +146,8 @@ #endif   -- * Handling Exceptions   , AsHandlingException(..)-#if __GLASGOW_HASKELL__ >= 710   , pattern HandlingException__   , pattern HandlingException_-#endif   ) where  import Control.Applicative@@ -206,9 +163,7 @@   ( const, either, flip, id   , (.)   , Maybe(..), Either(..), String-#if __GLASGOW_HASKELL__ >= 710   , Bool(..)-#endif   )  -- $setup@@ -232,10 +187,9 @@ exception = prism' toException fromException {-# INLINE exception #-} -#if __GLASGOW_HASKELL__ >= 710+pattern Exception :: Exception a => a -> SomeException pattern Exception e <- (preview exception -> Just e) where   Exception e = review exception e-#endif  ------------------------------------------------------------------------------ -- Catching@@ -492,10 +446,9 @@   _IOException = exception   {-# INLINE _IOException #-} -#if __GLASGOW_HASKELL__ >= 710+pattern IOException_ :: AsIOException s => IOException -> s pattern IOException_ a <- (preview _IOException -> Just a) where   IOException_ a = review _IOException a-#endif  ---------------------------------------------------------------------------- -- ArithException@@ -510,10 +463,9 @@   -- @   _ArithException :: Prism' t ArithException -#if __GLASGOW_HASKELL__ >= 710+pattern ArithException_ :: AsArithException s => ArithException -> s pattern ArithException_ a <- (preview _ArithException -> Just a) where   ArithException_ a = review _ArithException a-#endif  instance AsArithException ArithException where   _ArithException = id@@ -539,10 +491,9 @@   seta t        = Left  (pure t) {-# INLINE _Overflow #-} -#if __GLASGOW_HASKELL__ >= 710+pattern Overflow_ :: AsArithException s => s pattern Overflow_ <- (has _Overflow -> True) where   Overflow_ = review _Overflow ()-#endif  -- | Handle arithmetic '_Underflow'. --@@ -560,10 +511,9 @@   seta t        = Left  (pure t) {-# INLINE _Underflow #-} -#if __GLASGOW_HASKELL__ >= 710+pattern Underflow_ :: AsArithException s => s pattern Underflow_ <- (has _Underflow -> True) where   Underflow_ = review _Underflow ()-#endif  -- | Handle arithmetic loss of precision. --@@ -581,10 +531,9 @@   seta t        = Left  (pure t) {-# INLINE _LossOfPrecision #-} -#if __GLASGOW_HASKELL__ >= 710+pattern LossOfPrecision_ :: AsArithException s => s pattern LossOfPrecision_ <- (has _LossOfPrecision -> True) where   LossOfPrecision_ = review _LossOfPrecision ()-#endif  -- | Handle division by zero. --@@ -602,10 +551,9 @@   seta t        = Left  (pure t) {-# INLINE _DivideByZero #-} -#if __GLASGOW_HASKELL__ >= 710+pattern DivideByZero_ :: AsArithException s => s pattern DivideByZero_ <- (has _DivideByZero -> True) where   DivideByZero_ = review _DivideByZero ()-#endif  -- | Handle exceptional _Denormalized floating pure. --@@ -623,10 +571,9 @@   seta t        = Left  (pure t) {-# INLINE _Denormal #-} -#if __GLASGOW_HASKELL__ >= 710+pattern Denormal_ :: AsArithException s => s pattern Denormal_ <- (has _Denormal -> True) where   Denormal_ = review _Denormal ()-#endif  -- | --@@ -644,10 +591,9 @@   seta t        = Left  (pure t) {-# INLINE _RatioZeroDenominator #-} -#if __GLASGOW_HASKELL__ >= 710+pattern RatioZeroDenominator_ :: AsArithException s => s pattern RatioZeroDenominator_ <- (has _RatioZeroDenominator -> True) where   RatioZeroDenominator_ = review _RatioZeroDenominator ()-#endif  ---------------------------------------------------------------------------- -- ArrayException@@ -671,10 +617,9 @@   _ArrayException = exception   {-# INLINE _ArrayException #-} -#if __GLASGOW_HASKELL__ >= 710+pattern ArrayException_ :: AsArrayException s => ArrayException -> s pattern ArrayException_ e <- (preview _ArrayException -> Just e) where   ArrayException_ e = review _ArrayException e-#endif  -- | An attempt was made to index an array outside its declared bounds. --@@ -692,10 +637,9 @@   seta t                    = Left  (pure t) {-# INLINE _IndexOutOfBounds #-} -#if __GLASGOW_HASKELL__ >= 710+pattern IndexOutOfBounds_ :: AsArrayException s => String -> s pattern IndexOutOfBounds_ e <- (preview _IndexOutOfBounds -> Just e) where   IndexOutOfBounds_ e = review _IndexOutOfBounds e-#endif  -- | An attempt was made to evaluate an element of an array that had not been initialized. --@@ -713,10 +657,9 @@   seta t                    = Left  (pure t) {-# INLINE _UndefinedElement #-} -#if __GLASGOW_HASKELL__ >= 710+pattern UndefinedElement_ :: AsArrayException s => String -> s pattern UndefinedElement_ e <- (preview _UndefinedElement -> Just e) where   UndefinedElement_ e = review _UndefinedElement e-#endif  ---------------------------------------------------------------------------- -- AssertionFailed@@ -755,13 +698,13 @@   __AssertionFailed = exception   {-# INLINE __AssertionFailed #-} -#if __GLASGOW_HASKELL__ >= 710+pattern AssertionFailed__ :: AsAssertionFailed s => AssertionFailed -> s pattern AssertionFailed__ e <- (preview __AssertionFailed -> Just e) where   AssertionFailed__ e = review __AssertionFailed e +pattern AssertionFailed_ :: AsAssertionFailed s => String -> s pattern AssertionFailed_ e <- (preview _AssertionFailed -> Just e) where   AssertionFailed_ e = review _AssertionFailed e-#endif  ---------------------------------------------------------------------------- -- AsyncException@@ -785,10 +728,9 @@   _AsyncException = exception   {-# INLINE _AsyncException #-} -#if __GLASGOW_HASKELL__ >= 710+pattern AsyncException_ :: AsAsyncException s => AsyncException -> s pattern AsyncException_ e <- (preview _AsyncException -> Just e) where   AsyncException_ e = review _AsyncException e-#endif  -- | The current thread's stack exceeded its limit. Since an 'Exception' has -- been raised, the thread's stack will certainly be below its limit again,@@ -804,10 +746,9 @@   seta t             = Left  (pure t) {-# INLINE _StackOverflow #-} -#if __GLASGOW_HASKELL__ >= 710+pattern StackOverflow_ :: AsAsyncException s => s pattern StackOverflow_ <- (has _StackOverflow -> True) where   StackOverflow_ = review _StackOverflow ()-#endif  -- | The program's heap is reaching its limit, and the program should take action -- to reduce the amount of live data it has.@@ -828,10 +769,9 @@   seta t            = Left  (pure t) {-# INLINE _HeapOverflow #-} -#if __GLASGOW_HASKELL__ >= 710+pattern HeapOverflow_ :: AsAsyncException s => s pattern HeapOverflow_ <- (has _HeapOverflow -> True) where   HeapOverflow_ = review _HeapOverflow ()-#endif  -- | This 'Exception' is raised by another thread calling -- 'Control.Concurrent.killThread', or by the system if it needs to terminate@@ -847,10 +787,9 @@   seta t            = Left  (pure t) {-# INLINE _ThreadKilled #-} -#if __GLASGOW_HASKELL__ >= 710+pattern ThreadKilled_ :: AsAsyncException s => s pattern ThreadKilled_ <- (has _ThreadKilled -> True) where   ThreadKilled_ = review _ThreadKilled ()-#endif  -- | This '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)@@ -866,10 +805,9 @@   seta t             = Left  (pure t) {-# INLINE _UserInterrupt #-} -#if __GLASGOW_HASKELL__ >= 710+pattern UserInterrupt_ :: AsAsyncException s => s pattern UserInterrupt_ <- (has _UserInterrupt -> True) where   UserInterrupt_ = review _UserInterrupt ()-#endif  ---------------------------------------------------------------------------- -- AsyncException@@ -907,13 +845,13 @@   __NonTermination = exception   {-# INLINE __NonTermination #-} -#if __GLASGOW_HASKELL__ >= 710+pattern NonTermination__ :: AsNonTermination s => NonTermination -> s pattern NonTermination__ e <- (preview __NonTermination -> Just e) where   NonTermination__ e = review __NonTermination e +pattern NonTermination_ :: AsNonTermination s => s pattern NonTermination_ <- (has _NonTermination -> True) where   NonTermination_ = review _NonTermination ()-#endif  ---------------------------------------------------------------------------- -- NestedAtomically@@ -950,13 +888,13 @@   __NestedAtomically = exception   {-# INLINE __NestedAtomically #-} -#if __GLASGOW_HASKELL__ >= 710+pattern NestedAtomically__ :: AsNestedAtomically s => NestedAtomically -> s pattern NestedAtomically__ e <- (preview __NestedAtomically -> Just e) where   NestedAtomically__ e = review __NestedAtomically e +pattern NestedAtomically_ :: AsNestedAtomically s => s pattern NestedAtomically_ <- (has _NestedAtomically -> True) where   NestedAtomically_ = review _NestedAtomically ()-#endif  ---------------------------------------------------------------------------- -- BlockedIndefinitelyOnMVar@@ -994,13 +932,13 @@   __BlockedIndefinitelyOnMVar = exception   {-# INLINE __BlockedIndefinitelyOnMVar #-} -#if __GLASGOW_HASKELL__ >= 710+pattern BlockedIndefinitelyOnMVar__ :: AsBlockedIndefinitelyOnMVar s => BlockedIndefinitelyOnMVar -> s pattern BlockedIndefinitelyOnMVar__ e <- (preview __BlockedIndefinitelyOnMVar -> Just e) where   BlockedIndefinitelyOnMVar__ e = review __BlockedIndefinitelyOnMVar e +pattern BlockedIndefinitelyOnMVar_ :: AsBlockedIndefinitelyOnMVar s => s pattern BlockedIndefinitelyOnMVar_ <- (has _BlockedIndefinitelyOnMVar -> True) where   BlockedIndefinitelyOnMVar_ = review _BlockedIndefinitelyOnMVar ()-#endif  ---------------------------------------------------------------------------- -- BlockedIndefinitelyOnSTM@@ -1038,13 +976,13 @@   __BlockedIndefinitelyOnSTM = exception   {-# INLINE __BlockedIndefinitelyOnSTM #-} -#if __GLASGOW_HASKELL__ >= 710+pattern BlockedIndefinitelyOnSTM__ :: AsBlockedIndefinitelyOnSTM s => BlockedIndefinitelyOnSTM -> s pattern BlockedIndefinitelyOnSTM__ e <- (preview __BlockedIndefinitelyOnSTM -> Just e) where   BlockedIndefinitelyOnSTM__ e = review __BlockedIndefinitelyOnSTM e +pattern BlockedIndefinitelyOnSTM_ :: AsBlockedIndefinitelyOnSTM s => s pattern BlockedIndefinitelyOnSTM_ <- (has _BlockedIndefinitelyOnSTM -> True) where   BlockedIndefinitelyOnSTM_ = review _BlockedIndefinitelyOnSTM ()-#endif  ---------------------------------------------------------------------------- -- Deadlock@@ -1081,13 +1019,13 @@   __Deadlock = exception   {-# INLINE __Deadlock #-} -#if __GLASGOW_HASKELL__ >= 710+pattern Deadlock__ :: AsDeadlock s => Deadlock -> s pattern Deadlock__ e <- (preview __Deadlock -> Just e) where   Deadlock__ e = review __Deadlock e +pattern Deadlock_ :: AsDeadlock s => s pattern Deadlock_ <- (has _Deadlock -> True) where   Deadlock_ = review _Deadlock ()-#endif  ---------------------------------------------------------------------------- -- NoMethodError@@ -1124,13 +1062,13 @@   __NoMethodError = exception   {-# INLINE __NoMethodError #-} -#if __GLASGOW_HASKELL__ >= 710+pattern NoMethodError__ :: AsNoMethodError s => NoMethodError -> s pattern NoMethodError__ e <- (preview __NoMethodError -> Just e) where   NoMethodError__ e = review __NoMethodError e +pattern NoMethodError_ :: AsNoMethodError s => String -> s pattern NoMethodError_ e <- (preview _NoMethodError -> Just e) where   NoMethodError_ e = review _NoMethodError e-#endif  ---------------------------------------------------------------------------- -- PatternMatchFail@@ -1166,13 +1104,13 @@   __PatternMatchFail = exception   {-# INLINE __PatternMatchFail #-} -#if __GLASGOW_HASKELL__ >= 710+pattern PatternMatchFail__ :: AsPatternMatchFail s => PatternMatchFail -> s pattern PatternMatchFail__ e <- (preview __PatternMatchFail -> Just e) where   PatternMatchFail__ e = review __PatternMatchFail e +pattern PatternMatchFail_ :: AsPatternMatchFail s => String -> s pattern PatternMatchFail_ e <- (preview _PatternMatchFail -> Just e) where   PatternMatchFail_ e = review _PatternMatchFail e-#endif  ---------------------------------------------------------------------------- -- RecConError@@ -1209,13 +1147,13 @@   __RecConError = exception   {-# INLINE __RecConError #-} -#if __GLASGOW_HASKELL__ >= 710+pattern RecConError__ :: AsRecConError s => RecConError -> s pattern RecConError__ e <- (preview __RecConError -> Just e) where   RecConError__ e = review __RecConError e +pattern RecConError_ :: AsRecConError s => String -> s pattern RecConError_ e <- (preview _RecConError -> Just e) where   RecConError_ e = review _RecConError e-#endif  ---------------------------------------------------------------------------- -- RecSelError@@ -1253,13 +1191,13 @@   __RecSelError = exception   {-# INLINE __RecSelError #-} -#if __GLASGOW_HASKELL__ >= 710+pattern RecSelError__ :: AsRecSelError s => RecSelError -> s pattern RecSelError__ e <- (preview __RecSelError -> Just e) where   RecSelError__ e = review __RecSelError e +pattern RecSelError_ :: AsRecSelError s => String -> s pattern RecSelError_ e <- (preview _RecSelError -> Just e) where   RecSelError_ e = review _RecSelError e-#endif  ---------------------------------------------------------------------------- -- RecUpdError@@ -1297,13 +1235,13 @@   __RecUpdError = exception   {-# INLINE __RecUpdError #-} -#if __GLASGOW_HASKELL__ >= 710+pattern RecUpdError__ :: AsRecUpdError s => RecUpdError -> s pattern RecUpdError__ e <- (preview __RecUpdError -> Just e) where   RecUpdError__ e = review __RecUpdError e +pattern RecUpdError_ :: AsRecUpdError s => String -> s pattern RecUpdError_ e <- (preview _RecUpdError -> Just e) where   RecUpdError_ e = review _RecUpdError e-#endif  ---------------------------------------------------------------------------- -- ErrorCall@@ -1344,15 +1282,14 @@   __ErrorCall = exception   {-# INLINE __ErrorCall #-} -#if __GLASGOW_HASKELL__ >= 710+pattern ErrorCall__ :: AsErrorCall s => ErrorCall -> s pattern ErrorCall__ e <- (preview __ErrorCall -> Just e) where   ErrorCall__ e = review __ErrorCall e +pattern ErrorCall_ :: AsErrorCall s => String -> s pattern ErrorCall_ e <- (preview _ErrorCall -> Just e) where   ErrorCall_ e = review _ErrorCall e-#endif -#if MIN_VERSION_base(4,8,0) ---------------------------------------------------------------------------- -- AllocationLimitExceeded ----------------------------------------------------------------------------@@ -1388,14 +1325,14 @@   __AllocationLimitExceeded = exception   {-# INLINE __AllocationLimitExceeded #-} +pattern AllocationLimitExceeded__ :: AsAllocationLimitExceeded s => AllocationLimitExceeded -> s pattern AllocationLimitExceeded__ e <- (preview __AllocationLimitExceeded -> Just e) where   AllocationLimitExceeded__ e = review __AllocationLimitExceeded e +pattern AllocationLimitExceeded_ :: AsAllocationLimitExceeded s => s pattern AllocationLimitExceeded_ <- (has _AllocationLimitExceeded -> True) where   AllocationLimitExceeded_ = review _AllocationLimitExceeded ()-#endif -#if MIN_VERSION_base(4,9,0) ---------------------------------------------------------------------------- -- TypeError ----------------------------------------------------------------------------@@ -1431,12 +1368,13 @@   __TypeError = exception   {-# INLINE __TypeError #-} +pattern TypeError__ :: AsTypeError s => TypeError -> s pattern TypeError__ e <- (preview __TypeError -> Just e) where   TypeError__ e = review __TypeError e +pattern TypeError_ :: AsTypeError s => String -> s pattern TypeError_ e <- (preview _TypeError -> Just e) where   TypeError_ e = review _TypeError e-#endif  #if MIN_VERSION_base(4,10,0) ----------------------------------------------------------------------------@@ -1474,9 +1412,11 @@   __CompactionFailed = exception   {-# INLINE __CompactionFailed #-} +pattern CompactionFailed__ :: AsCompactionFailed s => CompactionFailed -> s pattern CompactionFailed__ e <- (preview __CompactionFailed -> Just e) where   CompactionFailed__ e = review __CompactionFailed e +pattern CompactionFailed_ :: AsCompactionFailed s => String -> s pattern CompactionFailed_ e <- (preview _CompactionFailed -> Just e) where   CompactionFailed_ e = review _CompactionFailed e #endif@@ -1516,13 +1456,13 @@   __HandlingException = exception   {-# INLINE __HandlingException #-} -#if __GLASGOW_HASKELL__ >= 710+pattern HandlingException__ :: AsHandlingException s => HandlingException -> s pattern HandlingException__ e <- (preview __HandlingException -> Just e) where   HandlingException__ e = review __HandlingException e +pattern HandlingException_ :: AsHandlingException s => s pattern HandlingException_ <- (has _HandlingException -> True) where   HandlingException_ = review _HandlingException ()-#endif  ------------------------------------------------------------------------------ -- Helper Functions
src/Control/Lens/At.hs view
@@ -68,6 +68,7 @@ import Data.IntMap (IntMap) import qualified Data.IntSet as IntSet import Data.IntSet (IntSet)+import Data.Kind import qualified Data.Map as Map import Data.Map (Map) import Data.Maybe (isJust)@@ -87,7 +88,7 @@ import Data.Word import Foreign.Storable (Storable) -type family Index (s :: *) :: *+type family Index (s :: Type) :: Type type instance Index (e -> a) = e type instance Index IntSet = Int type instance Index (Set a) = a@@ -202,7 +203,7 @@   {-# INLINE contains #-}  -- | This provides a common notion of a value at an index that is shared by both 'Ixed' and 'At'.-type family IxValue (m :: *) :: *+type family IxValue (m :: Type) :: Type  -- | Provides a simple 'Traversal' lets you 'traverse' the value at a given -- key in a 'Map' or element at an ordinal position in a list or 'Seq'.
src/Control/Lens/Combinators.hs view
@@ -141,8 +141,6 @@   , (<>=)   , (%@~)   , (%@=)-#if __GLASGOW_HASKELL__ >= 710   , (:>)   , (:<)-#endif   )
src/Control/Lens/Cons.hs view
@@ -4,12 +4,10 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE ScopedTypeVariables #-}-#ifdef TRUSTWORTHY-{-# LANGUAGE Trustworthy #-}-#endif-#if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-}+#ifdef TRUSTWORTHY+{-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- |@@ -29,18 +27,14 @@   , cons   , uncons   , _head, _tail-#if __GLASGOW_HASKELL__ >= 710   , pattern (:<)-#endif   -- * Snoc   , Snoc(..)   , (|>)   , snoc   , unsnoc   , _init, _last-#if __GLASGOW_HASKELL__ >= 710   , pattern (:>)-#endif    ) where @@ -84,18 +78,16 @@ infixr 5 <|, `cons` infixl 5 |>, `snoc` -#if __GLASGOW_HASKELL__ >= 710-+pattern (:<) :: Cons b b a a => a -> b -> b pattern (:<) a s <- (preview _Cons -> Just (a,s)) where   (:<) a s = _Cons # (a,s)  infixr 5 :< infixl 5 :> +pattern (:>) :: Snoc a a b b => a -> b -> a pattern (:>) s a <- (preview _Snoc -> Just (s,a)) where   (:>) a s = _Snoc # (a,s)--#endif  ------------------------------------------------------------------------------ -- Cons
src/Control/Lens/Empty.hs view
@@ -1,15 +1,12 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}  #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif -#if __GLASGOW_HASKELL__ >= 710-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ViewPatterns #-}-#endif- ------------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Empty@@ -23,17 +20,13 @@ module Control.Lens.Empty   (     AsEmpty(..)-#if __GLASGOW_HASKELL__ >= 710   , pattern Empty-#endif   ) where  import Prelude ()  import Control.Lens.Iso-#if __GLASGOW_HASKELL__ >= 710 import Control.Lens.Fold-#endif import Control.Lens.Prism import Control.Lens.Internal.Prelude as Prelude import Control.Lens.Review@@ -79,10 +72,9 @@   _Empty = only mempty   {-# INLINE _Empty #-} -#if __GLASGOW_HASKELL__ >= 710+pattern Empty :: AsEmpty s => s pattern Empty <- (has _Empty -> True) where   Empty = review _Empty ()-#endif  {- Default Monoid instances -} instance AsEmpty Ordering
src/Control/Lens/Equality.hs view
@@ -3,11 +3,8 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE PolyKinds #-}-#if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE TypeInType #-} {-# LANGUAGE Trustworthy #-}-#endif  ----------------------------------------------------------------------------- -- |@@ -48,10 +45,8 @@ import Control.Lens.Type import Data.Proxy (Proxy) import Data.Type.Equality ((:~:)(..))-#if __GLASGOW_HASKELL__ >= 800 import GHC.Exts (TYPE) import Data.Kind (Type)-#endif  -- $setup -- >>> import Control.Lens@@ -78,22 +73,14 @@ {-# INLINE runEq #-}  -- | Substituting types with 'Equality'.-#if __GLASGOW_HASKELL__ >= 800 substEq :: forall s t a b rep (r :: TYPE rep).            AnEquality s t a b -> ((s ~ a, t ~ b) => r) -> r-#else-substEq :: AnEquality s t a b -> ((s ~ a, t ~ b) => r) -> r-#endif substEq l = case runEq l of   Identical -> \r -> r {-# INLINE substEq #-}  -- | We can use 'Equality' to do substitution into anything.-#if __GLASGOW_HASKELL__ >= 800 mapEq :: forall k1 k2 (s :: k1) (t :: k2) (a :: k1) (b :: k2) (f :: k1 -> Type) . AnEquality s t a b -> f s -> f a-#else-mapEq :: forall (s :: k1) (t :: k2) (a :: k1) (b :: k2) (f :: k1 -> *) . AnEquality s t a b -> f s -> f a-#endif mapEq l r = substEq l r {-# INLINE mapEq #-} @@ -104,12 +91,8 @@  -- | This is an adverb that can be used to modify many other 'Lens' combinators to make them require -- simple lenses, simple traversals, simple prisms or simple isos as input.-#if __GLASGOW_HASKELL__ >= 800 simply :: forall p f s a rep (r :: TYPE rep).   (Optic' p f s a -> r) -> Optic' p f s a -> r-#else-simply :: (Optic' p f s a -> r) -> Optic' p f s a -> r-#endif simply = id {-# INLINE simply #-} @@ -168,12 +151,7 @@  -- | A version of 'substEq' that provides explicit, rather than implicit, -- equality evidence.-#if __GLASGOW_HASKELL__ >= 800 withEquality :: forall s t a b rep (r :: TYPE rep).    AnEquality s t a b -> (s :~: a -> b :~: t -> r) -> r-#else-withEquality :: forall s t a b r.-   AnEquality s t a b -> (s :~: a -> b :~: t -> r) -> r-#endif withEquality an = substEq an (\f -> f Refl Refl) {-# INLINE withEquality #-}
src/Control/Lens/Fold.hs view
@@ -7,7 +7,7 @@ {-# LANGUAGE Trustworthy #-}  #include "lens-common.h"-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} ---------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Fold@@ -163,9 +163,7 @@ import Data.List (intercalate) import Data.Maybe (fromMaybe) import Data.Monoid (First (..), All (..), Any (..))-#if MIN_VERSION_reflection(2,1,0) import Data.Reflection-#endif  import qualified Data.Semigroup as Semi @@ -534,7 +532,7 @@ -- 'foldMapOf' :: 'Getting' r s a -> (a -> r) -> s -> r -- @ foldMapOf :: Getting r s a -> (a -> r) -> s -> r-foldMapOf l f = getConst #. l (Const #. f)+foldMapOf = coerce {-# INLINE foldMapOf #-}  -- | Combine the elements of a structure viewed through a 'Lens', 'Getter',@@ -1171,7 +1169,7 @@ -- 'concatMapOf' :: 'Traversal'' s a -> (a -> [r]) -> s -> [r] -- @ concatMapOf :: Getting [r] s a -> (a -> [r]) -> s -> [r]-concatMapOf l ces = getConst #. l (Const #. ces)+concatMapOf = coerce {-# INLINE concatMapOf #-}  -- | Concatenate all of the lists targeted by a 'Fold' into a longer list.@@ -1236,7 +1234,7 @@ -- way to extract the optional value. -- -- Note: if you get stack overflows due to this, you may want to use 'firstOf' instead, which can deal--- more gracefully with heavily left-biased trees. This is because '^?' works by using the +-- more gracefully with heavily left-biased trees. This is because '^?' works by using the -- 'Data.Monoid.First' monoid, which can occasionally cause space leaks. -- -- >>> Left 4 ^?_Left@@ -1251,7 +1249,7 @@ -- >>> "world" ^? ix 20 -- Nothing ----- This operator works as an infix version of 'preview'. +-- This operator works as an infix version of 'preview'. -- -- @ -- ('^?') ≡ 'flip' 'preview'@@ -1259,7 +1257,7 @@ -- -- It may be helpful to think of '^?' as having one of the following -- more specialized types:--- +-- -- @ -- ('^?') :: s -> 'Getter' s a     -> 'Maybe' a -- ('^?') :: s -> 'Fold' s a       -> 'Maybe' a@@ -1968,11 +1966,11 @@ -- @ -- 'preview' = 'view' '.' 'pre' -- @---  ----- Unlike '^?', this function uses a +--+-- Unlike '^?', this function uses a -- 'Control.Monad.Reader.MonadReader' to read the value to be focused in on.--- This allows one to pass the value as the last argument by using the +-- This allows one to pass the value as the last argument by using the -- 'Control.Monad.Reader.MonadReader' instance for @(->) s@ -- However, it may also be used as part of some deeply nested transformer stack. --@@ -1984,7 +1982,7 @@ -- -- It may be helpful to think of 'preview' as having one of the following -- more specialized types:--- +-- -- @ -- 'preview' :: 'Getter' s a     -> s -> 'Maybe' a -- 'preview' :: 'Fold' s a       -> s -> 'Maybe' a@@ -2000,7 +1998,7 @@ -- 'preview' :: 'MonadReader' s m => 'Lens'' s a      -> m ('Maybe' a) -- 'preview' :: 'MonadReader' s m => 'Iso'' s a       -> m ('Maybe' a) -- 'preview' :: 'MonadReader' s m => 'Traversal'' s a -> m ('Maybe' a)--- +-- -- @ preview :: MonadReader s m => Getting (First a) s a -> m (Maybe a) preview l = asks (getFirst #. foldMapOf l (First #. Just))@@ -2212,7 +2210,7 @@ -- @ -- ifoldMapOf :: IndexedGetting i m s a -> (i -> a -> m) -> s -> m-ifoldMapOf l f = getConst #. l (Const #. Indexed f)+ifoldMapOf = coerce {-# INLINE ifoldMapOf #-}  -- | Right-associative fold of parts of a structure that are viewed through an 'IndexedFold' or 'IndexedTraversal' with@@ -2269,7 +2267,7 @@ -- 'ianyOf' :: 'IndexedTraversal'' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' -- @ ianyOf :: IndexedGetting i Any s a -> (i -> a -> Bool) -> s -> Bool-ianyOf l f = getAny #. getConst #. l (Const #. Any #. Indexed f)+ianyOf = coerce {-# INLINE ianyOf #-}  -- | Return whether or not all elements viewed through an 'IndexedFold' or 'IndexedTraversal'@@ -2288,7 +2286,7 @@ -- 'iallOf' :: 'IndexedTraversal'' i s a -> (i -> a -> 'Bool') -> s -> 'Bool' -- @ iallOf :: IndexedGetting i All s a -> (i -> a -> Bool) -> s -> Bool-iallOf l f = getAll #. getConst #. l (Const #. All #. Indexed f)+iallOf = coerce {-# INLINE iallOf #-}  -- | Return whether or not none of the elements viewed through an 'IndexedFold' or 'IndexedTraversal'
src/Control/Lens/Getter.hs view
@@ -7,9 +7,7 @@ -- Disable the warnings generated by '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.-#if __GLASGOW_HASKELL__ >= 711-{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}-#endif+{-# OPTIONS_GHC -Wno-redundant-constraints #-}  ------------------------------------------------------------------------------- -- |@@ -286,7 +284,7 @@ -- 'views' :: 'MonadReader' s m => 'Getting' r s a -> (a -> r) -> m r -- @ views :: MonadReader s m => LensLike' (Const r) s a -> (a -> r) -> m r-views l f = Reader.asks (getConst #. l (Const #. f))+views l f = Reader.asks (coerce l f) {-# INLINE views #-}  -- | View the value pointed to by a 'Getter' or 'Lens' or the@@ -460,7 +458,7 @@ -- 'iviews' ≡ 'Control.Lens.Fold.ifoldMapOf' -- @ iviews :: MonadReader s m => IndexedGetting i r s a -> (i -> a -> r) -> m r-iviews l f = asks (getConst #. l (Const #. Indexed f))+iviews l f = asks (coerce l f) {-# INLINE iviews #-}  -- | Use the index and value of an 'IndexedGetter' into the current state as a pair.@@ -475,7 +473,7 @@ -- -- When applied to an 'IndexedFold' the result will be a monoidal summary instead of a single answer. iuses :: MonadState s m => IndexedGetting i r s a -> (i -> a -> r) -> m r-iuses l f = gets (getConst #. l (Const #. Indexed f))+iuses l f = gets (coerce l f) {-# INLINE iuses #-}  -- | View the index and value of an 'IndexedGetter' or 'IndexedLens'.
src/Control/Lens/Internal/Bazaar.hs view
@@ -4,9 +4,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE RoleAnnotations #-}-#if __GLASGOW_HASKELL__ >= 711-{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}-#endif+{-# OPTIONS_GHC -Wno-redundant-constraints #-}  ----------------------------------------------------------------------------- -- |@@ -36,6 +34,7 @@ import Control.Lens.Internal.Context import Control.Lens.Internal.Indexed import Data.Functor.Apply+import Data.Kind import Data.Profunctor.Rep  ------------------------------------------------------------------------------@@ -145,7 +144,7 @@ -- -- For example. This lets us write a suitably polymorphic and lazy 'Control.Lens.Traversal.taking', but there -- must be a better way!-newtype BazaarT p (g :: * -> *) a b t = BazaarT { runBazaarT :: forall f. Applicative f => p a (f b) -> f t }+newtype BazaarT p (g :: Type -> Type) a b t = BazaarT { runBazaarT :: forall f. Applicative f => p a (f b) -> f t } type role BazaarT representational nominal nominal nominal nominal  -- | This alias is helpful when it comes to reducing repetition in type signatures.@@ -226,8 +225,10 @@ instance Contravariant g => Monoid (BazaarT p g a b t) where   mempty = BazaarT $ \_ -> pure (error "mempty: BazaarT")   {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0))   BazaarT a `mappend` BazaarT b = BazaarT $ \f -> a f <* b f   {-# INLINE mappend #-}+#endif   ------------------------------------------------------------------------------@@ -321,7 +322,7 @@ -- -- For example. This lets us write a suitably polymorphic and lazy 'Control.Lens.Traversal.taking', but there -- must be a better way!-newtype BazaarT1 p (g :: * -> *) a b t = BazaarT1 { runBazaarT1 :: forall f. Apply f => p a (f b) -> f t }+newtype BazaarT1 p (g :: Type -> Type) a b t = BazaarT1 { runBazaarT1 :: forall f. Apply f => p a (f b) -> f t } type role BazaarT1 representational nominal nominal nominal nominal  -- | This alias is helpful when it comes to reducing repetition in type signatures.
src/Control/Lens/Internal/ByteString.hs view
@@ -47,11 +47,7 @@ import Data.Word (Word8) import Foreign.Ptr import Foreign.Storable-#if MIN_VERSION_base(4,8,0) import Foreign.ForeignPtr-#else-import Foreign.ForeignPtr.Safe-#endif import GHC.Base (unsafeChr) import GHC.ForeignPtr (mallocPlainForeignPtrBytes) import GHC.IO (unsafeDupablePerformIO)
− src/Control/Lens/Internal/Coerce.hs
@@ -1,35 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE Trustworthy #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}--------------------------------------------------------------------------------- |--- Copyright   :  (C) 2016 Edward Kmett and Eric Mertens--- License     :  BSD-style (see the file LICENSE)--- Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  experimental--- Portability :  non-portable------ This module provides a shim around 'coerce'.--- We need to work around a GHC 7.8-specific 'Coercible' solver bug(s).-------------------------------------------------------------------------------module Control.Lens.Internal.Coerce-  ( coerce-  , coerce'-  , (#..)-  ) where--import Data.Profunctor.Unsafe-import Data.Coerce--coerce' :: forall a b. Coercible a b => b -> a-#if __GLASGOW_HASKELL__ <710-coerce' = coerce (id :: a -> a)-#else-coerce' = coerce-#endif-{-# INLINE coerce' #-}--(#..) :: (Profunctor p, Coercible c b) => (b -> c) -> p a b -> p a c-(#..) = (#.)-{-# INLINE (#..) #-}
src/Control/Lens/Internal/Context.hs view
@@ -33,6 +33,7 @@ import Control.Comonad.Store.Class import Control.Lens.Internal.Indexed import Control.Lens.Internal.Prelude+import Data.Kind import Data.Profunctor.Rep import Prelude hiding ((.),id) @@ -279,7 +280,7 @@ -- This is used internally to permit a number of combinators to gracefully -- degrade when applied to a 'Control.Lens.Fold.Fold' or -- 'Control.Lens.Getter.Getter'.-newtype PretextT p (g :: * -> *) a b t = PretextT { runPretextT :: forall f. Functor f => p a (f b) -> f t }+newtype PretextT p (g :: Type -> Type) a b t = PretextT { runPretextT :: forall f. Functor f => p a (f b) -> f t }  -- really we want PretextT p g a b t to permit the last 3 arguments to be representational iff p and f accept representational arguments -- but that isn't currently an option in GHC
src/Control/Lens/Internal/Deque.hs view
@@ -173,10 +173,12 @@ instance Monoid (Deque a) where   mempty = BD 0 [] 0 []   {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0))   mappend xs ys     | size xs < size ys = foldr cons ys xs     | otherwise         = foldl snoc xs ys   {-# INLINE mappend #-}+#endif  -- | Check that a 'Deque' satisfies the balance invariants and rebalance if not. check :: Int -> [a] -> Int -> [a] -> Deque a
src/Control/Lens/Internal/Exception.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-}@@ -32,6 +31,7 @@ import Control.Lens.Fold import Control.Lens.Getter import Control.Monad.Catch as Catch+import Data.Kind import Data.Monoid import Data.Proxy import Data.Reflection@@ -45,7 +45,7 @@ -- -- This lets us write combinators to build handlers that are agnostic about the choice of -- which of these they use.-class Handleable e (m :: * -> *) (h :: * -> *) | h -> e m where+class Handleable e (m :: Type -> Type) (h :: Type -> Type) | h -> e m where   -- | This builds a 'Handler' for just the targets of a given 'Control.Lens.Type.Prism' (or any 'Getter', really).   --   -- @@@ -144,7 +144,7 @@ ------------------------------------------------------------------------------  -- | There was an 'Exception' caused by abusing the internals of a 'Handler'.-data HandlingException = HandlingException deriving (Show,Typeable)+data HandlingException = HandlingException deriving Show  instance Exception HandlingException @@ -158,8 +158,7 @@ -}  -- | This permits the construction of an \"impossible\" 'Control.Exception.Handler' that matches only if some function does.-newtype Handling a s (m :: * -> *) = Handling a-  deriving Typeable+newtype Handling a s (m :: Type -> Type) = Handling a  type role Handling representational nominal nominal @@ -172,7 +171,7 @@          , Typeable a, Typeable s          , Typeable m          )-    => Exception (Handling a (s :: *) m) where+    => Exception (Handling a (s :: Type) m) where   toException _ = SomeException HandlingException   {-# INLINE toException #-}   fromException = fmap Handling . reflect (Proxy :: Proxy s)
src/Control/Lens/Internal/FieldTH.hs view
@@ -439,10 +439,6 @@     -- We want to catch type families, but not *data* families. See #799.     _TypeFamilyD :: Getting Any Dec ()     _TypeFamilyD = _OpenTypeFamilyD.united <> _ClosedTypeFamilyD.united-      where-#if !(MIN_VERSION_template_haskell(2,11,0))-      _OpenTypeFamilyD = _FamilyD . _1 . _TypeFam-#endif    pickInstanceDec hasFamilies     | hasFamilies = do
src/Control/Lens/Internal/Fold.hs view
@@ -2,9 +2,7 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-}-#if __GLASGOW_HASKELL__ >= 711-{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}-#endif+{-# OPTIONS_GHC -Wno-redundant-constraints #-}  ----------------------------------------------------------------------------- -- |@@ -54,8 +52,10 @@ instance (Contravariant f, Applicative f) => Monoid (Folding f a) where   mempty = Folding noEffect   {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0))   Folding fr `mappend` Folding fs = Folding (fr *> fs)   {-# INLINE mappend #-}+#endif  ------------------------------------------------------------------------------ -- Traversed@@ -74,8 +74,10 @@ instance Applicative f => Monoid (Traversed a f) where   mempty = Traversed (pure (error "Traversed: value used"))   {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0))   Traversed ma `mappend` Traversed mb = Traversed (ma *> mb)   {-# INLINE mappend #-}+#endif  ------------------------------------------------------------------------------ -- TraversedF@@ -93,8 +95,10 @@ instance (Apply f, Applicative f) => Monoid (TraversedF a f) where   mempty = TraversedF (pure (error "TraversedF: value used"))   {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0))   TraversedF ma `mappend` TraversedF mb = TraversedF (ma *> mb)   {-# INLINE mappend #-}+#endif  ------------------------------------------------------------------------------ -- Sequenced@@ -114,8 +118,10 @@ instance Monad m => Monoid (Sequenced a m) where   mempty = Sequenced (return (error "Sequenced: value used"))   {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0))   Sequenced ma `mappend` Sequenced mb = Sequenced (ma >> mb)   {-# INLINE mappend #-}+#endif  ------------------------------------------------------------------------------ -- NonEmptyDList@@ -135,24 +141,26 @@ data Leftmost a = LPure | LLeaf a | LStep (Leftmost a)  instance Semigroup (Leftmost a) where-  (<>) = mappend-  {-# INLINE (<>) #-}--instance Monoid (Leftmost a) where-  mempty = LPure-  {-# INLINE mempty #-}-  mappend x y = LStep $ case x of+  x <> y = LStep $ case x of     LPure    -> y     LLeaf _  -> x     LStep x' -> case y of       -- The last two cases make firstOf produce a Just as soon as any element       -- is encountered, and possibly serve as a micro-optimisation; this-      -- behaviour can be disabled by replacing them with _ -> mappend x y'.+      -- behaviour can be disabled by replacing them with _ -> x <> y'.       -- Note that this means that firstOf (backwards folded) [1..] is Just _|_.       LPure    -> x'       LLeaf a  -> LLeaf $ fromMaybe a (getLeftmost x')       LStep y' -> mappend x' y' +instance Monoid (Leftmost a) where+  mempty = LPure+  {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0))+  mappend = (<>)+  {-# INLINE mappend #-}+#endif+ -- | Extract the 'Leftmost' element. This will fairly eagerly determine that it can return 'Just' -- the moment it sees any element at all. getLeftmost :: Leftmost a -> Maybe a@@ -164,23 +172,25 @@ data Rightmost a = RPure | RLeaf a | RStep (Rightmost a)  instance Semigroup (Rightmost a) where-  (<>) = mappend-  {-# INLINE (<>) #-}--instance Monoid (Rightmost a) where-  mempty = RPure-  {-# INLINE mempty #-}-  mappend x y = RStep $ case y of+  x <> y = RStep $ case y of     RPure    -> x     RLeaf _  -> y     RStep y' -> case x of       -- The last two cases make lastOf produce a Just as soon as any element       -- is encountered, and possibly serve as a micro-optimisation; this-      -- behaviour can be disabled by replacing them with _ -> mappend x y'.+      -- behaviour can be disabled by replacing them with _ -> x <> y'.       -- Note that this means that lastOf folded [1..] is Just _|_.       RPure    -> y'       RLeaf a  -> RLeaf $ fromMaybe a (getRightmost y')       RStep x' -> mappend x' y'++instance Monoid (Rightmost a) where+  mempty = RPure+  {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0))+  mappend = (<>)+  {-# INLINE mappend #-}+#endif  -- | Extract the 'Rightmost' element. This will fairly eagerly determine that it can return 'Just' -- the moment it sees any element at all.
src/Control/Lens/Internal/Indexed.hs view
@@ -49,7 +49,6 @@ import Data.Int import Data.Profunctor.Closed import Data.Profunctor.Rep-import Control.Lens.Internal.Coerce  -- $setup -- >>> :set -XNoOverloadedStrings@@ -152,7 +151,7 @@   {-# INLINE rmap #-}   (.#) ibc _ = coerce ibc   {-# INLINE (.#) #-}-  (#.) _ = coerce'+  (#.) _ = coerce   {-# INLINE (#.) #-}  instance Closed (Indexed i) where@@ -282,10 +281,12 @@     mempty = Indexing $ \i -> (i, mempty)     {-# INLINE mempty #-} +#if !(MIN_VERSION_base(4,11,0))     mappend (Indexing mx) (Indexing my) = Indexing $ \i -> case mx i of       (j, x) -> case my j of          ~(k, y) -> (k, mappend x y)     {-# INLINE mappend #-}+#endif  -- | Transform a 'Control.Lens.Traversal.Traversal' into an 'Control.Lens.Traversal.IndexedTraversal' or -- a 'Control.Lens.Fold.Fold' into an 'Control.Lens.Fold.IndexedFold', etc.
src/Control/Lens/Internal/Iso.hs view
@@ -20,10 +20,10 @@  import Data.Profunctor import Data.Profunctor.Unsafe-import Control.Lens.Internal.Coerce  import qualified Data.ByteString       as StrictB import qualified Data.ByteString.Lazy  as LazyB+import Data.Coerce import qualified Data.List.NonEmpty    as NonEmpty import qualified Data.Text             as StrictT import qualified Data.Text.Lazy        as LazyT@@ -56,7 +56,7 @@   {-# INLINE lmap #-}   rmap f (Exchange sa bt) = Exchange sa (f . bt)   {-# INLINE rmap #-}-  (#.) _ = coerce'+  (#.) _ = coerce   {-# INLINE (#.) #-}   (.#) p _ = coerce p 
src/Control/Lens/Internal/Level.hs view
@@ -127,10 +127,12 @@ instance Monoid (Deepening i a) where   mempty = Deepening $ \ _ k -> k Zero False   {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0))   mappend (Deepening l) (Deepening r) = Deepening $ \ n k -> case n of     0 -> k Zero True     _ -> let n' = n - 1 in l n' $ \x a -> r n' $ \y b -> k (lappend x y) (a || b)   {-# INLINE mappend #-}+#endif  -- | Generate the leaf of a given 'Deepening' based on whether or not we're at the correct depth. deepening :: i -> a -> Deepening i a
src/Control/Lens/Internal/List.hs view
@@ -13,11 +13,17 @@ ------------------------------------------------------------------------------- module Control.Lens.Internal.List   ( ordinalNub+  , stripSuffix   ) where +import Control.Monad (guard) import Data.IntSet (IntSet) import qualified Data.IntSet as IntSet +--- $setup+--- >>> :set -XNoOverloadedStrings+--- >>> import Control.Lens.Internal.List+ -- | Return the the subset of given ordinals within a given bound -- and in order of the first occurrence seen. --@@ -38,3 +44,30 @@   where   outOfBounds = x < 0 || l <= x   notUnique   = x `IntSet.member` seen++-- | \(\mathcal{O}(\min(m,n))\). The 'stripSuffix' function drops the given+-- suffix from a list. It returns 'Nothing' if the list did not end with the+-- suffix given, or 'Just' the list after the suffix, if it does.+--+-- >>> stripSuffix "bar" "foobar"+-- Just "foo"+--+-- >>> stripSuffix "foo" "foo"+-- Just ""+--+-- >>> stripSuffix "bar" "barfoo"+-- Nothing+--+-- >>> stripSuffix "foo" "barfoobaz"+-- Nothing+stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]+stripSuffix qs xs0 = go xs0 zs+  where+    zs = drp qs xs0+    drp (_:ps) (_:xs) = drp ps xs+    drp [] xs = xs+    drp _  [] = []+    go (_:xs) (_:ys) = go xs ys+    go xs [] = zipWith const xs0 zs <$ guard (xs == qs)+    go [] _  = Nothing -- impossible+{-# INLINE stripSuffix #-}
src/Control/Lens/Internal/Magma.hs view
@@ -42,6 +42,7 @@ import Data.Functor.Apply import Data.Functor.WithIndex import Data.Foldable.WithIndex+import Data.Kind import Data.Traversable.WithIndex  ------------------------------------------------------------------------------@@ -229,7 +230,7 @@ -- -- In @'TakingWhile' p g a b t@, @g@ has a @nominal@ role to avoid exposing an illegal _|_ via 'Contravariant', -- while the remaining arguments are degraded to a @nominal@ role by the invariants of 'Magma'-data TakingWhile p (g :: * -> *) a b t = TakingWhile Bool t (Bool -> Magma () t b (Corep p a))+data TakingWhile p (g :: Type -> Type) a b t = TakingWhile Bool t (Bool -> Magma () t b (Corep p a)) type role TakingWhile nominal nominal nominal nominal nominal  -- | Generate a 'Magma' with leaves only while the predicate holds from left to right.
src/Control/Lens/Internal/Prelude.hs view
@@ -33,6 +33,8 @@ #if !MIN_VERSION_base(4,10,0)   , liftA2 #endif+  -- * Data.Coerce+  , Coercible, coerce   -- * Data.Contravariant   , Contravariant (..), phantom   -- * Data.Monoid@@ -55,22 +57,15 @@  import Prelude hiding     ( userError -- hiding something always helps with CPP-#if MIN_VERSION_base(4,8,0)     , Applicative (..)     , Foldable (..)     , Traversable (..)     , Monoid (..)     , (<$>), (<$)-#else-    , foldr, foldl, length, elem, null-    , mapM, sequence-#endif #if MIN_VERSION_base(4,13,0)     , Semigroup (..) #endif-#if MIN_VERSION_base(4,8,0)     , Word-#endif     )  -- Prelude@@ -82,10 +77,8 @@ import Data.Word (Word)  -- Extras-#if MIN_VERSION_base(4,8,0) import Data.Function ((&)) import Data.Foldable (length, null)-#endif  #if !MIN_VERSION_base(4,10,0) import Control.Applicative (liftA2)@@ -96,6 +89,7 @@ #endif  import Control.Applicative (Alternative (..), Const (..), WrappedMonad (..), ZipList (..))+import Data.Coerce (Coercible, coerce) import Data.Functor.Compose (Compose (..)) import Data.Functor.Contravariant (Contravariant (..), phantom) import Data.Functor.Identity (Identity (..))@@ -112,49 +106,6 @@ -- TraversableWithIndex instances for tagged, vector and unordered-containers -- We import this here, so the instances propagate through all (most) of @lens@. import Data.Functor.WithIndex.Instances ()---- $setup--- >>> import Control.Lens--- >>> import Control.Monad.State--- >>> import Debug.SimpleReflect.Expr--- >>> import Debug.SimpleReflect.Vars as Vars hiding (f,g,h)--- >>> let f :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f--- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g--- >>> let h :: Expr -> Expr -> Expr; h = Debug.SimpleReflect.Vars.h--#if !(MIN_VERSION_base(4,8,0))--- | Passes the result of the left side to the function on the right side (forward pipe operator).------ This is the flipped version of ('$'), which is more common in languages like F# as (@|>@) where it is needed--- for inference. Here it is supplied for notational convenience and given a precedence that allows it--- to be nested inside uses of ('$').------ >>> a & f--- f a------ >>> "hello" & length & succ--- 6------ This combinator is commonly used when applying multiple 'Lens' operations in sequence.------ >>> ("hello","world") & _1.element 0 .~ 'j' & _1.element 4 .~ 'y'--- ("jelly","world")------ This reads somewhat similar to:------ >>> flip execState ("hello","world") $ do _1.element 0 .= 'j'; _1.element 4 .= 'y'--- ("jelly","world")-(&) :: a -> (a -> b) -> b-a & f = f a-{-# INLINE (&) #-}-infixl 1 &--null :: Foldable t => t a -> Bool-null = foldr (\_ _ -> False) True--length :: Foldable t => t a -> Int-length = foldl' (\c _ -> c+1) 0-#endif  #if !(MIN_VERSION_base(4,11,0)) -- | Infix flipped 'fmap'.
src/Control/Lens/Internal/Prism.hs view
@@ -17,7 +17,6 @@ import Prelude ()  import Control.Lens.Internal.Prelude-import Control.Lens.Internal.Coerce  ------------------------------------------------------------------------------ -- Prism: Market@@ -42,7 +41,7 @@   rmap f (Market bt seta) = Market (f . bt) (either (Left . f) Right . seta)   {-# INLINE rmap #-} -  (#.) _ = coerce'+  (#.) _ = coerce   {-# INLINE (#.) #-}   (.#) p _ = coerce p   {-# INLINE (.#) #-}
src/Control/Lens/Internal/TH.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskellQuotes #-} #ifdef TRUSTWORTHY # if MIN_VERSION_template_haskell(2,12,0) {-# LANGUAGE Safe #-}@@ -21,17 +22,17 @@ ---------------------------------------------------------------------------- module Control.Lens.Internal.TH where +import Control.Lens.Iso+import Control.Lens.Prism+import Control.Lens.Review+import Control.Lens.Type+import Control.Lens.Wrapped import Data.Functor.Contravariant import qualified Data.Set as Set import Data.Set (Set) import Language.Haskell.TH import qualified Language.Haskell.TH.Datatype as D import qualified Language.Haskell.TH.Datatype.TyVarBndr as D-import Language.Haskell.TH.Syntax-#ifndef CURRENT_PACKAGE_KEY-import Data.Version (showVersion)-import Paths_lens (version)-#endif  -- | Apply arguments to a type constructor appsT :: TypeQ -> [TypeQ] -> TypeQ@@ -84,9 +85,7 @@     go acc (ForallT _ _ ty) = go acc ty     go acc (AppT ty1 ty2)   = go (ty2:acc) ty1     go acc (SigT ty _)      = go acc ty-#if MIN_VERSION_template_haskell(2,11,0)     go acc (ParensT ty)     = go acc ty-#endif #if MIN_VERSION_template_haskell(2,15,0)     go acc (AppKindT ty _)  = go acc ty #endif@@ -141,15 +140,7 @@   where   vs = filter (\tvb -> D.tvName tvb `Set.notMember` exclude)      $ D.changeTVFlags D.SpecifiedSpec-     $ D.freeVariablesWellScoped (t:concatMap predTypes c) -- stable order--  predTypes :: Pred -> [Type]-#if MIN_VERSION_template_haskell(2,10,0)-  predTypes p = [p]-#else-  predTypes (ClassP _ ts)  = ts-  predTypes (EqualP t1 t2) = [t1, t2]-#endif+     $ D.freeVariablesWellScoped (t:c) -- stable order  -- | Convert a 'TyVarBndr' into its corresponding 'Type'. tvbToType :: D.TyVarBndr_ flag -> Type@@ -167,114 +158,92 @@ isDataFamily D.NewtypeInstance = True  --------------------------------------------------------------------------- Manually quoted names+-- TH-quoted names --------------------------------------------------------------------------- By manually generating these names we avoid needing to use the--- TemplateHaskell language extension when compiling the lens library.--- This allows the library to be used in stage1 cross-compilers.--lensPackageKey         :: String-#ifdef CURRENT_PACKAGE_KEY-lensPackageKey          = CURRENT_PACKAGE_KEY-#else-lensPackageKey          = "lens-" ++ showVersion version-#endif--mkLensName_tc          :: String -> String -> Name-mkLensName_tc           = mkNameG_tc lensPackageKey--mkLensName_v           :: String -> String -> Name-mkLensName_v            = mkNameG_v lensPackageKey+-- Note that this module only TemplateHaskellQuotes, not TemplateHaskell,+-- which makes lens able to be used in stage1 cross-compilers.  traversalTypeName      :: Name-traversalTypeName       = mkLensName_tc "Control.Lens.Type" "Traversal"+traversalTypeName       = ''Traversal  traversal'TypeName     :: Name-traversal'TypeName      = mkLensName_tc "Control.Lens.Type" "Traversal'"+traversal'TypeName      = ''Traversal'  lensTypeName           :: Name-lensTypeName            = mkLensName_tc "Control.Lens.Type" "Lens"+lensTypeName            = ''Lens  lens'TypeName          :: Name-lens'TypeName           = mkLensName_tc "Control.Lens.Type" "Lens'"+lens'TypeName           = ''Lens'  isoTypeName            :: Name-isoTypeName             = mkLensName_tc "Control.Lens.Type" "Iso"+isoTypeName             = ''Iso  iso'TypeName           :: Name-iso'TypeName            = mkLensName_tc "Control.Lens.Type" "Iso'"+iso'TypeName            = ''Iso'  getterTypeName         :: Name-getterTypeName          = mkLensName_tc "Control.Lens.Type" "Getter"+getterTypeName          = ''Getter  foldTypeName           :: Name-foldTypeName            = mkLensName_tc "Control.Lens.Type" "Fold"+foldTypeName            = ''Fold  prismTypeName          :: Name-prismTypeName           = mkLensName_tc "Control.Lens.Type" "Prism"+prismTypeName           = ''Prism  prism'TypeName         :: Name-prism'TypeName          = mkLensName_tc "Control.Lens.Type" "Prism'"+prism'TypeName          = ''Prism'  reviewTypeName          :: Name-reviewTypeName           = mkLensName_tc "Control.Lens.Type" "Review"+reviewTypeName           = ''Review  wrappedTypeName         :: Name-wrappedTypeName          = mkLensName_tc "Control.Lens.Wrapped" "Wrapped"+wrappedTypeName          = ''Wrapped  unwrappedTypeName       :: Name-unwrappedTypeName        = mkLensName_tc "Control.Lens.Wrapped" "Unwrapped"+unwrappedTypeName        = ''Unwrapped  rewrappedTypeName       :: Name-rewrappedTypeName        = mkLensName_tc "Control.Lens.Wrapped" "Rewrapped"+rewrappedTypeName        = ''Rewrapped  _wrapped'ValName        :: Name-_wrapped'ValName         = mkLensName_v "Control.Lens.Wrapped" "_Wrapped'"+_wrapped'ValName         = '_Wrapped'  isoValName              :: Name-isoValName               = mkLensName_v "Control.Lens.Iso" "iso"+isoValName               = 'iso  prismValName            :: Name-prismValName             = mkLensName_v "Control.Lens.Prism" "prism"+prismValName             = 'prism  untoValName             :: Name-untoValName              = mkLensName_v "Control.Lens.Review" "unto"+untoValName              = 'unto  phantomValName          :: Name-phantomValName           = mkLensName_v "Control.Lens.Internal.TH" "phantom2"+phantomValName           = 'phantom2  phantom2 :: (Functor f, Contravariant f) => f a -> f b phantom2 = phantom {-# INLINE phantom2 #-}  composeValName          :: Name-composeValName           = mkNameG_v "base" "GHC.Base" "."+composeValName           = '(.)  idValName               :: Name-idValName                = mkNameG_v "base" "GHC.Base" "id"+idValName                = 'id  fmapValName             :: Name-fmapValName              = mkNameG_v "base" "GHC.Base" "fmap"+fmapValName              = 'fmap -#if MIN_VERSION_base(4,8,0) pureValName             :: Name-pureValName              = mkNameG_v "base" "GHC.Base" "pure"--apValName               :: Name-apValName                = mkNameG_v "base" "GHC.Base" "<*>"-#else-pureValName             :: Name-pureValName              = mkNameG_v "base" "Control.Applicative" "pure"+pureValName              = 'pure  apValName               :: Name-apValName                = mkNameG_v "base" "Control.Applicative" "<*>"-#endif+apValName                = '(<*>)  rightDataName           :: Name-rightDataName            = mkNameG_d "base" "Data.Either" "Right"+rightDataName            = 'Right  leftDataName            :: Name-leftDataName             = mkNameG_d "base" "Data.Either" "Left"+leftDataName             = 'Left   ------------------------------------------------------------------------
src/Control/Lens/Internal/Zoom.hs view
@@ -4,7 +4,7 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE Trustworthy #-} -{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-}+{-# OPTIONS_GHC -Wno-orphans -Wno-warnings-deprecations #-} ----------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Internal.Zoom@@ -153,10 +153,12 @@ instance Monoid a => Monoid (May a) where   mempty = May (Just mempty)   {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0))   May Nothing `mappend` _ = May Nothing   _ `mappend` May Nothing = May Nothing   May (Just a) `mappend` May (Just b) = May (Just (mappend a b))   {-# INLINE mappend #-}+#endif  ------------------------------------------------------------------------------ -- FocusingMay@@ -195,10 +197,12 @@ instance Monoid a => Monoid (Err e a) where   mempty = Err (Right mempty)   {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0))   Err (Left e) `mappend` _ = Err (Left e)   _ `mappend` Err (Left e) = Err (Left e)   Err (Right a) `mappend` Err (Right b) = Err (Right (mappend a b))   {-# INLINE mappend #-}+#endif  ------------------------------------------------------------------------------ -- FocusingErr@@ -238,10 +242,12 @@ instance (Applicative f, Monoid a, Monad m) => Monoid (Freed f m a) where   mempty = Freed $ Pure mempty +#if !(MIN_VERSION_base(4,11,0))   Freed (Pure a) `mappend` Freed (Pure b) = Freed $ Pure $ a `mappend` b   Freed (Pure a) `mappend` Freed (Free g) = Freed $ Free $ liftA2 (liftM2 mappend) (pure $ return a) g   Freed (Free f) `mappend` Freed (Pure b) = Freed $ Free $ liftA2 (liftM2 mappend) f (pure $ return b)   Freed (Free f) `mappend` Freed (Free g) = Freed $ Free $ liftA2 (liftM2 mappend) f g+#endif  ------------------------------------------------------------------------------ -- FocusingFree@@ -288,8 +294,10 @@ instance (Monad m, Monoid r) => Monoid (Effect m r a) where   mempty = Effect (return mempty)   {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0))   Effect ma `mappend` Effect mb = Effect (liftM2 mappend ma mb)   {-# INLINE mappend #-}+#endif  instance (Apply m, Semigroup r) => Apply (Effect m r) where   Effect ma <.> Effect mb = Effect (liftF2 (<>) ma mb)
src/Control/Lens/Iso.hs view
@@ -2,16 +2,10 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}--#if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE Trustworthy #-}-#endif--#if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE TypeInType #-}-#endif  #include "lens-common.h" @@ -51,23 +45,15 @@   , curried, uncurried   , flipped   , swapped-#if __GLASGOW_HASKELL__ >= 710   , pattern Swapped-#endif   , strict, lazy-#if __GLASGOW_HASKELL__ >= 710   , pattern Strict   , pattern Lazy-#endif   , Reversing(..)   , reversed-#if __GLASGOW_HASKELL__ >= 710   , pattern Reversed-#endif   , involuted-#if __GLASGOW_HASKELL__ >= 710   , pattern List-#endif   -- ** Uncommon Isomorphisms   , magma   , imagma@@ -106,22 +92,10 @@ import Data.Profunctor import Data.Profunctor.Unsafe -#if !(MIN_VERSION_base(4,8,0))-import Data.Functor-#endif- import Data.Coerce-#if __GLASGOW_HASKELL__ < 710-import Data.Type.Coercion-#endif -#if __GLASGOW_HASKELL__ >= 710 import qualified GHC.Exts as Exts-#endif--#if __GLASGOW_HASKELL__ >= 800 import GHC.Exts (TYPE)-#endif  -- $setup -- >>> :set -XNoOverloadedStrings@@ -168,12 +142,8 @@  -- | Extract the two functions, one from @s -> a@ and -- one from @b -> t@ that characterize an 'Iso'.-#if __GLASGOW_HASKELL__ >= 800 withIso :: forall s t a b rep (r :: TYPE rep).              AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r-#else-withIso :: AnIso s t a b -> ((s -> a) -> (b -> t) -> r) -> r-#endif withIso ai k = case ai (Exchange id Identity) of   Exchange sa bt -> k sa (runIdentity #. bt) {-# INLINE withIso #-}@@ -433,19 +403,21 @@ strict = iso toStrict toLazy {-# INLINE strict #-} -#if __GLASGOW_HASKELL__ >= 710+pattern Strict :: Strict s t => t -> s pattern Strict a <- (view strict -> a) where   Strict a = review strict a +pattern Lazy :: Strict t s => t -> s pattern Lazy a <- (view lazy -> a) where   Lazy a = review lazy a +pattern Swapped :: Swap p => p b a -> p a b pattern Swapped a <- (view swapped -> a) where   Swapped a = review swapped a +pattern Reversed :: Reversing t => t -> t pattern Reversed a <- (view reversed -> a) where   Reversed a = review reversed a-#endif  -- | An 'Iso' between the strict variant of a structure and its lazy -- counterpart.@@ -483,10 +455,9 @@ involuted a = iso a a {-# INLINE involuted #-} -#if __GLASGOW_HASKELL__ >= 710+pattern List :: Exts.IsList l => [Exts.Item l] -> l pattern List a <- (Exts.toList -> a) where   List a = Exts.fromList a-#endif  ------------------------------------------------------------------------------ -- Magma@@ -598,14 +569,5 @@ -- -- @since 4.13 coerced :: forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b-# if __GLASGOW_HASKELL__ >= 710 coerced l = rmap (fmap coerce) l .# coerce-# else-coerced l = case sym Coercion :: Coercion a s of-              Coercion -> rmap (fmap coerce') l .# coerce--coerce' :: forall a b. Coercible a b => b -> a-coerce' = coerce (id :: a -> a)-{-# INLINE coerce' #-}-# endif {-# INLINE coerced #-}
src/Control/Lens/Lens.hs view
@@ -6,9 +6,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Trustworthy #-}-#if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE TypeInType #-}-#endif  #include "lens-common.h" @@ -140,9 +138,7 @@ import Data.Functor.Reverse import Data.Functor.Yoneda import Data.Semigroup.Traversable-#if __GLASGOW_HASKELL__ >= 800 import GHC.Exts (TYPE)-#endif  -- $setup -- >>> :set -XNoOverloadedStrings@@ -220,12 +216,8 @@ {-# INLINE lens #-}  -- | Obtain a getter and a setter from a lens, reversing 'lens'.-#if __GLASGOW_HASKELL__ >= 800 withLens :: forall s t a b rep (r :: TYPE rep).             ALens s t a b -> ((s -> a) -> (s -> b -> t) -> r) -> r-#else-withLens :: ALens s t a b -> ((s -> a) -> (s -> b -> t) -> r) -> r-#endif withLens l f = f (^# l) (flip (storing l)) {-# INLINE withLens #-} @@ -319,14 +311,7 @@ -- ('%%=') :: ('MonadState' s m, 'Monoid' r) => 'Control.Lens.Traversal.Traversal' s s a b -> (a -> (r, b)) -> m r -- @ (%%=) :: MonadState s m => Over p ((,) r) s s a b -> p a (r, b) -> m r-#if MIN_VERSION_mtl(2,1,1) l %%= f = State.state (l f)-#else-l %%= f = do-  (r, s) <- State.gets (l f)-  State.put s-  return r-#endif {-# INLINE (%%=) #-}  -------------------------------------------------------------------------------@@ -1297,14 +1282,7 @@ -- ('%%@=') :: ('MonadState' s m, 'Monoid' r) => 'Control.Lens.Traversal.IndexedTraversal' i s s a b -> (i -> a -> (r, b)) -> s -> m r -- @ (%%@=) :: MonadState s m => Over (Indexed i) ((,) r) s s a b -> (i -> a -> (r, b)) -> m r-#if MIN_VERSION_mtl(2,1,0) l %%@= f = State.state (l %%@~ f)-#else-l %%@= f = do-  (r, s) <- State.gets (l %%@~ f)-  State.put s-  return r-#endif {-# INLINE (%%@=) #-}  -- | Adjust the target of an 'IndexedLens' returning the intermediate result, or@@ -1328,14 +1306,7 @@ -- ('<<%@=') :: ('MonadState' s m, 'Monoid' b) => 'Control.Lens.Traversal.IndexedTraversal' i s s a b -> (i -> a -> b) -> m a -- @ (<<%@=) :: MonadState s m => Over (Indexed i) ((,) a) s s a b -> (i -> a -> b) -> m a-#if MIN_VERSION_mtl(2,1,0) l <<%@= f = State.state (l (Indexed $ \ i a -> (a, f i a)))-#else-l <<%@= f = do-  (r, s) <- State.gets (l (Indexed $ \ i a -> (a, f i a)))-  State.put s-  return r-#endif {-# INLINE (<<%@=) #-}  ------------------------------------------------------------------------------@@ -1407,15 +1378,7 @@  -- | A version of ('%%=') that works on 'ALens'. (#%%=) :: MonadState s m => ALens s s a b -> (a -> (r, b)) -> m r-#if MIN_VERSION_mtl(2,1,1) l #%%= f = State.state $ \s -> runPretext (l sell s) f-#else-l #%%= f = do-  p <- State.gets (l sell)-  let (r, t) = runPretext p f-  State.put t-  return r-#endif {-# INLINE (#%%=) #-}  -- | A version of ('Control.Lens.Setter.<.~') that works on 'ALens'.
src/Control/Lens/Plated.hs view
@@ -11,13 +11,6 @@ {-# LANGUAGE Trustworthy #-} -- template-haskell #endif -#if __GLASGOW_HASKELL__ < 710-{-# LANGUAGE OverlappingInstances #-}-#define OVERLAPPING_PRAGMA-#else-#define OVERLAPPING_PRAGMA {-# OVERLAPPING #-}-#endif- #include "lens-common.h"  -------------------------------------------------------------------------------@@ -33,7 +26,7 @@ -- used by the \"Scrap Your Boilerplate\" papers, and later inherited by Neil -- Mitchell's \"Uniplate\". ----- <http://community.haskell.org/~ndm/uniplate/>+-- <https://www.cs.york.ac.uk/fp/darcs/uniplate/uniplate.htm> -- -- The combinators in here are designed to be compatible with and subsume the -- @uniplate@ API with the notion of a 'Traversal' replacing@@ -109,9 +102,6 @@ import Control.Monad.Free as Monad import Control.Monad.Free.Church as Church import Control.Monad.Trans.Free as Trans-#if !(MIN_VERSION_free(4,6,0))-import Control.MonadPlus.Free as MonadPlus-#endif import qualified Language.Haskell.TH as TH import Data.Data import Data.Data.Lens@@ -121,7 +111,7 @@ -- $setup -- >>> :set -XDeriveGeneric -XDeriveDataTypeable -- >>> import Control.Applicative--- >>> import Data.Data (Data, Typeable)+-- >>> import Data.Data (Data) -- >>> import GHC.Generics (Generic) -- >>> import Control.Lens @@ -142,7 +132,7 @@ --   = Val 'Int' --   | Neg Expr --   | Add Expr Expr---   deriving ('Eq','Ord','Show','Read','Data','Typeable')+--   deriving ('Eq','Ord','Show','Read','Data') -- @ -- -- @@@ -173,7 +163,7 @@ -- data Tree a --   = Bin (Tree a) (Tree a) --   | Tip a---   deriving ('Eq','Ord','Show','Read','Data','Typeable')+--   deriving ('Eq','Ord','Show','Read','Data') -- @ -- -- @@@ -234,13 +224,6 @@ instance (Traversable f, Traversable m) => Plated (Trans.FreeT f m a) where   plate f (Trans.FreeT xs) = Trans.FreeT <$> traverse (traverse f) xs -#if !(MIN_VERSION_free(4,6,0))-instance Traversable f => Plated (MonadPlus.Free f a) where-  plate f (MonadPlus.Free as) = MonadPlus.Free <$> traverse f as-  plate f (MonadPlus.Plus as) = MonadPlus.Plus <$> traverse f as-  plate _ x         = pure x-#endif- instance Traversable f => Plated (Church.F f a) where   plate f = fmap Church.toF . plate (fmap Church.fromF . f . Church.toF) . Church.fromF @@ -735,7 +718,7 @@ -- -- For example consider mutually recursive even and odd natural numbers: ----- >>> data Even = Z | E Odd deriving (Show, Generic, Typeable, Data); data Odd = O Even deriving (Show, Generic, Typeable, Data)+-- >>> data Even = Z | E Odd deriving (Show, Generic, Data); data Odd = O Even deriving (Show, Generic, Data) -- -- Then 'uniplate', which is based on `Data`, finds -- all even numbers less or equal than four:@@ -783,7 +766,7 @@   gplate' f (x :*: y) = (:*:) <$> gplate' f x <*> gplate' f y   {-# INLINE gplate' #-} -instance OVERLAPPING_PRAGMA GPlated a (K1 i a) where+instance {-# OVERLAPPING #-} GPlated a (K1 i a) where   gplate' f (K1 x) = K1 <$> f x   {-# INLINE gplate' #-} @@ -799,11 +782,9 @@   gplate' _ v = v `seq` error "GPlated/V1"   {-# INLINE gplate' #-} -#if MIN_VERSION_base(4,9,0) instance GPlated a (URec b) where   gplate' _ = pure   {-# INLINE gplate' #-}-#endif  -- | Implement 'plate' operation for a type using its 'Generic1' instance. gplate1 :: (Generic1 f, GPlated1 f (Rep1 f)) => Traversal' (f a) (f a)@@ -850,7 +831,7 @@   {-# INLINE gplate1' #-}  -- | match-instance OVERLAPPING_PRAGMA GPlated1 f (Rec1 f) where+instance {-# OVERLAPPING #-} GPlated1 f (Rec1 f) where   gplate1' f (Rec1 x) = Rec1 <$> f x   {-# INLINE gplate1' #-} @@ -864,9 +845,7 @@   gplate1' f (Comp1 x) = Comp1 <$> traverse (gplate1' f) x   {-# INLINE gplate1' #-} -#if MIN_VERSION_base(4,9,0) -- | ignored instance GPlated1 f (URec a) where   gplate1' _ = pure   {-# INLINE gplate1' #-}-#endif
src/Control/Lens/Prism.hs view
@@ -34,6 +34,7 @@   , below   , isn't   , matching+  , matching'   -- * Common Prisms   , _Left   , _Right@@ -43,24 +44,28 @@   , _Show   , only   , nearly+  , Prefixed(..)+  , Suffixed(..)   -- * Prismatic profunctors   , Choice(..)   ) where +import Prelude ()+ import Control.Applicative+import qualified Control.Lens.Internal.List as List import Control.Lens.Internal.Prism+import Control.Lens.Internal.Prelude import Control.Lens.Lens import Control.Lens.Review import Control.Lens.Type import Control.Monad-import Data.Functor.Identity-import Data.Profunctor+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import qualified Data.List as List import Data.Profunctor.Rep-import Data.Profunctor.Sieve-import Data.Traversable-import Data.Void-import Data.Coerce-import Prelude+import qualified Data.Text as TS+import qualified Data.Text.Lazy as TL  -- $setup -- >>> :set -XNoOverloadedStrings@@ -203,6 +208,24 @@ matching k = withPrism k $ \_ seta -> seta {-# INLINE matching #-} +-- | Like 'matching', but also works for combinations of 'Lens' and 'Prism's,+-- and also 'Traversal's.+--+-- >>> matching' (_2 . _Just) ('x', Just True)+-- Right True+--+-- >>> matching' (_2 . _Just) ('x', Nothing :: Maybe Int) :: Either (Char, Maybe Bool) Int+-- Left ('x',Nothing)+--+-- >>> matching' traverse "" :: Either [Int] Char+-- Left []+--+-- >>> matching' traverse "xyz" :: Either [Int] Char+-- Right 'x'+matching' :: LensLike (Either a) s t a b -> s -> Either t a+matching' k = either Right Left . k Left+{-# INLINE matching' #-}+ ------------------------------------------------------------------------------ -- Common Prisms ------------------------------------------------------------------------------@@ -361,3 +384,71 @@   [(a,"")] -> Right a   _ -> Left s {-# INLINE _Show #-}++class Prefixed t where+  -- | A 'Prism' stripping a prefix from a sequence when used as a 'Traversal',+  -- or prepending that prefix when run backwards:+  --+  -- >>> "preview" ^? prefixed "pre"+  -- Just "view"+  --+  -- >>> "review" ^? prefixed "pre"+  -- Nothing+  --+  -- >>> prefixed "pre" # "amble"+  -- "preamble"+  prefixed :: t -> Prism' t t++instance Eq a => Prefixed [a] where+  prefixed ps = prism' (ps ++) (List.stripPrefix ps)+  {-# INLINE prefixed #-}++instance Prefixed TS.Text where+  prefixed p = prism' (p <>) (TS.stripPrefix p)+  {-# INLINE prefixed #-}++instance Prefixed TL.Text where+  prefixed p = prism' (p <>) (TL.stripPrefix p)+  {-# INLINE prefixed #-}++instance Prefixed BS.ByteString where+  prefixed p = prism' (p <>) (BS.stripPrefix p)+  {-# INLINE prefixed #-}++instance Prefixed BL.ByteString where+  prefixed p = prism' (p <>) (BL.stripPrefix p)+  {-# INLINE prefixed #-}++class Suffixed t where+  -- | A 'Prism' stripping a suffix from a sequence when used as a 'Traversal',+  -- or appending that suffix when run backwards:+  --+  -- >>> "review" ^? suffixed "view"+  -- Just "re"+  --+  -- >>> "review" ^? suffixed "tire"+  -- Nothing+  --+  -- >>> suffixed ".o" # "hello"+  -- "hello.o"+  suffixed :: t -> Prism' t t++instance Eq a => Suffixed [a] where+  suffixed qs = prism' (++ qs) (List.stripSuffix qs)+  {-# INLINE suffixed #-}++instance Suffixed TS.Text where+  suffixed qs = prism' (<> qs) (TS.stripSuffix qs)+  {-# INLINE suffixed #-}++instance Suffixed TL.Text where+  suffixed qs = prism' (<> qs) (TL.stripSuffix qs)+  {-# INLINE suffixed #-}++instance Suffixed BS.ByteString where+  suffixed qs = prism' (<> qs) (BS.stripSuffix qs)+  {-# INLINE suffixed #-}++instance Suffixed BL.ByteString where+  suffixed qs = prism' (<> qs) (BL.stripSuffix qs)+  {-# INLINE suffixed #-}
src/Control/Lens/Reified.hs view
@@ -416,8 +416,10 @@ instance Monoid (ReifiedFold s a) where   mempty = Fold ignored   {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0))   mappend = (<|>)   {-# INLINE mappend #-}+#endif  instance Alt (ReifiedFold s) where   (<!>) = (<|>)@@ -440,8 +442,10 @@ instance Monoid (ReifiedIndexedFold i s a) where   mempty = IndexedFold ignored   {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0))   mappend = (<!>)   {-# INLINE mappend #-}+#endif  instance Alt (ReifiedIndexedFold i s) where   IndexedFold ma <!> IndexedFold mb = IndexedFold $
src/Control/Lens/Review.hs view
@@ -2,9 +2,7 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE Trustworthy #-} -#if __GLASGOW_HASKELL__ >= 800 {-# OPTIONS_GHC -Wno-redundant-constraints -Wno-trustworthy-safe #-}-#endif ------------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Review
src/Control/Lens/Setter.hs view
@@ -288,7 +288,7 @@  -- | Restore 'ASetter' to a full 'Setter'. cloneSetter :: ASetter s t a b -> Setter s t a b-cloneSetter l afb = taintedDot $ runIdentity #. l (Identity #. untaintedDot afb)+cloneSetter l afb = taintedDot $ coerce l (untaintedDot afb) {-# INLINE cloneSetter #-}  -- | Build an 'IndexPreservingSetter' from any 'Setter'.@@ -347,7 +347,7 @@ -- 'over' :: 'ASetter' s t a b -> (a -> b) -> s -> t -- @ over :: ASetter s t a b -> (a -> b) -> s -> t-over l f = runIdentity #. l (Identity #. f)+over = coerce {-# INLINE over #-}  -- | Replace the target of a 'Lens' or all of the targets of a 'Setter'@@ -1175,7 +1175,7 @@ -- 'iover' :: 'IndexedTraversal' i s t a b -> (i -> a -> b) -> s -> t -- @ iover :: AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t-iover l f = runIdentity #. l (Identity #. Indexed f)+iover = coerce {-# INLINE iover #-}  -- | Set with index. Equivalent to 'iover' with the current value ignored.
src/Control/Lens/TH.hs view
@@ -469,13 +469,8 @@ -- | Transform @NewtypeD@s declarations to @DataD@s and @NewtypeInstD@s to -- @DataInstD@s. deNewtype :: Dec -> Dec-#if MIN_VERSION_template_haskell(2,11,0) deNewtype (NewtypeD ctx tyName args kind c d) = DataD ctx tyName args kind [c] d deNewtype (NewtypeInstD ctx tyName args kind c d) = DataInstD ctx tyName args kind [c] d-#else-deNewtype (NewtypeD ctx tyName args c d) = DataD ctx tyName args [c] d-deNewtype (NewtypeInstD ctx tyName args c d) = DataInstD ctx tyName args [c] d-#endif deNewtype d = d  @@ -491,11 +486,7 @@  makeDataDecl :: Dec -> Maybe DataDecl makeDataDecl dec = case deNewtype dec of-  DataD ctx tyName args-#if MIN_VERSION_template_haskell(2,11,0)-        _-#endif-        cons _ -> Just DataDecl+  DataD ctx tyName args _ cons _ -> Just DataDecl     { dataContext = ctx     , tyConName = Just tyName     , dataParameters = args@@ -505,11 +496,7 @@ #if MIN_VERSION_template_haskell(2,15,0)   DataInstD ctx _ fnArgs _ cons _ #else-  DataInstD ctx familyName args-#if MIN_VERSION_template_haskell(2,11,0)-            _-#endif-            cons _+  DataInstD ctx familyName args _ cons _ #endif                     -> Just DataDecl     { dataContext = ctx@@ -589,11 +576,7 @@        appliedType' = return (fullType dataDecl (map VarT typeArgs'))         -- Con a' b' c'... ~ t-#if MIN_VERSION_template_haskell(2,10,0)        eq = AppT. AppT EqualityT <$> appliedType' <*> t-#else-       eq = equalP appliedType' t-#endif         -- Rewrapped (Con a b c...) t        klass = conT rewrappedTypeName `appsT` [appliedType, t]@@ -855,16 +838,11 @@        -- Recurse into instance declarations because they main contain       -- associated data family instances.-#if MIN_VERSION_template_haskell(2,11,0)       InstanceD moverlap ctx inst body -> InstanceD moverlap ctx inst <$> traverse go body-#else-      InstanceD ctx inst body -> InstanceD  ctx inst <$> traverse go body-#endif       _ -> pure dec  stripFields :: Dec -> Dec stripFields dec = case dec of-#if MIN_VERSION_template_haskell(2,11,0)   DataD ctx tyName tyArgs kind cons derivings ->     DataD ctx tyName tyArgs kind (map deRecord cons) derivings   NewtypeD ctx tyName tyArgs kind con derivings ->@@ -873,16 +851,6 @@     DataInstD ctx tyName tyArgs kind (map deRecord cons) derivings   NewtypeInstD ctx tyName tyArgs kind con derivings ->     NewtypeInstD ctx tyName tyArgs kind (deRecord con) derivings-#else-  DataD ctx tyName tyArgs cons derivings ->-    DataD ctx tyName tyArgs (map deRecord cons) derivings-  NewtypeD ctx tyName tyArgs con derivings ->-    NewtypeD ctx tyName tyArgs (deRecord con) derivings-  DataInstD ctx tyName tyArgs cons derivings ->-    DataInstD ctx tyName tyArgs (map deRecord cons) derivings-  NewtypeInstD ctx tyName tyArgs con derivings ->-    NewtypeInstD ctx tyName tyArgs (deRecord con) derivings-#endif   _ -> dec  deRecord :: Con -> Con@@ -890,14 +858,8 @@ deRecord con@InfixC{} = con deRecord (ForallC tyVars ctx con) = ForallC tyVars ctx $ deRecord con deRecord (RecC conName fields) = NormalC conName (map dropFieldName fields)-#if MIN_VERSION_template_haskell(2,11,0) deRecord con@GadtC{} = con deRecord (RecGadtC ns fields retTy) = GadtC ns (map dropFieldName fields) retTy-#endif -#if MIN_VERSION_template_haskell(2,11,0)-dropFieldName :: VarBangType   -> BangType-#else-dropFieldName :: VarStrictType -> StrictType-#endif+dropFieldName :: VarBangType -> BangType dropFieldName (_, str, typ) = (str, typ)
src/Control/Lens/Traversal.hs view
@@ -55,6 +55,7 @@   , Traversing1, Traversing1'    -- * Traversing and Lensing+  , traversal   , traverseOf, forOf, sequenceAOf   , mapMOf, forMOf, sequenceOf   , transposeOf@@ -166,6 +167,7 @@ -- $setup -- >>> :set -XNoOverloadedStrings -XFlexibleContexts -- >>> import Data.Char (toUpper)+-- >>> import Control.Applicative -- >>> import Control.Lens -- >>> import Control.Lens.Internal.Context -- >>> import Control.DeepSeq (NFData (..), force)@@ -178,6 +180,8 @@ -- >>> import System.Timeout (timeout) -- >>> import qualified Data.List.NonEmpty as NonEmpty -- >>> let timingOut :: NFData a => a -> IO a; timingOut = fmap (fromMaybe (error "timeout")) . timeout (5*10^6) . evaluate . force+-- >>> let firstAndThird :: Traversal (a, x, a) (b, x, b) a b; firstAndThird = traversal go where { go :: Applicative f => (a -> f b) -> (a, x, a) -> f (b, x, b); go focus (a, x, a') = liftA3 (,,) (focus a) (pure x) (focus a') }+-- >>> let selectNested :: Traversal (x, [a]) (x, [b]) a b; selectNested = traversal go where { go :: Applicative f => (a -> f b) -> (x, [a]) -> f (x, [b]); go focus (x, as) = liftA2 (,) (pure x) (traverse focus as) }  ------------------------------------------------------------------------------ -- Traversals@@ -244,6 +248,70 @@ -- Traversal Combinators -------------------------- +-- | Build a 'Traversal' by providing a function which specifies the elements you wish to+-- focus.+--+-- The caller provides a function of type:+--+-- @+-- Applicative f => (a -> f b) -> s -> f t+-- @+--+-- Which is a higher order function which accepts a "focusing function" and applies+-- it to all desired focuses within @s@, then constructs a @t@ using the Applicative+-- instance of @f@.+--+-- Only elements which are "focused" using the focusing function will be targeted by the+-- resulting traversal.+--+-- For example, we can explicitly write a traversal which targets the first and third elements+-- of a tuple like this:+--+-- @+-- firstAndThird :: Traversal (a, x, a) (b, x, b) a b+-- firstAndThird = traversal go+--   where+--     go :: Applicative f => (a -> f b) -> (a, x, a) -> f (b, x, b)+--     go focus (a, x, a') = liftA3 (,,) (focus a) (pure x) (focus a')+-- @+--+-- >>> (1,"two",3) & firstAndThird *~ 10+-- (10,"two",30)+--+-- >>> over firstAndThird length ("one",2,"three")+-- (3,2,5)+--+-- We can re-use existing 'Traversal's when writing new ones by passing our focusing function+-- along to them. This example re-uses 'traverse' to focus all elements in a list which is+-- embedded in a tuple. This traversal could also be written simply as @_2 . traverse@.+--+-- @+-- selectNested :: Traversal (x, [a]) (x, [b]) a b+-- selectNested = traversal go+--   where+--     go :: Applicative f => (a -> f b) -> (x, [a]) -> f (x, [b])+--     go focus (x, as) = liftA2 (,) (pure x) (traverse focus as)+-- @+--+-- >>> selectNested .~ "hello" $ (1,[2,3,4,5])+-- (1,["hello","hello","hello","hello"])+--+-- >>> (1,[2,3,4,5]) & selectNested *~ 3+-- (1,[6,9,12,15])+--+-- Note that the 'traversal' function actually just returns the same function you pass to+-- it. The function it accepts is in fact a valid traversal all on its own! The use of+-- 'traversal' does nothing except verify that the function it is passed matches the signature+-- of a valid traversal. One could remove the @traversal@ cominator from either of the last+-- two examples and use the definiton of @go@ directly with no change in behaviour.+--+-- This function exists for consistency with the 'lens', 'prism' and 'iso' constructors+-- as well as to serve as a touchpoint for beginners who wish to construct their own+-- traversals but are uncertain how to do so.+traversal :: ((a -> f b) -> s -> f t) -> LensLike f s t a b+traversal = id+{-# INLINE traversal #-}+ -- | Map each element of a structure targeted by a 'Lens' or 'Traversal', -- evaluate these actions from left to right, and collect the results. --@@ -344,7 +412,7 @@ -- 'mapMOf' :: 'Monad' m => 'Traversal' s t a b -> (a -> m b) -> s -> m t -- @ mapMOf :: LensLike (WrappedMonad m) s t a b -> (a -> m b) -> s -> m t-mapMOf l cmd = unwrapMonad #. l (WrapMonad #. cmd)+mapMOf = coerce {-# INLINE mapMOf #-}  -- | 'forMOf' is a flipped version of 'mapMOf', consistent with the definition of 'forM'.@@ -1052,7 +1120,7 @@ -- 'imapMOf' :: 'Bind'  m => 'IndexedTraversal1' i s t a b -> (i -> a -> m b) -> s -> m t -- @ imapMOf :: Over (Indexed i) (WrappedMonad m) s t a b  -> (i -> a -> m b) -> s -> m t-imapMOf l cmd = unwrapMonad #. l (WrapMonad #. Indexed cmd)+imapMOf = coerce {-# INLINE imapMOf #-}  -- | Map each element of a structure targeted by a 'Lens' to a monadic action,
src/Control/Lens/Tuple.hs view
@@ -56,6 +56,7 @@ import           Control.Lens.Lens import           Control.Lens.Internal.Prelude import           Data.Functor.Product  (Product (..))+import           Data.Kind import           Data.Strict           (Pair (..)) import           GHC.Generics          ((:*:) (..), Generic (..), K1 (..),                                         M1 (..), U1 (..))@@ -1165,7 +1166,7 @@ ix n f = fmap to . gix n f . from {-# INLINE ix #-} -type family GSize (f :: * -> *)+type family GSize (f :: Type -> Type) type instance GSize U1 = Z type instance GSize (K1 i c) = S Z type instance GSize (M1 i c f) = GSize f
src/Control/Lens/Type.hs view
@@ -5,10 +5,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PolyKinds #-}-#if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE TypeInType #-}-#endif {-# LANGUAGE Trustworthy #-} ------------------------------------------------------------------------------- -- |@@ -67,9 +64,7 @@ import Control.Lens.Internal.Indexed import Data.Bifunctor import Data.Functor.Apply-#if __GLASGOW_HASKELL__ >= 800 import Data.Kind-#endif  -- $setup -- >>> :set -XNoOverloadedStrings@@ -459,11 +454,7 @@ -- | A witness that @(a ~ s, b ~ t)@. -- -- Note: Composition with an 'Equality' is index-preserving.-#if __GLASGOW_HASKELL__ >= 800 type Equality (s :: k1) (t :: k2) (a :: k1) (b :: k2) = forall k3 (p :: k1 -> k3 -> Type) (f :: k2 -> k3) .-#else-type Equality (s :: k1) (t :: k2) (a :: k1) (b :: k2) = forall (p :: k1 -> * -> *) (f :: k2 -> *) .-#endif     p a (f b) -> p s (f t)  -- | A 'Simple' 'Equality'.
src/Control/Lens/Unsound.hs view
@@ -6,7 +6,7 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE RankNTypes #-} -{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}+{-# OPTIONS_GHC -Wno-warnings-deprecations #-}  ------------------------------------------------------------------------------- -- |
src/Control/Lens/Wrapped.hs view
@@ -8,17 +8,14 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE PolyKinds #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}  #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif -#if __GLASGOW_HASKELL__ >= 710-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE ViewPatterns #-}-#endif--{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}+{-# OPTIONS_GHC -Wno-warnings-deprecations #-}  #include "lens-common.h" @@ -66,11 +63,9 @@   -- * Operations   , op   , ala, alaf-#if __GLASGOW_HASKELL__ >= 710   -- * Pattern Synonyms   , pattern Wrapped   , pattern Unwrapped-#endif   -- * Generics   , _GWrapped'   ) where@@ -90,9 +85,7 @@ import           Control.Lens.Getter import           Control.Lens.Internal.CTypes import           Control.Lens.Iso-#if __GLASGOW_HASKELL__ >= 710 import           Control.Lens.Review-#endif import           Control.Monad.Catch.Pure import           Control.Monad.Trans.Cont import           Control.Monad.Trans.Error@@ -134,9 +127,11 @@ import           Data.HashSet (HashSet) import qualified Data.HashMap.Lazy as HashMap import           Data.HashMap.Lazy (HashMap)+import           Data.Kind import           Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Map as Map import           Data.Map (Map)+import qualified Data.Monoid as Monoid import           Data.Monoid import qualified Data.Profunctor as Profunctor import           Data.Profunctor hiding (WrappedArrow(..))@@ -164,10 +159,6 @@ import           System.Posix.Types import           Data.Ord (Down(Down)) -#if MIN_VERSION_base(4,8,0)-import qualified Data.Monoid as Monoid-#endif- -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens@@ -177,7 +168,7 @@ -- | 'Wrapped' provides isomorphisms to wrap and unwrap newtypes or -- data types with one constructor. class Wrapped s where-  type Unwrapped s :: *+  type Unwrapped s :: Type   type Unwrapped s = GUnwrapped (Rep s)    -- | An isomorphism between @s@ and @a@.@@ -199,21 +190,19 @@     reviewer x = M1 (M1 (M1 (K1 x))) {-# INLINE _GWrapped' #-} -type family GUnwrapped (rep :: * -> *) :: *+type family GUnwrapped (rep :: Type -> Type) :: Type type instance GUnwrapped (D1 d (C1 c (S1 s (Rec0 a)))) = a -#if __GLASGOW_HASKELL__ >= 710-+pattern Wrapped :: Rewrapped s s => Unwrapped s -> s pattern Wrapped a <- (view _Wrapped -> a) where   Wrapped a = review _Wrapped a +pattern Unwrapped :: Rewrapped t t => t -> Unwrapped t pattern Unwrapped a <- (view _Unwrapped -> a) where   Unwrapped a = review _Unwrapped a -#endif- -- This can be used to help inference between the wrappers-class Wrapped s => Rewrapped (s :: *) (t :: *)+class Wrapped s => Rewrapped (s :: Type) (t :: Type)  class    (Rewrapped s t, Rewrapped t s) => Rewrapping s t instance (Rewrapped s t, Rewrapped t s) => Rewrapping s t@@ -325,13 +314,11 @@   _Wrapped' = iso getLast Last   {-# INLINE _Wrapped' #-} -#if MIN_VERSION_base(4,8,0) instance (t ~ Monoid.Alt g b) => Rewrapped (Monoid.Alt f a) t instance Wrapped (Monoid.Alt f a) where   type Unwrapped (Monoid.Alt f a) = f a   _Wrapped' = iso Monoid.getAlt Monoid.Alt   {-# INLINE _Wrapped' #-}-#endif  #if MIN_VERSION_base(4,12,0) instance (t ~ Monoid.Ap g b) => Rewrapped (Monoid.Ap f a) t@@ -753,11 +740,13 @@   _Wrapped' = iso S.unwrapMonoid S.WrapMonoid   {-# INLINE _Wrapped' #-} +#if !(MIN_VERSION_base(4,16,0)) instance (t ~ S.Option b) => Rewrapped (S.Option a) t instance Wrapped (S.Option a) where   type Unwrapped (S.Option a) = Maybe a   _Wrapped' = iso S.getOption S.Option   {-# INLINE _Wrapped' #-}+#endif  -- * contravariant @@ -855,7 +844,6 @@   _Wrapped' = iso getErrorCall ErrorCall   {-# INLINE _Wrapped' #-} -#if MIN_VERSION_base(4,9,0) instance (t ~ TypeError) => Rewrapped TypeError t instance Wrapped TypeError where   type Unwrapped TypeError = String@@ -865,7 +853,6 @@ getTypeError :: TypeError -> String getTypeError (TypeError x) = x {-# INLINE getTypeError #-}-#endif  #if MIN_VERSION_base(4,10,0) instance (t ~ CompactionFailed) => Rewrapped CompactionFailed t@@ -880,11 +867,7 @@ #endif  getErrorCall :: ErrorCall -> String-#if __GLASGOW_HASKELL__ < 800-getErrorCall (ErrorCall x) = x-#else getErrorCall (ErrorCallWithLocation x _) = x-#endif {-# INLINE getErrorCall #-}  getRecUpdError :: RecUpdError -> String
src/Control/Lens/Zoom.hs view
@@ -5,7 +5,7 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE RankNTypes #-}-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}+{-# OPTIONS_GHC -Wno-warnings-deprecations #-} {-# LANGUAGE Trustworthy #-}  #include "lens-common.h"@@ -30,7 +30,6 @@ import Prelude ()  import Control.Lens.Getter-import Control.Lens.Internal.Coerce import Control.Lens.Internal.Prelude import Control.Lens.Internal.Zoom import Control.Lens.Type@@ -49,6 +48,7 @@ import Control.Monad.Trans.Identity import Control.Monad.Trans.Maybe import Control.Monad.Trans.Free+import Data.Kind  -- $setup -- >>> import Control.Lens@@ -69,7 +69,7 @@ ------------------------------------------------------------------------------  -- | This type family is used by 'Control.Lens.Zoom.Zoom' to describe the common effect type.-type family Zoomed (m :: * -> *) :: * -> * -> *+type family Zoomed (m :: Type -> Type) :: Type -> Type -> Type type instance Zoomed (Strict.StateT s z) = Focusing z type instance Zoomed (Lazy.StateT s z) = Focusing z type instance Zoomed (ReaderT e m) = Zoomed m@@ -89,7 +89,7 @@ ------------------------------------------------------------------------------  -- | This type family is used by 'Control.Lens.Zoom.Magnify' to describe the common effect type.-type family Magnified (m :: * -> *) :: * -> * -> *+type family Magnified (m :: Type -> Type) :: Type -> Type -> Type type instance Magnified (ReaderT b m) = Effect m type instance Magnified ((->)b) = Const type instance Magnified (Strict.RWST a w s m) = EffectRWS w s m@@ -167,11 +167,11 @@   {-# INLINE zoom #-}  instance (Monoid w, Zoom m n s t) => Zoom (Strict.WriterT w m) (Strict.WriterT w n) s t where-  zoom l = Strict.WriterT . zoom (\afb -> unfocusingPlus #.. l (FocusingPlus #.. afb)) . Strict.runWriterT+  zoom l = Strict.WriterT . zoom (\afb -> unfocusingPlus #. l (FocusingPlus #. afb)) . Strict.runWriterT   {-# INLINE zoom #-}  instance (Monoid w, Zoom m n s t) => Zoom (Lazy.WriterT w m) (Lazy.WriterT w n) s t where-  zoom l = Lazy.WriterT . zoom (\afb -> unfocusingPlus #.. l (FocusingPlus #.. afb)) . Lazy.runWriterT+  zoom l = Lazy.WriterT . zoom (\afb -> unfocusingPlus #. l (FocusingPlus #. afb)) . Lazy.runWriterT   {-# INLINE zoom #-}  instance Zoom m n s t => Zoom (ListT m) (ListT n) s t where@@ -179,19 +179,19 @@   {-# INLINE zoom #-}  instance Zoom m n s t => Zoom (MaybeT m) (MaybeT n) s t where-  zoom l = MaybeT . liftM getMay . zoom (\afb -> unfocusingMay #.. l (FocusingMay #.. afb)) . liftM May . runMaybeT+  zoom l = MaybeT . liftM getMay . zoom (\afb -> unfocusingMay #. l (FocusingMay #. afb)) . liftM May . runMaybeT   {-# INLINE zoom #-}  instance (Error e, Zoom m n s t) => Zoom (ErrorT e m) (ErrorT e n) s t where-  zoom l = ErrorT . liftM getErr . zoom (\afb -> unfocusingErr #.. l (FocusingErr #.. afb)) . liftM Err . runErrorT+  zoom l = ErrorT . liftM getErr . zoom (\afb -> unfocusingErr #. l (FocusingErr #. afb)) . liftM Err . runErrorT   {-# INLINE zoom #-}  instance Zoom m n s t => Zoom (ExceptT e m) (ExceptT e n) s t where-  zoom l = ExceptT . liftM getErr . zoom (\afb -> unfocusingErr #.. l (FocusingErr #.. afb)) . liftM Err . runExceptT+  zoom l = ExceptT . liftM getErr . zoom (\afb -> unfocusingErr #. l (FocusingErr #. afb)) . liftM Err . runExceptT   {-# INLINE zoom #-}  instance (Functor f, Zoom m n s t) => Zoom (FreeT f m) (FreeT f n) s t where-  zoom l = FreeT . liftM (fmap (zoom l) . getFreed) . zoom (\afb -> unfocusingFree #.. l (FocusingFree #.. afb)) . liftM Freed . runFreeT+  zoom l = FreeT . liftM (fmap (zoom l) . getFreed) . zoom (\afb -> unfocusingFree #. l (FocusingFree #. afb)) . liftM Freed . runFreeT  ------------------------------------------------------------------------------ -- Magnify
src/Control/Monad/Error/Lens.hs view
@@ -177,7 +177,7 @@   {-# INLINE fmap #-}  instance Monad m => Semigroup (Handler e m a) where-  (<>) = M.mappend+  (<>) = (<!>)   {-# INLINE (<>) #-}  instance Monad m => Alt (Handler e m) where@@ -193,8 +193,10 @@ instance Monad m => M.Monoid (Handler e m a) where   mempty = zero   {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0))   mappend = (<!>)   {-# INLINE mappend #-}+#endif  instance Handleable e m (Handler e m) where   handler = Handler . preview
src/Control/Parallel/Strategies/Lens.hs view
@@ -56,11 +56,7 @@ -- 'parOf' :: ((a -> 'Eval' a) -> s -> 'Eval' s) -> 'Strategy' a -> 'Strategy' s -- @ parOf :: LensLike' Eval s a -> Strategy a -> Strategy s-#if MIN_VERSION_parallel(3,2,0) parOf l s = l (rparWith s)-#else-parOf l s = l (rpar `dot` s)-#endif {-# INLINE parOf #-}  -- | Transform a 'Lens', 'Fold', 'Getter', 'Setter' or 'Traversal' to
src/Data/ByteString/Lazy/Lens.hs view
@@ -1,10 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}--#if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE PatternSynonyms #-}-#endif  ----------------------------------------------------------------------------- -- |@@ -20,10 +17,8 @@ module Data.ByteString.Lazy.Lens   ( packedBytes, unpackedBytes, bytes   , packedChars, unpackedChars, chars-#if __GLASGOW_HASKELL__ >= 710   , pattern Bytes   , pattern Chars-#endif   ) where  import Control.Lens@@ -142,10 +137,10 @@ chars = traversedLazy8 {-# INLINE chars #-} -#if __GLASGOW_HASKELL__ >= 710+pattern Bytes :: [Word8] -> ByteString pattern Bytes b <- (view unpackedBytes -> b) where   Bytes b = review unpackedBytes b +pattern Chars :: String -> ByteString pattern Chars b <- (view unpackedChars -> b) where   Chars b = review unpackedChars b-#endif
src/Data/ByteString/Lens.hs view
@@ -1,9 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}-#if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE PatternSynonyms #-}-#endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.ByteString.Lens@@ -18,10 +16,8 @@   ( IsByteString(..)   , unpackedBytes   , unpackedChars-#if __GLASGOW_HASKELL__ >= 710   , pattern Bytes   , pattern Chars-#endif   ) where  import           Control.Lens@@ -110,13 +106,13 @@ unpackedBytes = from packedBytes {-# INLINE unpackedBytes #-} -#if __GLASGOW_HASKELL__ >= 710+pattern Bytes :: IsByteString s => [Word8] -> s pattern Bytes b <- (view unpackedBytes -> b) where   Bytes b = review unpackedBytes b +pattern Chars :: IsByteString s => String -> s pattern Chars b <- (view unpackedChars -> b) where   Chars b = review unpackedChars b-#endif  -- | 'Data.ByteString.Char8.unpack' (or 'Data.ByteString.Char8.pack') a list of characters into a strict (or lazy) 'ByteString' --
src/Data/ByteString/Strict/Lens.hs view
@@ -1,9 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}-#if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE PatternSynonyms #-}-#endif  ----------------------------------------------------------------------------- -- |@@ -18,10 +16,8 @@ module Data.ByteString.Strict.Lens   ( packedBytes, unpackedBytes, bytes   , packedChars, unpackedChars, chars-#if __GLASGOW_HASKELL__ >= 710   , pattern Bytes   , pattern Chars-#endif   ) where  import Control.Lens@@ -139,11 +135,10 @@ chars = traversedStrictTree8 {-# INLINE chars #-} -#if __GLASGOW_HASKELL__ >= 710+pattern Bytes :: [Word8] -> ByteString pattern Bytes b <- (view unpackedBytes -> b) where   Bytes b = review unpackedBytes b +pattern Chars :: String -> ByteString pattern Chars b <- (view unpackedChars -> b) where   Chars b = review unpackedChars b-#endif-
src/Data/Complex/Lens.hs view
@@ -1,9 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}-#if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE PatternSynonyms #-}-#endif  ----------------------------------------------------------------------------- -- |@@ -24,13 +22,11 @@   , _magnitude   , _phase   , _conjugate-#if __GLASGOW_HASKELL__ >= 710   -- * Pattern Synonyms   , pattern Polar   , pattern Real   , pattern Imaginary   , pattern Conjugate-#endif   ) where  import Prelude ()@@ -85,13 +81,15 @@ _polar = iso polar (uncurry mkPolar) {-# INLINE _polar #-} -#if __GLASGOW_HASKELL__ >= 710+pattern Polar :: RealFloat a => a -> a -> Complex a pattern Polar m theta <- (view _polar -> (m, theta)) where   Polar m theta = review _polar (m, theta) +pattern Real :: (Eq a, Num a) => a -> Complex a pattern Real r      = r :+ 0++pattern Imaginary :: (Eq a, Num a) => a -> Complex a pattern Imaginary i = 0 :+ i-#endif  -- | Access the 'magnitude' of a 'Complex' number. --@@ -145,7 +143,6 @@ _conjugate = involuted conjugate {-# INLINE _conjugate #-} -#if __GLASGOW_HASKELL__ >= 710+pattern Conjugate :: Num a => Complex a -> Complex a pattern Conjugate a <- (conjugate -> a) where   Conjugate a = conjugate a-#endif
src/Data/Data/Lens.hs view
@@ -5,7 +5,6 @@ {-# LANGUAGE PatternGuards #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GADTs #-}@@ -141,7 +140,7 @@ -- Automatic Traversal construction from field accessors ------------------------------------------------------------------------------ -data FieldException a = FieldException !Int a deriving Typeable+data FieldException a = FieldException !Int a  instance Show (FieldException a) where   showsPrec d (FieldException i _) = showParen (d > 10) $@@ -393,7 +392,7 @@ biplateData :: forall f s a. (Applicative f, Data s) => (forall c. Typeable c => c -> Answer c a) -> (a -> f a) -> s -> f s biplateData o f = go2 where   go :: Data d => d -> f d-  go s = gfoldl (\x y -> x <*> go2 y) pure s+  go = gfoldl (\x y -> x <*> go2 y) pure   go2 :: Data d => d -> f d   go2 s = case o s of     Hit a  -> f a@@ -404,7 +403,7 @@ uniplateData :: forall f s a. (Applicative f, Data s) => (forall c. Typeable c => c -> Answer c a) -> (a -> f a) -> s -> f s uniplateData o f = go where   go :: Data d => d -> f d-  go s = gfoldl (\x y -> x <*> go2 y) pure s+  go = gfoldl (\x y -> x <*> go2 y) pure   go2 :: Data d => d -> f d   go2 s = case o s of     Hit a  -> f a
src/Data/Dynamic/Lens.hs view
@@ -1,11 +1,7 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-}--#if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-}-#endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.Dynamic.Lens@@ -18,9 +14,7 @@ ---------------------------------------------------------------------------- module Data.Dynamic.Lens   ( AsDynamic(..)-#if __GLASGOW_HASKELL__ >= 710   , pattern Data.Dynamic.Lens.Dynamic-#endif   ) where  import Control.Exception@@ -50,7 +44,6 @@   _Dynamic = exception.prism' toDyn fromDynamic   {-# INLINE _Dynamic #-} -#if __GLASGOW_HASKELL__ >= 710+pattern Dynamic :: (AsDynamic s, Typeable a) => a -> s pattern Dynamic a <- (preview _Dynamic -> Just a) where   Dynamic a = review _Dynamic a-#endif
src/Data/List/Lens.hs view
@@ -1,6 +1,3 @@-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE FlexibleContexts #-}- ----------------------------------------------------------------------------- -- | -- Module      :  Data.List.Lens@@ -68,6 +65,20 @@ -- >>> "live" & reversed %~ ('d':) -- "lived" --+-- It's possible to work under a prefix or suffix of a list using+-- 'Control.Lens.Prism.Prefixed' and 'Control.Lens.Prism.Suffixed'.+--+-- >>> "preview" ^? prefixed "pre"+-- Just "view"+--+-- >>> suffixed ".o" # "hello"+-- "hello.o"+--+-- At present, "Data.List.Lens" re-exports 'Prefixed' and 'Suffixed' for+-- backwards compatibility, as 'prefixed' and 'suffixed' used to be top-level+-- functions defined in this module. This may change in a future major release+-- of @lens@.+-- -- Finally, it's possible to traverse, fold over, and map over -- index-value pairs thanks to instances of -- 'Control.Lens.Indexed.TraversableWithIndex',@@ -89,68 +100,14 @@ -- ---------------------------------------------------------------------------- module Data.List.Lens-  ( prefixed-  , suffixed+  ( Prefixed(..)+  , Suffixed(..)   , stripSuffix   ) where -import Prelude ()--import Control.Monad (guard)-import Control.Lens.Internal.Prelude-import Control.Lens-import qualified Data.List as List---- $setup--- >>> :set -XNoOverloadedStrings--- >>> import Control.Lens--- >>> import Debug.SimpleReflect.Expr--- >>> import Debug.SimpleReflect.Vars as Vars hiding (f,g)--- >>> let f :: Expr -> Expr; f = Debug.SimpleReflect.Vars.f--- >>> let g :: Expr -> Expr; g = Debug.SimpleReflect.Vars.g---- | A 'Prism' stripping a prefix from a list when used as a 'Traversal', or--- prepending that prefix when run backwards:------ >>> "preview" ^? prefixed "pre"--- Just "view"------ >>> "review" ^? prefixed "pre"--- Nothing------ >>> prefixed "pre" # "amble"--- "preamble"-prefixed :: Eq a => [a] -> Prism' [a] [a]-prefixed ps = prism' (ps ++) (List.stripPrefix ps)-{-# INLINE prefixed #-}---- | A 'Prism' stripping a suffix from a list when used as a 'Traversal', or--- appending that suffix when run backwards:------ >>> "review" ^? suffixed "view"--- Just "re"------ >>> "review" ^? suffixed "tire"--- Nothing------ >>> suffixed ".o" # "hello"--- "hello.o"-suffixed :: Eq a => [a] -> Prism' [a] [a]-suffixed qs = prism' (++ qs) (stripSuffix qs)-{-# INLINE suffixed #-}----------------------------------------------------------------------------------- Util-------------------------------------------------------------------------------+import Control.Lens.Prism (Prefixed(..), Suffixed(..))+import Control.Lens.Internal.List (stripSuffix) -stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]-stripSuffix qs xs0 = go xs0 zs-  where-    zs = drp qs xs0-    drp (_:ps) (_:xs) = drp ps xs-    drp [] xs = xs-    drp _  [] = []-    go (_:xs) (_:ys) = go xs ys-    go xs [] = zipWith const xs0 zs <$ guard (xs == qs)-    go [] _  = Nothing -- impossible-{-# INLINE stripSuffix #-}+--- $setup+--- >>> :set -XNoOverloadedStrings+--- >>> import Control.Lens
src/Data/Text/Lazy/Lens.hs view
@@ -1,10 +1,8 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-#if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-}-#endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.Text.Lazy.Lens@@ -21,9 +19,7 @@   , text   , builder   , utf8-#if __GLASGOW_HASKELL__ >= 710   , pattern Text-#endif   ) where  import Control.Lens.Type@@ -31,9 +27,7 @@ import Control.Lens.Fold import Control.Lens.Iso import Control.Lens.Prism-#if __GLASGOW_HASKELL__ >= 710 import Control.Lens.Review-#endif import Control.Lens.Setter import Control.Lens.Traversal import Data.ByteString.Lazy (ByteString)@@ -151,7 +145,6 @@ utf8 = prism' encodeUtf8 (preview _Right . decodeUtf8') {-# INLINE utf8 #-} -#if __GLASGOW_HASKELL__ >= 710+pattern Text :: String -> Text pattern Text a <- (view _Text -> a) where   Text a = review _Text a-#endif
src/Data/Text/Lens.hs view
@@ -1,11 +1,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}--#if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE PatternSynonyms #-}-#endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.Text.Lens@@ -20,16 +17,12 @@   ( IsText(..)   , unpacked   , _Text-#if __GLASGOW_HASKELL__ >= 710   , pattern Text-#endif   ) where  import           Control.Lens.Type-#if __GLASGOW_HASKELL__ >= 710 import           Control.Lens.Getter import           Control.Lens.Review-#endif import           Control.Lens.Iso import           Control.Lens.Traversal import qualified Data.Text as Strict@@ -106,10 +99,9 @@ _Text = from packed {-# INLINE _Text #-} -#if __GLASGOW_HASKELL__ >= 710+pattern Text :: IsText s => String -> s pattern Text a <- (view _Text -> a) where   Text a = review _Text a-#endif  instance IsText Strict.Text where   packed = Strict.packed
src/Data/Text/Strict/Lens.hs view
@@ -1,9 +1,7 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}-#if __GLASGOW_HASKELL__ >= 710+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-}-#endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.Text.Strict.Lens@@ -20,9 +18,7 @@   , text   , utf8   , _Text-#if __GLASGOW_HASKELL__ >= 710   , pattern Text-#endif   ) where  import Control.Lens.Type@@ -30,9 +26,7 @@ import Control.Lens.Fold import Control.Lens.Iso import Control.Lens.Prism-#if __GLASGOW_HASKELL__ >= 710 import Control.Lens.Review-#endif import Control.Lens.Setter import Control.Lens.Traversal import Data.ByteString (ByteString)@@ -143,7 +137,6 @@ utf8 = prism' encodeUtf8 (preview _Right . decodeUtf8') {-# INLINE utf8 #-} -#if __GLASGOW_HASKELL__ >= 710+pattern Text :: String -> Text pattern Text a <- (view _Text -> a) where   Text a = review _Text a-#endif
src/Data/Vector/Generic/Lens.hs view
@@ -48,16 +48,11 @@ import Control.Lens.Traversal import Control.Lens.Internal.List (ordinalNub) import Control.Lens.Internal.Prelude+import Data.Vector.Fusion.Bundle (Bundle) import qualified Data.Vector.Generic as V import Data.Vector.Generic (Vector) import Data.Vector.Generic.New (New) -#if MIN_VERSION_vector(0,11,0)-import Data.Vector.Fusion.Bundle (Bundle)-#else-import Data.Vector.Fusion.Stream (Stream)-#endif- -- $setup -- >>> import qualified Data.Vector as Vector -- >>> import Control.Lens@@ -102,25 +97,14 @@ vector = iso V.fromList V.toList {-# INLINE vector #-} -#if MIN_VERSION_vector(0,11,0) -- | Convert a 'Vector' to a finite 'Bundle' (or back.) asStream :: (Vector v a, Vector v b) => Iso (v a) (v b) (Bundle v a) (Bundle v b)-#else--- | Convert a 'Vector' to a finite 'Stream' (or back.)-asStream :: (Vector v a, Vector v b) => Iso (v a) (v b) (Stream a) (Stream b)-#endif asStream = iso V.stream V.unstream {-# INLINE asStream #-} -#if MIN_VERSION_vector(0,11,0) -- | Convert a 'Vector' to a finite 'Bundle' from right to left (or -- back.) asStreamR :: (Vector v a, Vector v b) => Iso (v a) (v b) (Bundle v a) (Bundle v b)-#else--- | Convert a 'Vector' to a finite 'Stream' from right to left (or--- back.)-asStreamR :: (Vector v a, Vector v b) => Iso (v a) (v b) (Stream a) (Stream b)-#endif asStreamR = iso V.streamR V.unstreamR {-# INLINE asStreamR #-} 
src/GHC/Generics/Lens.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}+{-# LANGUAGE EmptyCase #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeOperators #-}@@ -56,10 +56,6 @@ import qualified GHC.Generics as Generic import           GHC.Generics hiding (from, to) -#if !(MIN_VERSION_base(4,9,0))-import           Generics.Deriving.Base hiding (from, to)-#endif- -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens@@ -78,8 +74,7 @@ {-# INLINE generic1 #-}  _V1 :: Over p f (V1 s) (V1 t) a b-_V1 _ = absurd where-  absurd !_a = undefined+_V1 _ = \case {-# INLINE _V1 #-}  _U1 :: Iso (U1 p) (U1 q) () ()@@ -87,19 +82,19 @@ {-# INLINE _U1 #-}  _Par1 :: Iso (Par1 p) (Par1 q) p q-_Par1 = iso unPar1 Par1+_Par1 = coerced {-# INLINE _Par1 #-}  _Rec1 :: Iso (Rec1 f p) (Rec1 g q) (f p) (g q)-_Rec1 = iso unRec1 Rec1+_Rec1 = coerced {-# INLINE _Rec1 #-}  _K1 :: Iso (K1 i c p) (K1 j d q) c d-_K1 = iso unK1 K1+_K1 = coerced {-# INLINE _K1 #-}  _M1 :: Iso (M1 i c f p) (M1 j d g q) (f p) (g q)-_M1 = iso unM1 M1+_M1 = coerced {-# INLINE _M1 #-}  _L1 :: Prism' ((f :+: g) a) (f a)@@ -110,7 +105,8 @@   reviewer x = Left x {-# INLINE _L1 #-} --- | You can access fields of `data (f :*: g) p` by using it's `Field1` and `Field2` instances+-- | You can access fields of `data (f :*: g) p` by using its `Field1` and+-- `Field2` instances.  _R1 :: Prism' ((f :+: g) a) (g a) _R1 = prism remitter reviewer
src/Language/Haskell/TH/Lens.hs view
@@ -68,7 +68,6 @@ # endif   , tySynEqnPatterns   , tySynEqnResult-#if MIN_VERSION_template_haskell(2,11,0)   -- ** InjectivityAnn Lenses   , injectivityAnnOutput   , injectivityAnnInputs@@ -80,7 +79,6 @@   -- ** Bang Lenses   , bangSourceUnpackedness   , bangSourceStrictness-#endif #if MIN_VERSION_template_haskell(2,12,0)   -- ** DerivClause Lenses   , derivClauseStrategy@@ -116,16 +114,10 @@   , _TySynInstD   , _ClosedTypeFamilyD   , _RoleAnnotD-#if MIN_VERSION_template_haskell(2,10,0)   , _StandaloneDerivD   , _DefaultSigD-#endif-#if MIN_VERSION_template_haskell(2,11,0)   , _DataFamilyD   , _OpenTypeFamilyD-#else-  , _FamilyD-#endif #if MIN_VERSION_template_haskell(2,12,0)   , _PatSynD   , _PatSynSigD@@ -148,18 +140,13 @@   , _RecC   , _InfixC   , _ForallC-#if MIN_VERSION_template_haskell(2,11,0)   , _GadtC   , _RecGadtC-#endif-#if MIN_VERSION_template_haskell(2,11,0)   -- ** Overlap Prisms   ,_Overlappable   ,_Overlapping   ,_Overlaps   ,_Incoherent-#endif-#if MIN_VERSION_template_haskell(2,11,0)   -- ** SourceUnpackedness Prisms   , _NoSourceUnpackedness   , _SourceNoUnpack@@ -172,23 +159,15 @@   , _DecidedLazy   , _DecidedStrict   , _DecidedUnpack-#else-  -- ** Strict Prisms-  , _IsStrict-  , _NotStrict-  , _Unpacked-#endif   -- ** Foreign Prisms   , _ImportF   , _ExportF   -- ** Callconv Prisms   , _CCall   , _StdCall-#if MIN_VERSION_template_haskell(2,10,0)   , _CApi   , _Prim   , _JavaScript-#endif   -- ** Safety Prisms   , _Unsafe   , _Safe@@ -199,9 +178,7 @@   , _SpecialiseInstP   , _RuleP   , _AnnP-#if MIN_VERSION_template_haskell(2,10,0)   , _LineP-#endif #if MIN_VERSION_template_haskell(2,12,0)   , _CompleteP #endif@@ -263,12 +240,8 @@   , _SigE   , _RecConE   , _RecUpdE-#if MIN_VERSION_template_haskell(2,10,0)   , _StaticE-#endif-#if MIN_VERSION_template_haskell(2,11,0)   , _UnboundVarE-#endif #if MIN_VERSION_template_haskell(2,13,0)   , _LabelE #endif@@ -305,9 +278,7 @@   , _FloatPrimL   , _DoublePrimL   , _StringPrimL-#if MIN_VERSION_template_haskell(2,11,0)   , _CharPrimL-#endif #if MIN_VERSION_template_haskell(2,16,0)   , _BytesPrimL #endif@@ -344,9 +315,7 @@   , _UnboxedSumT #endif   , _ArrowT-#if MIN_VERSION_template_haskell(2,10,0)   , _EqualityT-#endif   , _ListT   , _PromotedTupleT   , _PromotedNilT@@ -354,12 +323,10 @@   , _StarT   , _ConstraintT   , _LitT-#if MIN_VERSION_template_haskell(2,11,0)   , _InfixT   , _UInfixT   , _ParensT   , _WildCardT-#endif #if MIN_VERSION_template_haskell(2,15,0)   , _AppKindT   , _ImplicitParamT@@ -378,19 +345,15 @@   -- ** TyVarBndr Prisms   , _PlainTV   , _KindedTV-#if MIN_VERSION_template_haskell(2,11,0)   -- ** FamilyResultSig Prisms   , _NoSig   , _KindSig   , _TyVarSig-#endif   -- ** TyLit Prisms   , _NumTyLit   , _StrTyLit-#if !MIN_VERSION_template_haskell(2,10,0)-  -- ** Pred Prisms-  , _ClassP-  , _EqualP+#if MIN_VERSION_template_haskell(2,18,0)+  , _CharTyLit #endif   -- ** Role Prisms   , _NominalR@@ -450,12 +413,10 @@   name f (RecC n tys)          = (`RecC` tys) <$> f n   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-#if MIN_VERSION_template_haskell(2,11,0)   name f (GadtC ns argTys retTy) =     (\n -> GadtC [n] argTys retTy) <$> f (head ns)   name f (RecGadtC ns argTys retTy) =     (\n -> RecGadtC [n] argTys retTy) <$> f (head ns)-#endif  instance HasName Foreign where   name f (ImportF cc saf str n ty) =@@ -467,14 +428,12 @@   name f (RuleVar n) = RuleVar <$> f n   name f (TypedRuleVar n ty) = (`TypedRuleVar` ty) <$> f n -#if MIN_VERSION_template_haskell(2,11,0) instance HasName TypeFamilyHead where   name f (TypeFamilyHead n tvbs frs mia) =     (\n' -> TypeFamilyHead n' tvbs frs mia) <$> f n  instance HasName InjectivityAnn where   name f (InjectivityAnn n deps) = (`InjectivityAnn` deps) <$> f n-#endif  -- | Contains some amount of `Type`s inside class HasTypes t where@@ -490,12 +449,10 @@   types f (InfixC t1 n t2) = InfixC <$> _2 (types f) t1                                        <*> pure n <*> _2 (types f) t2   types f (ForallC vb ctx con)    = ForallC vb ctx <$> types f con-#if MIN_VERSION_template_haskell(2,11,0)   types f (GadtC ns argTys retTy) =     GadtC    ns <$> traverse (_2 (types f)) argTys <*> types f retTy   types f (RecGadtC ns argTys retTy) =     RecGadtC ns <$> traverse (_3 (types f)) argTys <*> types f retTy-#endif  instance HasTypes Foreign where   types f (ImportF cc saf str n t) = ImportF cc saf str n <$> types f t@@ -552,10 +509,7 @@   typeVarsEx _ _ t@StarT{}            = pure t   typeVarsEx _ _ t@ConstraintT{}      = pure t   typeVarsEx _ _ t@LitT{}             = pure t-#if MIN_VERSION_template_haskell(2,10,0)   typeVarsEx _ _ t@EqualityT{}        = pure t-#endif-#if MIN_VERSION_template_haskell(2,11,0)   typeVarsEx s f (InfixT  t1 n t2)    = InfixT  <$> typeVarsEx s f t1                                                 <*> pure n                                                 <*> typeVarsEx s f t2@@ -564,7 +518,6 @@                                                 <*> typeVarsEx s f t2   typeVarsEx s f (ParensT t)          = ParensT <$> typeVarsEx s f t   typeVarsEx _ _ t@WildCardT{}        = pure t-#endif #if MIN_VERSION_template_haskell(2,12,0)   typeVarsEx _ _ t@UnboxedSumT{}      = pure t #endif@@ -581,12 +534,6 @@   typeVarsEx _ _ t@MulArrowT{}        = pure t #endif -#if !MIN_VERSION_template_haskell(2,10,0)-instance HasTypeVars Pred where-  typeVarsEx s f (ClassP n ts) = ClassP n <$> typeVarsEx s f ts-  typeVarsEx s f (EqualP l r)  = EqualP <$> typeVarsEx s f l <*> typeVarsEx s f r-#endif- instance HasTypeVars Con where   typeVarsEx s f (NormalC n ts) = NormalC n <$> traverseOf (traverse . _2) (typeVarsEx s f) ts   typeVarsEx s f (RecC n ts) = RecC n <$> traverseOf (traverse . _3) (typeVarsEx s f) ts@@ -594,14 +541,12 @@        where g (i, t) = (,) i <$> typeVarsEx s f t   typeVarsEx s f (ForallC bs ctx c) = ForallC bs <$> typeVarsEx s' f ctx <*> typeVarsEx s' f c        where s' = s `Set.union` setOf typeVars bs-#if MIN_VERSION_template_haskell(2,11,0)   typeVarsEx s f (GadtC ns argTys retTy) =     GadtC ns <$> traverseOf (traverse . _2) (typeVarsEx s f) argTys              <*> typeVarsEx s f retTy   typeVarsEx s f (RecGadtC ns argTys retTy) =     RecGadtC ns <$> traverseOf (traverse . _3) (typeVarsEx s f) argTys                 <*> typeVarsEx s f retTy-#endif  instance HasTypeVars t => HasTypeVars [t] where   typeVarsEx s = traverse . typeVarsEx s@@ -641,15 +586,11 @@   substType _ t@StarT{}            = t   substType _ t@ConstraintT{}      = t   substType _ t@LitT{}             = t-#if MIN_VERSION_template_haskell(2,10,0)   substType _ t@EqualityT{}        = t-#endif-#if MIN_VERSION_template_haskell(2,11,0)   substType m (InfixT  t1 n t2)    = InfixT  (substType m t1) n (substType m t2)   substType m (UInfixT t1 n t2)    = UInfixT (substType m t1) n (substType m t2)   substType m (ParensT t)          = ParensT (substType m t)   substType _ t@WildCardT{}        = t-#endif #if MIN_VERSION_template_haskell(2,12,0)   substType _ t@UnboxedSumT{}      = t #endif@@ -668,68 +609,29 @@ instance SubstType t => SubstType [t] where   substType = map . substType -#if !MIN_VERSION_template_haskell(2,10,0)-instance SubstType Pred where-  substType m (ClassP n ts) = ClassP n (substType m ts)-  substType m (EqualP l r)  = substType m (EqualP l r)-#endif- -- | Provides a 'Traversal' of the types of each field of a constructor.------ @--- conFields :: 'Traversal'' 'Con' 'BangType'   -- template-haskell-2.11+--- conFields :: 'Traversal'' 'Con' 'StrictType' -- Earlier versions--- @-conFields :: Traversal' Con-#if MIN_VERSION_template_haskell(2,11,0)-                            BangType-#else-                            StrictType-#endif+conFields :: Traversal' Con BangType conFields f (NormalC n fs)      = NormalC n <$> traverse f fs conFields f (RecC n fs)         = RecC n <$> traverse (sansVar f) fs conFields f (InfixC l n r)      = InfixC <$> f l <*> pure n <*> f r conFields f (ForallC bds ctx c) = ForallC bds ctx <$> conFields f c-#if MIN_VERSION_template_haskell(2,11,0) conFields f (GadtC ns argTys retTy) =   GadtC ns <$> traverse f argTys <*> pure retTy conFields f (RecGadtC ns argTys retTy) =   RecGadtC ns <$> traverse (sansVar f) argTys <*> pure retTy-#endif --- |--- @--- sansVar :: 'Traversal'' 'VarBangType'   'BangType'   -- template-haskell-2.11+--- sansVar :: 'Traversal'' 'VarStrictType' 'StrictType' -- Earlier versions--- @-#if MIN_VERSION_template_haskell(2,11,0)-sansVar :: Traversal' VarBangType   BangType-#else-sansVar :: Traversal' VarStrictType StrictType-#endif+sansVar :: Traversal' VarBangType BangType sansVar f (fn,s,t) = (\(s', t') -> (fn,s',t')) <$> f (s, t)  -- | 'Traversal' of the types of the /named/ fields of a constructor.------ @--- conNamedFields :: 'Traversal'' 'Con' 'VarBangType'   -- template-haskell-2.11+--- conNamedFields :: 'Traversal'' 'Con' 'VarStrictType' -- Earlier versions--- @-conNamedFields :: Traversal' Con-#if MIN_VERSION_template_haskell(2,11,0)-                                 VarBangType-#else-                                 VarStrictType-#endif+conNamedFields :: Traversal' Con VarBangType conNamedFields _ c@NormalC{}      = pure c conNamedFields _ c@InfixC{}       = pure c conNamedFields f (RecC n fs)      = RecC n <$> traverse f fs conNamedFields f (ForallC a b fs) = ForallC a b <$> conNamedFields f fs-#if MIN_VERSION_template_haskell(2,11,0) conNamedFields _ c@GadtC{}        = pure c conNamedFields f (RecGadtC ns argTys retTy) =   RecGadtC ns <$> traverse f argTys <*> pure retTy-#endif  -- Lenses and Prisms locFileName :: Lens' Loc String@@ -814,7 +716,6 @@    g (Clause _ _ ds) = ds    s (Clause x y _ ) = Clause x y -#if MIN_VERSION_template_haskell(2,11,0) injectivityAnnOutput :: Lens' InjectivityAnn Name injectivityAnnOutput = lens g s where    g (InjectivityAnn o _)   = o@@ -854,7 +755,6 @@ bangSourceStrictness = lens g s where   g (Bang _  su) = su   s (Bang ss _ ) = Bang ss-#endif  #if MIN_VERSION_template_haskell(2,12,0) derivClauseStrategy :: Lens' DerivClause (Maybe DerivStrategy)@@ -876,13 +776,6 @@       remitter (ClassI x y) = Just (x, y)       remitter _ = Nothing --- |--- @--- _ClassOpI :: 'Prism'' 'Info' ('Name', 'Type', 'ParentName')         -- template-haskell-2.11+--- _ClassOpI :: 'Prism'' 'Info' ('Name', 'Type', 'ParentName', 'Fixity') -- template-haskell-2.8 through 2.10--- _ClassOpI :: 'Prism'' 'Info' ('Name', 'Type', 'Name',       'Fixity') -- Earlier versions--- @-#if MIN_VERSION_template_haskell(2,11,0) _ClassOpI :: Prism' Info (Name, Type, ParentName) _ClassOpI   = prism' reviewer remitter@@ -890,15 +783,6 @@       reviewer (x, y, z) = ClassOpI x y z       remitter (ClassOpI x y z) = Just (x, y, z)       remitter _ = Nothing-#else-_ClassOpI :: Prism' Info (Name, Type, ParentName, Fixity)-_ClassOpI-  = prism' reviewer remitter-  where-      reviewer (x, y, z, w) = ClassOpI x y z w-      remitter (ClassOpI x y z w) = Just (x, y, z, w)-      remitter _ = Nothing-#endif  _TyConI :: Prism' Info Dec _TyConI@@ -908,11 +792,7 @@       remitter (TyConI x) = Just x       remitter _ = Nothing -#if MIN_VERSION_template_haskell(2,11,0) _FamilyI :: Prism' Info (Dec, [InstanceDec])-#else-_FamilyI :: Prism' Info (Dec, [Dec])-#endif _FamilyI   = prism' reviewer remitter   where@@ -928,13 +808,6 @@       remitter (PrimTyConI x y z) = Just (x, y, z)       remitter _ = Nothing --- |--- @--- _DataConI :: 'Prism'' 'Info' ('Name', 'Type', 'ParentName')         -- template-haskell-2.11+--- _DataConI :: 'Prism'' 'Info' ('Name', 'Type', 'ParentName', 'Fixity') -- template-haskell-2.8 through 2.10--- _DataConI :: 'Prism'' 'Info' ('Name', 'Type', 'Name',       'Fixity') -- Earlier versions--- @-#if MIN_VERSION_template_haskell(2,11,0) _DataConI :: Prism' Info (Name, Type, ParentName) _DataConI   = prism' reviewer remitter@@ -942,22 +815,7 @@       reviewer (x, y, z) = DataConI x y z       remitter (DataConI x y z) = Just (x, y, z)       remitter _ = Nothing-#else-_DataConI :: Prism' Info (Name, Type, ParentName, Fixity)-_DataConI-  = prism' reviewer remitter-  where-      reviewer (x, y, z, w) = DataConI x y z w-      remitter (DataConI x y z w) = Just (x, y, z, w)-      remitter _ = Nothing-#endif --- |--- @--- _VarI :: 'Prism'' 'Info' ('Name', 'Type', 'Maybe' 'Dec')         -- template-haskell-2.11+--- _VarI :: 'Prism'' 'Info' ('Name', 'Type', 'Maybe' 'Dec', 'Fixity') -- Earlier versions--- @-#if MIN_VERSION_template_haskell(2,11,0) _VarI :: Prism' Info (Name, Type, Maybe Dec) _VarI   = prism' reviewer remitter@@ -965,15 +823,6 @@       reviewer (x, y, z) = VarI x y z       remitter (VarI x y z) = Just (x, y, z)       remitter _ = Nothing-#else-_VarI :: Prism' Info (Name, Type, Maybe Dec, Fixity)-_VarI-  = prism' reviewer remitter-  where-      reviewer (x, y, z, w) = VarI x y z w-      remitter (VarI x y z w) = Just (x, y, z, w)-      remitter _ = Nothing-#endif  _TyVarI :: Prism' Info (Name, Type) _TyVarI@@ -1025,29 +874,14 @@       remitter (ClassD x y z w u) = Just (x, y, z, w, u)       remitter _ = Nothing --- |--- @--- _InstanceD :: 'Prism'' 'Dec' ('Maybe' 'Overlap', 'Cxt', 'Type', ['Dec']) -- template-haskell-2.11+--- _InstanceD :: 'Prism'' 'Dec'                ('Cxt', 'Type', ['Dec']) -- Earlier versions--- @-#if MIN_VERSION_template_haskell(2,11,0) _InstanceD :: Prism' Dec (Maybe Overlap, Cxt, Type, [Dec])-#else-_InstanceD :: Prism' Dec (Cxt, Type, [Dec])-#endif _InstanceD   = prism' reviewer remitter   where-#if MIN_VERSION_template_haskell(2,11,0)       reviewer (x, y, z, w) = InstanceD x y z w       remitter (InstanceD x y z w) = Just (x, y, z, w)-#else-      reviewer (x, y, z) = InstanceD x y z-      remitter (InstanceD x y z) = Just ( x, y, z)-#endif       remitter _ = Nothing -#if MIN_VERSION_template_haskell(2,11,0) _Overlappable  :: Prism' Overlap  () _Overlappable  = prism' reviewer remitter   where@@ -1075,7 +909,6 @@       reviewer () = Incoherent       remitter Incoherent = Just ()       remitter _ = Nothing-#endif  _SigD :: Prism' Dec (Name, Type) _SigD@@ -1154,7 +987,7 @@       reviewer (x, y, z) = StandaloneDerivD x y z       remitter (StandaloneDerivD x y z) = Just (x, y, z)       remitter _ = Nothing-#elif MIN_VERSION_template_haskell(2,10,0)+#else _StandaloneDerivD :: Prism' Dec (Cxt, Type) _StandaloneDerivD   = prism' reviewer remitter@@ -1164,7 +997,6 @@       remitter _ = Nothing #endif -#if MIN_VERSION_template_haskell(2,10,0) _DefaultSigD :: Prism' Dec (Name, Type) _DefaultSigD   = prism' reviewer remitter@@ -1172,11 +1004,10 @@       reviewer (x, y) = DefaultSigD x y       remitter (DefaultSigD x y) = Just (x, y)       remitter _ = Nothing-#endif  # if MIN_VERSION_template_haskell(2,12,0) type DataPrism' tys cons = Prism' Dec (Cxt, Name, tys, Maybe Kind, cons, [DerivClause])-# elif MIN_VERSION_template_haskell(2,11,0)+# else type DataPrism' tys cons = Prism' Dec (Cxt, Name, tys, Maybe Kind, cons, Cxt) # endif @@ -1184,8 +1015,7 @@ -- @ -- _DataInstD :: 'Prism'' 'Dec' ('Cxt', 'Maybe' ['TyVarBndrUnit'], 'Type', 'Maybe' 'Kind', ['Con'], ['DerivClause']) -- template-haskell-2.15+ -- _DataInstD :: 'Prism'' 'Dec' ('Cxt', 'Name', ['Type'],                'Maybe' 'Kind', ['Con'], ['DerivClause']) -- template-haskell-2.12 through 2.14--- _DataInstD :: 'Prism'' 'Dec' ('Cxt', 'Name', ['Type'],                'Maybe' 'Kind', ['Con'], 'Cxt')           -- template-haskell-2.11--- _DataInstD :: 'Prism'' 'Dec' ('Cxt', 'Name', ['Type'],                            ['Con'], ['Name'])        -- Earlier versions+-- _DataInstD :: 'Prism'' 'Dec' ('Cxt', 'Name', ['Type'],                'Maybe' 'Kind', ['Con'], 'Cxt')           -- Earlier versions -- @ #if MIN_VERSION_template_haskell(2,15,0) _DataInstD :: Prism' Dec (Cxt, Maybe [TyVarBndrUnit], Type, Maybe Kind, [Con], [DerivClause])@@ -1195,7 +1025,7 @@       reviewer (x, y, z, w, u, v) = DataInstD x y z w u v       remitter (DataInstD x y z w u v) = Just (x, y, z, w, u, v)       remitter _ = Nothing-#elif MIN_VERSION_template_haskell(2,11,0)+#else _DataInstD :: DataPrism' [Type] [Con] _DataInstD   = prism' reviewer remitter@@ -1203,22 +1033,13 @@       reviewer (x, y, z, w, u, v) = DataInstD x y z w u v       remitter (DataInstD x y z w u v) = Just (x, y, z, w, u, v)       remitter _ = Nothing-#else-_DataInstD :: Prism' Dec (Cxt, Name, [Type], [Con], [Name])-_DataInstD-  = prism' reviewer remitter-  where-      reviewer (x, y, z, w, u) = DataInstD x y z w u-      remitter (DataInstD x y z w u) = Just (x, y, z, w, u)-      remitter _ = Nothing #endif  -- | -- @ -- _NewtypeInstD :: 'Prism'' 'Dec' ('Cxt', 'Maybe' ['TyVarBndrUnit'], 'Type', 'Maybe' 'Kind', 'Con', ['DerivClause']) -- template-haskell-2.15+ -- _NewtypeInstD :: 'Prism'' 'Dec' ('Cxt', 'Name', ['Type'],                'Maybe' 'Kind', 'Con', ['DerivClause']) -- template-haskell-2.12 through 2.14--- _NewtypeInstD :: 'Prism'' 'Dec' ('Cxt', 'Name', ['Type'],                'Maybe' 'Kind', 'Con', 'Cxt')           -- template-haskell-2.11--- _NewtypeInstD :: 'Prism'' 'Dec' ('Cxt', 'Name', ['Type'],                            'Con', ['Name'])        -- Earlier versions+-- _NewtypeInstD :: 'Prism'' 'Dec' ('Cxt', 'Name', ['Type'],                'Maybe' 'Kind', 'Con', 'Cxt')           -- Earlier versions -- @ #if MIN_VERSION_template_haskell(2,15,0) _NewtypeInstD :: Prism' Dec (Cxt, Maybe [TyVarBndrUnit], Type, Maybe Kind, Con, [DerivClause])@@ -1228,7 +1049,7 @@       reviewer (x, y, z, w, u, v) = NewtypeInstD x y z w u v       remitter (NewtypeInstD x y z w u v) = Just (x, y, z, w, u, v)       remitter _ = Nothing-#elif MIN_VERSION_template_haskell(2,11,0)+#else _NewtypeInstD :: DataPrism' [Type] Con _NewtypeInstD   = prism' reviewer remitter@@ -1236,17 +1057,8 @@       reviewer (x, y, z, w, u, v) = NewtypeInstD x y z w u v       remitter (NewtypeInstD x y z w u v) = Just (x, y, z, w, u, v)       remitter _ = Nothing-#else-_NewtypeInstD :: Prism' Dec (Cxt, Name, [Type], Con, [Name])-_NewtypeInstD-  = prism' reviewer remitter-  where-      reviewer (x, y, z, w, u) = NewtypeInstD x y z w u-      remitter (NewtypeInstD x y z w u) = Just (x, y, z, w, u)-      remitter _ = Nothing #endif -#if MIN_VERSION_template_haskell(2,11,0) _ClosedTypeFamilyD :: Prism' Dec (TypeFamilyHead, [TySynEqn]) _ClosedTypeFamilyD   = prism' reviewer remitter@@ -1254,23 +1066,12 @@       reviewer (x, y) = ClosedTypeFamilyD x y       remitter (ClosedTypeFamilyD x y) = Just (x, y)       remitter _ = Nothing-#else-_ClosedTypeFamilyD :: Prism' Dec (Name, [TyVarBndrUnit], Maybe Kind, [TySynEqn])-_ClosedTypeFamilyD-  = prism' reviewer remitter-  where-      reviewer (x, y, z, w) = ClosedTypeFamilyD x y z w-      remitter (ClosedTypeFamilyD x y z w) = Just (x, y, z, w)-      remitter _ = Nothing-#endif  -- | -- @ -- _DataD :: 'Prism'' 'Dec' ('Cxt', 'Name', ['TyVarBndrUnit'], 'Maybe' 'Kind', ['Con'], ['DerivClause']) -- template-haskell-2.12+--- _DataD :: 'Prism'' 'Dec' ('Cxt', 'Name', ['Type'],          'Maybe' 'Kind', ['Con'], 'Cxt')           -- template-haskell-2.11--- _DataD :: 'Prism'' 'Dec' ('Cxt', 'Name', ['Type'],                      ['Con'], ['Name'])        -- Earlier versions+-- _DataD :: 'Prism'' 'Dec' ('Cxt', 'Name', ['Type'],          'Maybe' 'Kind', ['Con'], 'Cxt')           -- Earlier versions -- @-#if MIN_VERSION_template_haskell(2,11,0) _DataD :: DataPrism' [TyVarBndrUnit] [Con] _DataD   = prism' reviewer remitter@@ -1278,23 +1079,12 @@       reviewer (x, y, z, w, u, v) = DataD x y z w u v       remitter (DataD x y z w u v) = Just (x, y, z, w, u, v)       remitter _ = Nothing-#else-_DataD :: Prism' Dec (Cxt, Name, [TyVarBndrUnit], [Con], [Name])-_DataD-  = prism' reviewer remitter-  where-      reviewer (x, y, z, w, u) = DataD x y z w u-      remitter (DataD x y z w u) = Just (x, y, z, w, u)-      remitter _ = Nothing-#endif  -- | -- @ -- _NewtypeD :: 'Prism'' 'Dec' ('Cxt', 'Name', ['TyVarBndrUnit'], 'Maybe' 'Kind', 'Con', ['DerivClause']) -- template-haskell-2.12+--- _NewtypeD :: 'Prism'' 'Dec' ('Cxt', 'Name', ['Type'],          'Maybe' 'Kind', 'Con', 'Cxt')           -- template-haskell-2.11--- _NewtypeD :: 'Prism'' 'Dec' ('Cxt', 'Name', ['Type'],                      'Con', ['Name'])        -- Earlier versions+-- _NewtypeD :: 'Prism'' 'Dec' ('Cxt', 'Name', ['Type'],          'Maybe' 'Kind', 'Con', 'Cxt')           -- Earlier versions -- @-#if MIN_VERSION_template_haskell(2,11,0) _NewtypeD :: DataPrism' [TyVarBndrUnit] Con _NewtypeD   = prism' reviewer remitter@@ -1302,17 +1092,7 @@       reviewer (x, y, z, w, u, v) = NewtypeD x y z w u v       remitter (NewtypeD x y z w u v) = Just (x, y, z, w, u, v)       remitter _ = Nothing-#else-_NewtypeD :: Prism' Dec (Cxt, Name, [TyVarBndrUnit], Con, [Name])-_NewtypeD-  = prism' reviewer remitter-  where-      reviewer (x, y, z, w, u) = NewtypeD x y z w u-      remitter (NewtypeD x y z w u) = Just (x, y, z, w, u)-      remitter _ = Nothing-#endif -#if MIN_VERSION_template_haskell(2,11,0) _DataFamilyD :: Prism' Dec (Name, [TyVarBndrUnit], Maybe Kind) _DataFamilyD   = prism' reviewer remitter@@ -1328,15 +1108,6 @@       reviewer = OpenTypeFamilyD       remitter (OpenTypeFamilyD x) = Just x       remitter _ = Nothing-#else-_FamilyD :: Prism' Dec (FamFlavour, Name, [TyVarBndrUnit], Maybe Kind)-_FamilyD-  = prism' reviewer remitter-  where-      reviewer (x, y, z, w) = FamilyD x y z w-      remitter (FamilyD x y z w) = Just (x, y, z, w)-      remitter _ = Nothing-#endif  #if MIN_VERSION_template_haskell(2,12,0) _PatSynD :: Prism' Dec (Name, PatSynArgs, PatSynDir, Pat)@@ -1416,19 +1187,7 @@       remitter _ = Nothing #endif --- |--- @--- _NormalC :: 'Prism'' 'Con' ('Name', ['BangType'])   -- template-haskell-2.11+--- _NormalC :: 'Prism'' 'Con' ('Name', ['StrictType']) -- Earlier versions--- @-_NormalC ::-  Prism' Con ( Name-#if MIN_VERSION_template_haskell(2,11,0)-             , [BangType]-#else-             , [StrictType]-#endif-             )+_NormalC :: Prism' Con (Name, [BangType]) _NormalC   = prism' reviewer remitter   where@@ -1436,19 +1195,7 @@       remitter (NormalC x y) = Just (x, y)       remitter _ = Nothing --- |--- @--- _RecC :: 'Prism'' 'Con' ('Name', ['VarBangType'])   -- template-haskell-2.11+--- _RecC :: 'Prism'' 'Con' ('Name', ['VarStrictType']) -- Earlier versions--- @-_RecC ::-  Prism' Con ( Name-#if MIN_VERSION_template_haskell(2,11,0)-             , [VarBangType]-#else-             , [VarStrictType]-#endif-             )+_RecC :: Prism' Con (Name, [VarBangType]) _RecC   = prism' reviewer remitter   where@@ -1456,18 +1203,7 @@       remitter (RecC x y) = Just (x, y)       remitter _ = Nothing --- |--- @--- _InfixC :: 'Prism'' 'Con' ('BangType',   'Name', 'BangType')   -- template-haskell-2.11+--- _InfixC :: 'Prism'' 'Con' ('StrictType', 'Name', 'StrictType') -- Earlier versions--- @-_InfixC ::-  Prism' Con-#if MIN_VERSION_template_haskell(2,11,0)-             (BangType,   Name, BangType  )-#else-             (StrictType, Name, StrictType)-#endif+_InfixC :: Prism' Con (BangType, Name, BangType  ) _InfixC   = prism' reviewer remitter   where@@ -1483,7 +1219,6 @@       remitter (ForallC x y z) = Just (x, y, z)       remitter _ = Nothing -#if MIN_VERSION_template_haskell(2,11,0) _GadtC :: Prism' Con ([Name], [BangType], Type) _GadtC   = prism' reviewer remitter@@ -1499,9 +1234,7 @@       reviewer (x, y, z) = RecGadtC x y z       remitter (RecGadtC x y z) = Just (x, y, z)       remitter _ = Nothing-#endif -#if MIN_VERSION_template_haskell(2,11,0) _NoSourceUnpackedness :: Prism' SourceUnpackedness () _NoSourceUnpackedness   = prism' reviewer remitter@@ -1573,32 +1306,7 @@       reviewer () = DecidedUnpack       remitter DecidedUnpack = Just ()       remitter _ = Nothing-#else-_IsStrict :: Prism' Strict ()-_IsStrict-  = prism' reviewer remitter-  where-      reviewer () = IsStrict-      remitter IsStrict = Just ()-      remitter _ = Nothing -_NotStrict :: Prism' Strict ()-_NotStrict-  = prism' reviewer remitter-  where-      reviewer () = NotStrict-      remitter NotStrict = Just ()-      remitter _ = Nothing--_Unpacked :: Prism' Strict ()-_Unpacked-  = prism' reviewer remitter-  where-      reviewer () = Unpacked-      remitter Unpacked = Just ()-      remitter _ = Nothing-#endif- _ImportF :: Prism' Foreign (Callconv, Safety, String, Name, Type) _ImportF   = prism' reviewer remitter@@ -1631,7 +1339,6 @@       remitter StdCall = Just ()       remitter _ = Nothing -#if MIN_VERSION_template_haskell(2,10,0) _CApi :: Prism' Callconv () _CApi   = prism' reviewer remitter@@ -1655,7 +1362,6 @@       reviewer () = JavaScript       remitter JavaScript = Just ()       remitter _ = Nothing-#endif  _Unsafe :: Prism' Safety () _Unsafe@@ -1738,7 +1444,6 @@       remitter (AnnP x y) = Just (x, y)       remitter _ = Nothing -#if MIN_VERSION_template_haskell(2,10,0) _LineP :: Prism' Pragma (Int, String) _LineP   = prism' reviewer remitter@@ -1746,7 +1451,6 @@       reviewer (x, y) = LineP x y       remitter (LineP x y) = Just (x, y)       remitter _ = Nothing-#endif  #if MIN_VERSION_template_haskell(2,12,0) _CompleteP :: Prism' Pragma ([Name], Maybe Name)@@ -2169,7 +1873,6 @@       remitter (RecUpdE x y) = Just (x, y)       remitter _ = Nothing -#if MIN_VERSION_template_haskell(2,10,0) _StaticE :: Prism' Exp Exp _StaticE   = prism' reviewer remitter@@ -2177,9 +1880,7 @@       reviewer = StaticE       remitter (StaticE x) = Just x       remitter _ = Nothing-#endif -#if MIN_VERSION_template_haskell(2,11,0) _UnboundVarE :: Prism' Exp Name _UnboundVarE   = prism' reviewer remitter@@ -2187,7 +1888,6 @@       reviewer = UnboundVarE       remitter (UnboundVarE x) = Just x       remitter _ = Nothing-#endif  #if MIN_VERSION_template_haskell(2,13,0) _LabelE :: Prism' Exp String@@ -2410,7 +2110,6 @@       remitter (StringPrimL x) = Just x       remitter _ = Nothing -#if MIN_VERSION_template_haskell(2,11,0) _CharPrimL :: Prism' Lit Char _CharPrimL   = prism' reviewer remitter@@ -2418,7 +2117,6 @@       reviewer = CharPrimL       remitter (CharPrimL x) = Just x       remitter _ = Nothing-#endif  #if MIN_VERSION_template_haskell(2,16,0) _BytesPrimL :: Prism' Lit Bytes@@ -2472,6 +2170,20 @@       remitter _ = Nothing #endif +-- |+-- @+-- _ConP :: 'Prism'' 'Pat' ('Name', ['Type'], ['Pat']) -- template-haskell-2.18++-- _ConP :: 'Prism'' 'Pat' ('Name',         ['Pat']) -- Earlier versions+-- @+#if MIN_VERSION_template_haskell(2,18,0)+_ConP :: Prism' Pat (Name, [Type], [Pat])+_ConP+  = prism' reviewer remitter+  where+      reviewer (x, y, z) = ConP x y z+      remitter (ConP x y z) = Just (x, y, z)+      remitter _ = Nothing+#else _ConP :: Prism' Pat (Name, [Pat]) _ConP   = prism' reviewer remitter@@ -2479,6 +2191,7 @@       reviewer (x, y) = ConP x y       remitter (ConP x y) = Just (x, y)       remitter _ = Nothing+#endif  _InfixP :: Prism' Pat (Pat, Name, Pat) _InfixP@@ -2650,7 +2363,6 @@       remitter ArrowT = Just ()       remitter _ = Nothing -#if MIN_VERSION_template_haskell(2,10,0) _EqualityT :: Prism' Type () _EqualityT   = prism' reviewer remitter@@ -2658,7 +2370,6 @@       reviewer () = EqualityT       remitter EqualityT = Just ()       remitter _ = Nothing-#endif  _ListT :: Prism' Type () _ListT@@ -2716,7 +2427,6 @@       remitter (LitT x) = Just x       remitter _ = Nothing -#if MIN_VERSION_template_haskell(2,11,0) _InfixT :: Prism' Type (Type, Name, Type) _InfixT   = prism' reviewer remitter@@ -2748,7 +2458,6 @@       reviewer () = WildCardT       remitter WildCardT = Just ()       remitter _ = Nothing-#endif  #if MIN_VERSION_template_haskell(2,15,0) _AppKindT :: Prism' Type (Type, Kind)@@ -2852,7 +2561,6 @@       remitter _ = Nothing #endif -#if MIN_VERSION_template_haskell(2,11,0) _NoSig :: Prism' FamilyResultSig () _NoSig   = prism' reviewer remitter@@ -2876,7 +2584,6 @@       reviewer = TyVarSig       remitter (TyVarSig x) = Just x       remitter _ = Nothing-#endif  _NumTyLit :: Prism' TyLit Integer _NumTyLit@@ -2894,21 +2601,13 @@       remitter (StrTyLit x) = Just x       remitter _ = Nothing -#if !MIN_VERSION_template_haskell(2,10,0)-_ClassP :: Prism' Pred (Name, [Type])-_ClassP-  = prism' reviewer remitter-  where-      reviewer (x, y) = ClassP x y-      remitter (ClassP x y) = Just (x, y)-      remitter _ = Nothing--_EqualP :: Prism' Pred (Type, Type)-_EqualP+#if MIN_VERSION_template_haskell(2,18,0)+_CharTyLit :: Prism' TyLit Char+_CharTyLit   = prism' reviewer remitter   where-      reviewer (x, y) = EqualP x y-      remitter (EqualP x y) = Just (x, y)+      reviewer = CharTyLit+      remitter (CharTyLit x) = Just x       remitter _ = Nothing #endif 
src/Numeric/Lens.hs view
@@ -2,10 +2,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE Rank2Types #-}-#if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-}-#endif -------------------------------------------------------------------------------- -- | -- Module      :  Numeric.Lens@@ -30,9 +28,7 @@   , dividing   , exponentiating   , negated-#if __GLASGOW_HASKELL__ >= 710   , pattern Integral-#endif   ) where  import Control.Lens@@ -57,10 +53,9 @@   then Right a   else Left i -#if __GLASGOW_HASKELL__ >= 710+pattern Integral :: Integral a => a -> Integer pattern Integral a <- (preview integral -> Just a) where   Integral a = review integral a-#endif  -- | A prism that shows and reads integers in base-2 through base-36 --
src/Numeric/Natural/Lens.hs view
@@ -1,10 +1,7 @@-{-# language CPP #-} {-# language RankNTypes #-} {-# language PatternGuards #-}-#if __GLASGOW_HASKELL__ >= 710 {-# language ViewPatterns #-} {-# language PatternSynonyms #-}-#endif -------------------------------------------------------------------------------- -- | -- Module      :  Numeric.Natural.Lens@@ -20,11 +17,9 @@   ( _Pair   , _Sum   , _Naturals-#if __GLASGOW_HASKELL__ >= 710   , pattern Pair   , pattern Sum   , pattern Naturals-#endif   ) where  import Control.Lens@@ -65,8 +60,6 @@   yon [] = 0   yon (x:xs) = 1 + review _Pair (x, yon xs) -#if __GLASGOW_HASKELL__ >= 710- -- | -- interleaves the bits of two natural numbers pattern Pair :: Natural -> Natural -> Natural@@ -90,4 +83,3 @@ pattern Naturals :: [Natural] -> Natural pattern Naturals xs <- (view _Naturals -> xs) where   Naturals xs = review _Naturals xs-#endif
src/System/Exit/Lens.hs view
@@ -1,11 +1,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}--#if __GLASGOW_HASKELL__ >= 710 {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-}-#endif  ----------------------------------------------------------------------------- -- |@@ -22,10 +19,8 @@   ( AsExitCode(..)   , _ExitFailure   , _ExitSuccess-#if __GLASGOW_HASKELL__ >= 710   , pattern ExitFailure_   , pattern ExitSuccess_-#endif   ) where  import Prelude ()@@ -73,10 +68,10 @@   seta t               = Left  (pure t) {-# INLINE _ExitFailure #-} -#if __GLASGOW_HASKELL__ >= 710+pattern ExitSuccess_ :: AsExitCode s => s pattern ExitSuccess_ <- (has _ExitSuccess -> True) where   ExitSuccess_ = review _ExitSuccess () +pattern ExitFailure_ :: AsExitCode s => Int -> s pattern ExitFailure_ a <- (preview _ExitFailure -> Just a) where   ExitFailure_ a = review _ExitFailure a-#endif
tests/T917.hs view
@@ -6,40 +6,35 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} -#if __GLASGOW_HASKELL__ >= 800 && __GLASGOW_HASKELL__ < 806+#if __GLASGOW_HASKELL__ < 806 {-# LANGUAGE TypeInType #-} #endif module T917 where  import Control.Lens-import Data.Proxy--#if __GLASGOW_HASKELL__ >= 800 && __GLASGOW_HASKELL__ < 806 import Data.Kind-#endif+import Data.Proxy  -- Like Data.Functor.Const, but redefined to ensure that it is poly-kinded -- across all versions of GHC, not just 8.0+ newtype Constant a (b :: k) = Constant a -data T917OneA (a :: k -> *) (b :: k -> *) = MkT917OneA+data T917OneA (a :: k -> Type) (b :: k -> Type) = MkT917OneA data T917OneB a b = MkT917OneB (T917OneA a (Const b)) $(makePrisms ''T917OneB) -data T917TwoA (a :: k -> *) (b :: k -> *) = MkT917TwoA+data T917TwoA (a :: k -> Type) (b :: k -> Type) = MkT917TwoA data T917TwoB a b = MkT917TwoB (T917TwoA a (Const b)) $(makeClassyPrisms ''T917TwoB)  data family   T917DataFam (a :: k)-data instance T917DataFam (a :: *) = MkT917DataFam { _unT917DataFam :: Proxy a }+data instance T917DataFam (a :: Type) = MkT917DataFam { _unT917DataFam :: Proxy a } $(makeLenses 'MkT917DataFam) -#if __GLASGOW_HASKELL__ >= 800 data T917GadtOne (a :: k) where-  MkT917GadtOne :: T917GadtOne (a :: *)+  MkT917GadtOne :: T917GadtOne (a :: Type) $(makePrisms ''T917GadtOne)  data T917GadtTwo (a :: k) where-  MkT917GadtTwo :: T917GadtTwo (a :: *)+  MkT917GadtTwo :: T917GadtTwo (a :: Type) $(makePrisms ''T917GadtTwo)-#endif
tests/T972.hs view
@@ -2,15 +2,13 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TemplateHaskell #-} -#if __GLASGOW_HASKELL__ >= 800 && __GLASGOW_HASKELL__ < 806+#if __GLASGOW_HASKELL__ < 806 {-# LANGUAGE TypeInType #-} #endif module T972 where  import Control.Lens-#if __GLASGOW_HASKELL__ >= 800 import Data.Proxy-#endif  newtype Arc s = Arc { _unArc :: Int } @@ -18,7 +16,5 @@ data Dart s = Dart { _arc :: Arc s, _direction :: Direction } $(makeLenses ''Dart) -#if __GLASGOW_HASKELL__ >= 800 data Fancy k (a :: k) = MkFancy { _unFancy1 :: k, _unFancy2 :: Proxy a } $(makeLenses ''Fancy)-#endif
tests/hunit.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -Wno-missing-signatures #-} {-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} 
tests/properties.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -Wno-missing-signatures #-} {-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-}@@ -24,16 +24,12 @@ ----------------------------------------------------------------------------- module Main where -#if !(MIN_VERSION_base(4,8,0))-import Control.Applicative-#endif import Control.Lens import Test.QuickCheck import Test.Framework import Test.Framework.Providers.QuickCheck2 import Data.Char (isAlphaNum, isAscii, toUpper)-import Data.Text.Strict.Lens-import Data.List.Lens+import qualified Data.Text.Strict.Lens as Text import GHC.Exts (Constraint) import Numeric (showHex, showOct, showSigned) import Numeric.Lens@@ -86,7 +82,7 @@ prop_prefixed s                      = isPrism (prefixed s :: Prism' String String)  -- Data.Text.Lens-prop_text s                          = s^.packed.from packed == s+prop_text s                          = s^.Text.packed.from Text.packed == s --prop_text                           = isIso packed  -- Numeric.Lens