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 +1/−1
- CHANGELOG.markdown +26/−0
- benchmarks/plated.hs +1/−1
- benchmarks/traversals.hs +1/−1
- cabal.project +0/−4
- examples/Plates.hs +3/−6
- examples/Pong.hs +1/−4
- examples/lens-examples.cabal +3/−4
- include/lens-common.h +0/−24
- lens-properties/CHANGELOG.markdown +4/−0
- lens-properties/lens-properties.cabal +4/−5
- lens-properties/src/Control/Lens/Properties.hs +0/−4
- lens.cabal +22/−46
- src/Control/Exception/Lens.hs +51/−111
- src/Control/Lens/At.hs +3/−2
- src/Control/Lens/Combinators.hs +0/−2
- src/Control/Lens/Cons.hs +4/−12
- src/Control/Lens/Empty.hs +3/−11
- src/Control/Lens/Equality.hs +0/−22
- src/Control/Lens/Fold.hs +14/−16
- src/Control/Lens/Getter.hs +4/−6
- src/Control/Lens/Internal/Bazaar.hs +6/−5
- src/Control/Lens/Internal/ByteString.hs +0/−4
- src/Control/Lens/Internal/Coerce.hs +0/−35
- src/Control/Lens/Internal/Context.hs +2/−1
- src/Control/Lens/Internal/Deque.hs +2/−0
- src/Control/Lens/Internal/Exception.hs +5/−6
- src/Control/Lens/Internal/FieldTH.hs +0/−4
- src/Control/Lens/Internal/Fold.hs +29/−19
- src/Control/Lens/Internal/Indexed.hs +3/−2
- src/Control/Lens/Internal/Iso.hs +2/−2
- src/Control/Lens/Internal/Level.hs +2/−0
- src/Control/Lens/Internal/List.hs +33/−0
- src/Control/Lens/Internal/Magma.hs +2/−1
- src/Control/Lens/Internal/Prelude.hs +3/−52
- src/Control/Lens/Internal/Prism.hs +1/−2
- src/Control/Lens/Internal/TH.hs +36/−67
- src/Control/Lens/Internal/Zoom.hs +9/−1
- src/Control/Lens/Iso.hs +5/−43
- src/Control/Lens/Lens.hs +0/−37
- src/Control/Lens/Plated.hs +7/−28
- src/Control/Lens/Prism.hs +98/−7
- src/Control/Lens/Reified.hs +4/−0
- src/Control/Lens/Review.hs +0/−2
- src/Control/Lens/Setter.hs +3/−3
- src/Control/Lens/TH.hs +3/−41
- src/Control/Lens/Traversal.hs +70/−2
- src/Control/Lens/Tuple.hs +2/−1
- src/Control/Lens/Type.hs +0/−9
- src/Control/Lens/Unsound.hs +1/−1
- src/Control/Lens/Wrapped.hs +12/−29
- src/Control/Lens/Zoom.hs +10/−10
- src/Control/Monad/Error/Lens.hs +3/−1
- src/Control/Parallel/Strategies/Lens.hs +0/−4
- src/Data/ByteString/Lazy/Lens.hs +2/−7
- src/Data/ByteString/Lens.hs +2/−6
- src/Data/ByteString/Strict/Lens.hs +2/−7
- src/Data/Complex/Lens.hs +5/−8
- src/Data/Data/Lens.hs +3/−4
- src/Data/Dynamic/Lens.hs +1/−8
- src/Data/List/Lens.hs +21/−64
- src/Data/Text/Lazy/Lens.hs +2/−9
- src/Data/Text/Lens.hs +1/−9
- src/Data/Text/Strict/Lens.hs +2/−9
- src/Data/Vector/Generic/Lens.hs +1/−17
- src/GHC/Generics/Lens.hs +9/−13
- src/Language/Haskell/TH/Lens.hs +36/−337
- src/Numeric/Lens.hs +1/−6
- src/Numeric/Natural/Lens.hs +0/−8
- src/System/Exit/Lens.hs +2/−7
- tests/T917.hs +7/−12
- tests/T972.hs +1/−5
- tests/hunit.hs +1/−1
- tests/properties.hs +3/−7
.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