packages feed

lens 4.6.0.1 → 4.7

raw patch · 48 files changed

+494/−707 lines, 48 filesdep ~filepath

Dependency ranges changed: filepath

Files

CHANGELOG.markdown view
@@ -1,3 +1,17 @@+4.7+---+* Migrated `Control.Lens.Action` to `lens-action`.+* Added `Data.Vector.Generic.Lens.vectorIx` function for indexing vectors with only `Vector` constraint.+* Added `Field1` and `Field2` instances for `Data.Functor.Product.Product`.+* Removed the "typeclass synonym" `Gettable`.+* Added new flag to `makeLenses`, `generateUpdateableOptics`, which allows+  the generation of only `Getter`s and `Fold`s. This feature is intended+  to be used when the constructors are hidden behind validating, "smart"+  constructors.+* Fixed Template Haskell name generation when using GHC 7.10+* Fixed Template Haskell generation of classes methods where field types used+  existential quantification+ 4.6.0.1 [maintenance release] ------- * Compatibility with `base` 4.8
lens.cabal view
@@ -1,6 +1,6 @@ name:          lens category:      Data, Lenses, Generics-version:       4.6.0.1+version:       4.7 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE@@ -214,7 +214,6 @@   exposed-modules:     Control.Exception.Lens     Control.Lens-    Control.Lens.Action     Control.Lens.At     Control.Lens.Combinators     Control.Lens.Cons@@ -226,7 +225,6 @@     Control.Lens.Getter     Control.Lens.Indexed     Control.Lens.Internal-    Control.Lens.Internal.Action     Control.Lens.Internal.Bazaar     Control.Lens.Internal.ByteString     Control.Lens.Internal.Context
src/Control/Lens.hs view
@@ -44,8 +44,7 @@ -- <<Hierarchy.png>> ---------------------------------------------------------------------------- module Control.Lens-  ( module Control.Lens.Action-  , module Control.Lens.At+  ( module Control.Lens.At   , module Control.Lens.Cons   , module Control.Lens.Each   , module Control.Lens.Empty@@ -72,7 +71,6 @@   , module Control.Lens.Zoom   ) where -import Control.Lens.Action import Control.Lens.At import Control.Lens.Cons import Control.Lens.Each
− src/Control/Lens/Action.hs 
@@ -1,201 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MultiParamTypeClasses #-}-#ifdef TRUSTWORTHY-{-# LANGUAGE Trustworthy #-}-#endif--------------------------------------------------------------------------------- |--- Module      :  Control.Lens.Action--- Copyright   :  (C) 2012-14 Edward Kmett--- License     :  BSD-style (see the file LICENSE)--- Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  experimental--- Portability :  non-portable---------------------------------------------------------------------------------module Control.Lens.Action-  (-  -- * Composable Actions-    Action-  , act-  , acts-  , perform-  , performs-  , liftAct-  , (^!)-  , (^!!)-  , (^!?)--  -- * Indexed Actions-  , IndexedAction-  , iact-  , iperform-  , iperforms-  , (^@!)-  , (^@!!)-  , (^@!?)--  -- * Folds with Effects-  , MonadicFold-  , IndexedMonadicFold--  -- * Implementation Details-  , Acting-  , IndexedActing-  , Effective-  ) where--import Control.Comonad-import Control.Lens.Internal.Action-import Control.Lens.Internal.Fold-import Control.Lens.Internal.Indexed-import Control.Lens.Type-import Control.Monad (liftM)-import Control.Monad.Trans.Class-import Data.Profunctor-import Data.Profunctor.Rep-import Data.Profunctor.Unsafe---- $setup--- >>> :set -XNoOverloadedStrings--- >>> import Control.Lens--infixr 8 ^!, ^!!, ^@!, ^@!!, ^!?, ^@!?---- | Used to evaluate an 'Action'.-type Acting m r s a = LensLike (Effect m r) s s a a---- | Perform an 'Action'.------ @--- 'perform' ≡ 'flip' ('^!')--- @-perform :: Monad m => Acting m a s a -> s -> m a-perform l = getEffect #. l (Effect #. return)-{-# INLINE perform #-}---- | Perform an 'Action' and modify the result.------ @--- 'performs' :: 'Monad' m => 'Acting' m e s a -> (a -> e) -> s -> m e--- @-performs :: (Profunctor p, Monad m) => Over p (Effect m e) s t a b -> p a e -> s -> m e-performs l f = getEffect #. l (rmap (Effect #. return) f)-{-# INLINE performs #-}---- | Perform an 'Action'.------ >>> ["hello","world"]^!folded.act putStrLn--- hello--- world-(^!) :: Monad m => s -> Acting m a s a -> m a-a ^! l = getEffect (l (Effect #. return) a)-{-# INLINE (^!) #-}---- | Perform a 'MonadicFold' and collect all of the results in a list.------ >>> ["ab","cd","ef"]^!!folded.acts--- ["ace","acf","ade","adf","bce","bcf","bde","bdf"]------ [1,2]^!!folded.act (\i -> putStr (show i ++ ": ") >> getLine).each.to succ--- 1: aa--- 2: bb--- "bbcc"-(^!!) :: Monad m => s -> Acting m [a] s a -> m [a]-a ^!! l = getEffect (l (Effect #. return . return) a)-{-# INLINE (^!!) #-}---- | Perform a 'MonadicFold' and collect the leftmost result.------ /Note:/ this still causes all effects for all elements.------ >>> [Just 1, Just 2, Just 3]^!?folded.acts--- Just (Just 1)--- >>> [Just 1, Nothing]^!?folded.acts--- Nothing-(^!?) :: Monad m => s -> Acting m (Leftmost a) s a -> m (Maybe a)-a ^!?  l = liftM getLeftmost .# getEffect $ l (Effect #. return . LLeaf) a-{-# INLINE (^!?) #-}---- | Construct an 'Action' from a monadic side-effect.------ >>> ["hello","world"]^!folded.act (\x -> [x,x ++ "!"])--- ["helloworld","helloworld!","hello!world","hello!world!"]------ @--- 'act' :: 'Monad' m => (s -> m a) -> 'Action' m s a--- 'act' sma afb a = 'effective' (sma a '>>=' 'ineffective' '.' afb)--- @-act :: Monad m => (s -> m a) -> IndexPreservingAction m s a-act sma pafb = cotabulate $ \ws -> effective $ do-   a <- sma (extract ws)-   ineffective (corep pafb (a <$ ws))-{-# INLINE act #-}---- | A self-running 'Action', analogous to 'Control.Monad.join'.------ @--- 'acts' ≡ 'act' 'id'--- @------ >>> (1,"hello")^!_2.acts.to succ--- "ifmmp"------ (1,getLine)^!!_2.acts.folded.to succ--- aa--- "bb"-acts :: IndexPreservingAction m (m a) a-acts = act id-{-# INLINE acts #-}---- | Apply a 'Monad' transformer to an 'Action'.-liftAct :: (MonadTrans trans, Monad m) => Acting m a s a -> IndexPreservingAction (trans m) s a-liftAct l = act (lift . perform l)-{-# INLINE liftAct #-}---------------------------------------------------------------------------------- Indexed Actions--------------------------------------------------------------------------------- | Used to evaluate an 'IndexedAction'.-type IndexedActing i m r s a = Over (Indexed i) (Effect m r) s s a a---- | Perform an 'IndexedAction'.------ @--- 'iperform' ≡ 'flip' ('^@!')--- @-iperform :: Monad m => IndexedActing i m (i, a) s a -> s -> m (i, a)-iperform l = getEffect #. l (Indexed $ \i a -> Effect (return (i, a)))-{-# INLINE iperform #-}---- | Perform an 'IndexedAction' and modify the result.-iperforms :: Monad m => IndexedActing i m e s a -> (i -> a -> e) -> s -> m e-iperforms l = performs l .# Indexed-{-# INLINE iperforms #-}---- | Perform an 'IndexedAction'.-(^@!) :: Monad m => s -> IndexedActing i m (i, a) s a -> m (i, a)-s ^@! l = getEffect (l (Indexed $ \i a -> Effect (return (i, a))) s)-{-# INLINE (^@!) #-}---- | Obtain a list of all of the results of an 'IndexedMonadicFold'.-(^@!!) :: Monad m => s -> IndexedActing i m [(i, a)] s a -> m [(i, a)]-s ^@!! l = getEffect (l (Indexed $ \i a -> Effect (return [(i, a)])) s)-{-# INLINE (^@!!) #-}---- | Perform an 'IndexedMonadicFold' and collect the 'Leftmost' result.------ /Note:/ this still causes all effects for all elements.-(^@!?) :: Monad m => s -> IndexedActing i m (Leftmost (i, a)) s a -> m (Maybe (i, a))-a ^@!?  l = liftM getLeftmost .# getEffect $ l (Indexed $ \i -> Effect #. return . LLeaf . (,) i) a-{-# INLINE (^@!?) #-}---- | Construct an 'IndexedAction' from a monadic side-effect.-iact :: Monad m => (s -> m (i, a)) -> IndexedAction i m s a-iact smia iafb s = effective $ do-  (i, a) <- smia s-  ineffective (indexed iafb i a)-{-# INLINE iact #-}
src/Control/Lens/At.hs view
@@ -380,6 +380,11 @@   -- you cannot satisfy the 'Lens' laws.   at :: Index m -> Lens' m (Maybe (IxValue m)) +-- | Delete the value associated with a key in a 'Map'-like container+--+-- @+-- 'sans' k = 'at' k .~ Nothing+-- @ sans :: At m => Index m -> m -> m sans k m = m & at k .~ Nothing {-# INLINE sans #-}
src/Control/Lens/Combinators.hs view
@@ -19,13 +19,7 @@  import Control.Lens hiding   ( -- output from scripts/operators-    (^!)-  , (^!!)-  , (^!?)-  , (^@!)-  , (^@!!)-  , (^@!?)-  , (<|)+    (<|)   , (|>)   , (^..)   , (^?)
src/Control/Lens/Cons.hs view
@@ -54,6 +54,7 @@ import           Data.Vector.Unboxed (Unbox) import qualified Data.Vector.Unboxed as Unbox import           Data.Word+import           Prelude  {-# ANN module "HLint: ignore Eta reduce" #-}
src/Control/Lens/Fold.hs view
@@ -161,6 +161,7 @@ import Data.Profunctor.Rep import Data.Profunctor.Unsafe import Data.Traversable+import Prelude  -- $setup -- >>> :set -XNoOverloadedStrings@@ -432,7 +433,13 @@ -- Fold/Getter combinators -------------------------- --- | @+-- | Map each part of a structure viewed through a 'Lens', 'Getter',+-- 'Fold' or 'Traversal' to a monoid and combine the results.+--+-- >>> foldMapOf (folded . both . _Just) Sum [(Just 21, Just 21)]+-- Sum {getSum = 42}+--+-- @ -- 'Data.Foldable.foldMap' = 'foldMapOf' 'folded' -- @ --@@ -457,7 +464,13 @@ foldMapOf l f = getConst #. l (Const #. f) {-# INLINE foldMapOf #-} --- | @+-- | Combine the elements of a structure viewed through a 'Lens', 'Getter',+-- 'Fold' or 'Traversal' using a monoid.+--+-- >>> foldOf (folded.folded) [[Sum 1,Sum 4],[Sum 8, Sum 8],[Sum 21]]+-- Sum {getSum = 42}+--+-- @ -- 'Data.Foldable.fold' = 'foldOf' 'folded' -- @ --
src/Control/Lens/Getter.hs view
@@ -29,11 +29,10 @@ -- -- @type 'Getter' s a = forall r. 'Getting' r s a@ ----- But we actually hide the use of 'Const' behind a class 'Gettable' to--- report error messages from type class resolution rather than at unification--- time, where they are much uglier.+-- However, for 'Getter' (but not for 'Getting') we actually permit any+-- functor @f@ which is an instance of both 'Functor' and 'Contravariant': ----- @type 'Getter' s a = forall f. 'Gettable' f => (a -> f a) -> s -> f s@+-- @type 'Getter' s a = forall f. ('Contravariant' f, 'Functor' f) => (a -> f a) -> s -> f s@ -- -- Everything you can do with a function, you can do with a 'Getter', but -- note that because of the continuation passing style ('.') composes them@@ -67,7 +66,6 @@   , Contravariant(..)   , coerce, coerced   , Const(..)-  , Gettable   ) where  import Control.Applicative@@ -457,7 +455,8 @@ s ^@. l = getConst $ l (Indexed $ \i -> Const #. (,) i) s {-# INLINE (^@.) #-} --- | Coerce a 'Gettable' 'LensLike' to a 'Simple' 'LensLike'. This is useful--- when using a 'Traversal' that is not simple as a 'Getter' or a 'Fold'.+-- | Coerce a 'Getter'-compatible 'LensLike' to a 'Simple' 'LensLike'. This+-- is useful when using a 'Traversal' that is not simple as a 'Getter' or a+-- 'Fold'. coerced :: (Functor f, Contravariant f) => LensLike f s t a b -> LensLike' f s a coerced l f = coerce . l (coerce . f)
src/Control/Lens/Indexed.hs view
@@ -102,6 +102,7 @@ import Data.Tuple (swap) import Data.Vector (Vector) import qualified Data.Vector as V+import Prelude  infixr 9 <.>, <., .>
src/Control/Lens/Internal.hs view
@@ -14,8 +14,7 @@ -- ---------------------------------------------------------------------------- module Control.Lens.Internal-  ( module Control.Lens.Internal.Action-  , module Control.Lens.Internal.Bazaar+  ( module Control.Lens.Internal.Bazaar   , module Control.Lens.Internal.Context   , module Control.Lens.Internal.Fold   , module Control.Lens.Internal.Getter@@ -29,7 +28,6 @@   , module Control.Lens.Internal.Zoom   ) where -import Control.Lens.Internal.Action import Control.Lens.Internal.Bazaar import Control.Lens.Internal.Context import Control.Lens.Internal.Fold
− src/Control/Lens/Internal/Action.hs 
@@ -1,100 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}-#ifdef TRUSTWORTHY-{-# LANGUAGE Trustworthy #-}-#endif--------------------------------------------------------------------------------- |--- Module      :  Control.Lens.Internal.Action--- Copyright   :  (C) 2012-2014 Edward Kmett--- License     :  BSD-style (see the file LICENSE)--- Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  non-portable---------------------------------------------------------------------------------module Control.Lens.Internal.Action-  (-  -- ** Actions-    Effective(..)-  , Effect(..)-  ) where--import Control.Applicative-import Control.Applicative.Backwards-import Control.Monad-import Data.Functor.Bind-import Data.Functor.Contravariant-import Data.Functor.Identity-import Data.Profunctor.Unsafe-import Data.Semigroup------------------------------------------------------------------------------------ Programming with Effects------------------------------------------------------------------------------------ | An 'Effective' 'Functor' ignores its argument and is isomorphic to a 'Monad' wrapped around a value.------ That said, the 'Monad' is possibly rather unrelated to any 'Applicative' structure.-class (Monad m, Functor f, Contravariant f) => Effective m r f | f -> m r where-  effective :: m r -> f a-  ineffective :: f a -> m r--instance Effective m r f => Effective m (Dual r) (Backwards f) where-  effective = Backwards . effective . liftM getDual-  {-# INLINE effective #-}-  ineffective = liftM Dual . ineffective . forwards-  {-# INLINE ineffective #-}--instance Effective Identity r (Const r) where-  effective = Const #. runIdentity-  {-# INLINE effective #-}-  ineffective = Identity #. getConst-  {-# INLINE ineffective #-}----------------------------------------------------------------------------------- Effect----------------------------------------------------------------------------------- | Wrap a monadic effect with a phantom type argument.-newtype Effect m r a = Effect { getEffect :: m r }--- type role Effect representational nominal phantom--instance Functor (Effect m r) where-  fmap _ (Effect m) = Effect m-  {-# INLINE fmap #-}--instance Contravariant (Effect m r) where-  contramap _ (Effect m) = Effect m-  {-# INLINE contramap #-}--instance Monad m => Effective m r (Effect m r) where-  effective = Effect-  {-# INLINE effective #-}-  ineffective = getEffect-  {-# INLINE ineffective #-}--instance (Apply m, Semigroup r) => Semigroup (Effect m r a) where-  Effect ma <> Effect mb = Effect (liftF2 (<>) ma mb)-  {-# INLINE (<>) #-}--instance (Monad m, Monoid r) => Monoid (Effect m r a) where-  mempty = Effect (return mempty)-  {-# INLINE mempty #-}-  Effect ma `mappend` Effect mb = Effect (liftM2 mappend ma mb)-  {-# INLINE mappend #-}--instance (Apply m, Semigroup r) => Apply (Effect m r) where-  Effect ma <.> Effect mb = Effect (liftF2 (<>) ma mb)-  {-# INLINE (<.>) #-}--instance (Monad m, Monoid r) => Applicative (Effect m r) where-  pure _ = Effect (return mempty)-  {-# INLINE pure #-}-  Effect ma <*> Effect mb = Effect (liftM2 mappend ma mb)-  {-# INLINE (<*>) #-}
src/Control/Lens/Internal/ByteString.hs view
@@ -9,6 +9,9 @@ #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #endif++{-# OPTIONS_GHC -fno-warn-deprecations #-} -- for inlinePerformIO+ ----------------------------------------------------------------------------- -- | -- Module      :  Data.ByteString.Strict.Lens@@ -42,7 +45,10 @@ import Data.Word (Word8) import Foreign.Ptr import Foreign.Storable-#if MIN_VERSION_base(4,4,0)+#if MIN_VERSION_base(4,8,0)+import Foreign.ForeignPtr+import Foreign.ForeignPtr.Unsafe+#elif MIN_VERSION_base(4,4,0) import Foreign.ForeignPtr.Safe import Foreign.ForeignPtr.Unsafe #else
src/Control/Lens/Internal/Context.hs view
@@ -282,10 +282,11 @@ -- impact on its performance, and which permits the use of an arbitrary 'Conjoined' -- 'Profunctor'. ----- The extra phantom 'Functor' is used to let us lie and claim a 'Gettable' instance under--- limited circumstances. This is used internally to permit a number of combinators to--- gracefully degrade when applied to a 'Control.Lens.Fold.Fold', 'Control.Lens.Getter.Getter'--- or 'Control.Lens.Action.Action'.+-- The extra phantom 'Functor' is used to let us lie and claim+-- 'Control.Lens.Getter.Getter'-compatibility under limited circumstances.+-- 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 }  #if __GLASGOW_HASKELL__ >= 707
src/Control/Lens/Internal/Deque.hs view
@@ -56,7 +56,7 @@ data Deque a = BD !Int [a] !Int [a]   deriving Show --- | /O(1)/. Determine of a 'Deque' is 'empty'.+-- | /O(1)/. Determine if a 'Deque' is 'empty'. -- -- >>> null empty -- True
src/Control/Lens/Internal/Exception.hs view
@@ -7,9 +7,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE KindSignatures #-}-#ifdef TRUSTWORTHY-{-# LANGUAGE Trustworthy #-}-#endif #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE PolyKinds #-}
src/Control/Lens/Internal/FieldTH.hs view
@@ -1,5 +1,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE PatternGuards #-}+#ifdef TRUSTWORTHY+{-# LANGUAGE Trustworthy #-}+#endif  ----------------------------------------------------------------------------- -- |@@ -32,15 +35,17 @@ import Control.Monad import Language.Haskell.TH.Lens import Language.Haskell.TH-import Data.Traversable (sequenceA) import Data.Foldable (toList) import Data.Maybe (isJust,maybeToList) import Data.List (nub, findIndices) import Data.Either (partitionEithers) import Data.Set.Lens import           Data.Map ( Map )+import           Data.Set ( Set ) import qualified Data.Set as Set import qualified Data.Map as Map+import qualified Data.Traversable as T+import Prelude   ------------------------------------------------------------------------@@ -81,7 +86,7 @@      let allFields  = toListOf (folded . _2 . folded . _1 . folded) fieldCons      let defCons    = over normFieldLabels (expandName allFields) fieldCons          allDefs    = setOf (normFieldLabels . folded) defCons-     perDef <- sequenceA (fromSet (buildScaffold rules s defCons) allDefs)+     perDef <- T.sequenceA (fromSet (buildScaffold rules s defCons) allDefs)       let defs = Map.toList perDef      case _classyLenses rules tyName of@@ -145,21 +150,30 @@                          | otherwise = foldTypeName                in OpticSa cx optic s' a' +           -- Getter and Fold are always simple+           | not (_allowUpdates rules) =+               let optic | lensCase  = getterTypeName+                         | otherwise = foldTypeName+               in OpticSa [] optic s' a++           -- Generate simple Lens and Traversal where possible            | _simpleLenses rules || s' == t && a == b =                let optic | isoCase && _allowIsos rules = iso'TypeName-                         | lensCase  = lens'TypeName-                         | otherwise = traversal'TypeName+                         | lensCase                    = lens'TypeName+                         | otherwise                   = traversal'TypeName                in OpticSa [] optic s' a +           -- Generate type-changing Lens and Traversal otherwise            | otherwise =                let optic | isoCase && _allowIsos rules = isoTypeName-                         | lensCase  = lensTypeName-                         | otherwise = traversalTypeName+                         | lensCase                    = lensTypeName+                         | otherwise                   = traversalTypeName                in OpticStab optic s' t a b -         opticType | has _ForallT a = GetterType-                   | isoCase        = IsoType-                   | otherwise      = LensType+         opticType | has _ForallT a            = GetterType+                   | not (_allowUpdates rules) = GetterType+                   | isoCase                   = IsoType+                   | otherwise                 = LensType       return (opticType, defType, scaffolds)   where@@ -195,6 +209,10 @@ stabToType (OpticStab  c s t a b) = quantifyType [] (c `conAppsT` [s,t,a,b]) stabToType (OpticSa cx c s   a  ) = quantifyType cx (c `conAppsT` [s,a]) +stabToContext :: OpticStab -> Cxt+stabToContext OpticStab{}        = []+stabToContext (OpticSa cx _ _ _) = cx+ stabToOptic :: OpticStab -> Name stabToOptic (OpticStab c _ _ _ _) = c stabToOptic (OpticSa _ c _ _) = c@@ -217,7 +235,7 @@      let s' = applyTypeSubst subA s       -- compute possible type changes-     sub <- sequenceA (fromSet (newName . nameBase) unfixedTypeVars)+     sub <- T.sequenceA (fromSet (newName . nameBase) unfixedTypeVars)      let (t,b) = over both (substTypeVars sub) (s',a)       return (s',t,a,b)@@ -237,7 +255,7 @@   DecsQ makeFieldOptic rules (defName, (opticType, defType, cons)) =   do cls <- mkCls-     sequenceA (cls ++ sig ++ def)+     T.sequenceA (cls ++ sig ++ def)   where   mkCls = case defName of           MethodName c n | _generateClasses rules ->@@ -271,7 +289,7 @@   Type {- ^ Outer 's' type -} ->   [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))] ->   DecsQ-makeClassyDriver rules className methodName s defs = sequenceA (cls ++ inst)+makeClassyDriver rules className methodName s defs = T.sequenceA (cls ++ inst)    where   cls | _generateClasses rules = [makeClassyClass className methodName s defs]@@ -298,12 +316,16 @@   classD (cxt[]) className (map PlainTV (c:vars)) fd     $ sigD methodName (return (lens'TypeName `conAppsT` [VarT c, s']))     : concat-      [ [sigD defName (return (stabToOptic stab `conAppsT` [VarT c, applyTypeSubst sub (stabToA stab)]))+      [ [sigD defName (return ty)         ,valD (varP defName) (normalB body) []         ] ++         inlinePragma defName       | (TopName defName, (_, stab, _)) <- defs       , let body = appsE [varE composeValName, varE methodName, varE defName]+      , let ty   = quantifyType' (Set.fromList (c:vars))+                                 (stabToContext stab)+                 $ stabToOptic stab `conAppsT`+                       [VarT c, applyTypeSubst sub (stabToA stab)]       ]  @@ -337,7 +359,9 @@   classD (cxt []) className [PlainTV s, PlainTV a] [FunDep [s] [a]]          [sigD methodName (return methodType)]   where-  methodType = stabToOptic defType `conAppsT` [VarT s,VarT a]+  methodType = quantifyType' (Set.fromList [s,a])+                             (stabToContext defType)+             $ stabToOptic defType `conAppsT` [VarT s,VarT a]   s = mkName "s"   a = mkName "a" @@ -516,13 +540,14 @@   data LensRules = LensRules-  { _simpleLenses :: Bool-  , _generateSigs :: Bool+  { _simpleLenses    :: Bool+  , _generateSigs    :: Bool   , _generateClasses :: Bool-  , _allowIsos    :: Bool-  , _fieldToDef   :: Name -> [Name] -> Name -> [DefName]+  , _allowIsos       :: Bool+  , _allowUpdates    :: Bool -- ^ Allow Lens/Traversal (otherwise Getter/Fold)+  , _fieldToDef      :: Name -> [Name] -> Name -> [DefName]        -- ^ Type Name -> Field Names -> Target Field Name -> Definition Names-  , _classyLenses :: Name -> Maybe (Name,Name)+  , _classyLenses    :: Name -> Maybe (Name,Name)        -- type name to class name and top method   } @@ -544,6 +569,13 @@ quantifyType c t = ForallT vs c t   where   vs = map PlainTV (toList (setOf typeVars t))++-- | This function works like 'quantifyType' except that it takes+-- a list of variables to exclude from quantification.+quantifyType' :: Set Name -> Cxt -> Type -> Type+quantifyType' exclude c t = ForallT vs c t+  where+  vs = map PlainTV (toList (setOf typeVars t Set.\\ exclude))   ------------------------------------------------------------------------
src/Control/Lens/Internal/Fold.hs view
@@ -2,9 +2,6 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-}-#ifdef TRUSTWORTHY-{-# LANGUAGE Trustworthy #-}-#endif ----------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Internal.Fold@@ -36,6 +33,7 @@ import Data.Maybe import Data.Semigroup hiding (Min, getMin, Max, getMax) import Data.Reflection+import Prelude  {-# ANN module "HLint: ignore Avoid lambda" #-}
src/Control/Lens/Internal/Getter.hs view
@@ -14,17 +14,13 @@ ---------------------------------------------------------------------------- module Control.Lens.Internal.Getter   (-  -- * Internal Classes-    Gettable-  -- ** Getters-  , coerce+    coerce   , noEffect   , AlongsideLeft(..)   , AlongsideRight(..)   ) where  import Control.Applicative-import Control.Lens.Internal.Action import Data.Bifoldable import Data.Bifunctor import Data.Bitraversable@@ -34,30 +30,20 @@ import Data.Semigroup.Traversable import Data.Traversable import Data.Void---- | This class is provided mostly for backwards compatibility with lens 3.8,--- but it can also shorten type signatures.-class (Contravariant f, Functor f) => Gettable f-instance (Contravariant f, Functor f) => Gettable f------------------------------------------------------------------------------------ Gettables & Accessors--------------------------------------------------------------------------------+import Prelude --- | This Generalizes 'Const' so we can apply simple 'Applicative'--- transformations to it and so we can get nicer error messages.------ A 'Functor' you can 'coerce' ignores its argument, which it carries solely as a--- phantom type parameter.+-- | A 'Functor' you can 'coerce' ignores its argument, which it carries+-- solely as a phantom type parameter. ----- By the 'Functor' and 'Contravariant' laws, an instance of 'Gettable' will necessarily satisfy:+-- By the 'Functor' and 'Contravariant' laws, an instance of both will+-- necessarily satisfy: -- -- @'id' = 'fmap' f = 'coerce' = 'contramap' g@ coerce :: (Contravariant f, Functor f) => f a -> f b coerce a = absurd <$> contramap absurd a {-# INLINE coerce #-} --- | The 'mempty' equivalent for a 'Gettable' 'Applicative' 'Functor'.+-- | The 'mempty' equivalent for a 'Contravariant' 'Applicative' 'Functor'. noEffect :: (Contravariant f, Applicative f) => f a noEffect = coerce $ pure () {-# INLINE noEffect #-}@@ -103,12 +89,6 @@   bitraverse f g (AlongsideLeft as) = AlongsideLeft <$> traverse (bitraverse g f) as   {-# INLINE bitraverse #-} -instance Effective m r f => Effective m r (AlongsideLeft f b) where-  effective = AlongsideLeft . effective-  {-# INLINE effective #-}-  ineffective = ineffective . getAlongsideLeft-  {-# INLINE ineffective #-}- newtype AlongsideRight f a b = AlongsideRight { getAlongsideRight :: f (a, b) }  deriving instance Show (f (a, b)) => Show (AlongsideRight f a b)@@ -149,9 +129,3 @@ instance Traversable f => Bitraversable (AlongsideRight f) where   bitraverse f g (AlongsideRight as) = AlongsideRight <$> traverse (bitraverse f g) as   {-# INLINE bitraverse #-}--instance Effective m r f => Effective m r (AlongsideRight f b) where-  effective = AlongsideRight . effective-  {-# INLINE effective #-}-  ineffective = ineffective . getAlongsideRight-  {-# INLINE ineffective #-}
src/Control/Lens/Internal/Level.hs view
@@ -5,9 +5,6 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-#ifdef TRUSTWORTHY-{-# LANGUAGE Trustworthy #-}-#endif ----------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Internal.Level
src/Control/Lens/Internal/PrismTH.hs view
@@ -1,4 +1,7 @@ {-# LANGUAGE CPP #-}+#ifdef TRUSTWORTHY+{-# LANGUAGE Trustworthy #-}+#endif  ----------------------------------------------------------------------------- -- |@@ -28,11 +31,12 @@ import Data.List import Data.Monoid import Data.Set.Lens-import Data.Traversable (for,sequenceA,traverse)+import Data.Traversable import Language.Haskell.TH import Language.Haskell.TH.Lens import qualified Data.Map as Map import qualified Data.Set as Set+import Prelude  -- | Generate a 'Prism' for each constructor of a data type. -- Isos generated when possible.@@ -140,7 +144,7 @@     do let conName = view nconName con        stab <- computeOpticType t cons con        let n = prismName conName-       sequence+       sequenceA          [ sigD n (close (stabToType stab))          , valD (varP n) (normalB (makeConOpticExp stab cons con)) []          ]@@ -148,7 +152,7 @@  -- classy prism class and instance makeConsPrisms t cons (Just typeName) =-  sequence+  sequenceA     [ makeClassyPrismClass t className methodName cons     , makeClassyPrismInstance t className methodName cons     ]@@ -242,7 +246,7 @@ makeConIso s con =   do let ty      = computeIsoType s (view nconTypes con)          defName = prismName (view nconName con)-     sequence+     sequenceA        [ sigD       defName  ty        , valD (varP defName) (normalB (makeConIsoExp con)) []        ]@@ -392,7 +396,7 @@        let stab' = Stab cx o r r b b            defName = view nconName con            body    = appsE [varE composeValName, varE methodName, varE defName]-       sequence+       sequenceA          [ sigD defName        (return (stabToType stab'))          , valD (varP defName) (normalB body) []          ]
src/Control/Lens/Internal/Setter.hs view
@@ -26,6 +26,7 @@ import Data.Profunctor import Data.Profunctor.Unsafe import Data.Traversable+import Prelude  ----------------------------------------------------------------------------- -- Settable
src/Control/Lens/Internal/TH.hs view
@@ -14,6 +14,10 @@ #ifndef MIN_VERSION_containers #define MIN_VERSION_containers(x,y,z) 1 #endif++#ifndef MIN_VERSION_base+#define MIN_VERSION_base(x,y,z) 1+#endif ----------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Internal.TH@@ -30,8 +34,10 @@ import Language.Haskell.TH.Syntax import qualified Data.Map as Map import qualified Data.Set as Set+#ifndef CURRENT_PACKAGE_KEY import Data.Version (showVersion) import Paths_lens (version)+#endif  -- | Compatibility shim for recent changes to template haskell's 'tySynInstD' tySynInstD' :: Name -> [TypeQ] -> TypeQ -> DecQ@@ -88,11 +94,18 @@ -- 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 ("lens-" ++ showVersion version)+mkLensName_tc           = mkNameG_tc lensPackageKey  mkLensName_v           :: String -> String -> Name-mkLensName_v            = mkNameG_v ("lens-" ++ showVersion version)+mkLensName_v            = mkNameG_v lensPackageKey  traversalTypeName      :: Name traversalTypeName       = mkLensName_tc "Control.Lens.Type" "Traversal"@@ -160,11 +173,19 @@ fmapValName             :: Name fmapValName              = mkNameG_v "base" "GHC.Base" "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"  apValName               :: Name apValName                = mkNameG_v "base" "Control.Applicative" "<*>"+#endif  rightDataName           :: Name rightDataName            = mkNameG_d "base" "Data.Either" "Right"
src/Control/Lens/Internal/Zoom.hs view
@@ -1,11 +1,9 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE Safe #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-}-#ifdef TRUSTWORTHY-{-# LANGUAGE Trustworthy #-}-#endif  {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-} -----------------------------------------------------------------------------@@ -30,13 +28,13 @@   , FocusingErr(..), Err(..)   -- * Magnify   , Magnified+  , Effect(..)   , EffectRWS(..)   ) where  import Control.Applicative import Control.Category import Control.Comonad-import Control.Lens.Internal.Action import Control.Monad.Reader as Reader import Control.Monad.Trans.State.Lazy as Lazy import Control.Monad.Trans.State.Strict as Strict@@ -268,6 +266,42 @@ type instance Magnified (Strict.RWST a w s m) = EffectRWS w s m type instance Magnified (Lazy.RWST a w s m) = EffectRWS w s m type instance Magnified (IdentityT m) = Magnified m++-----------------------------------------------------------------------------+--- Effect+-------------------------------------------------------------------------------++-- | Wrap a monadic effect with a phantom type argument.+newtype Effect m r a = Effect { getEffect :: m r }+-- type role Effect representational nominal phantom++instance Functor (Effect m r) where+  fmap _ (Effect m) = Effect m+  {-# INLINE fmap #-}++instance Contravariant (Effect m r) where+  contramap _ (Effect m) = Effect m+  {-# INLINE contramap #-}++instance (Apply m, Semigroup r) => Semigroup (Effect m r a) where+  Effect ma <> Effect mb = Effect (liftF2 (<>) ma mb)+  {-# INLINE (<>) #-}++instance (Monad m, Monoid r) => Monoid (Effect m r a) where+  mempty = Effect (return mempty)+  {-# INLINE mempty #-}+  Effect ma `mappend` Effect mb = Effect (liftM2 mappend ma mb)+  {-# INLINE mappend #-}++instance (Apply m, Semigroup r) => Apply (Effect m r) where+  Effect ma <.> Effect mb = Effect (liftF2 (<>) ma mb)+  {-# INLINE (<.>) #-}++instance (Monad m, Monoid r) => Applicative (Effect m r) where+  pure _ = Effect (return mempty)+  {-# INLINE pure #-}+  Effect ma <*> Effect mb = Effect (liftM2 mappend ma mb)+  {-# INLINE (<*>) #-}  ------------------------------------------------------------------------------ -- EffectRWS
src/Control/Lens/Lens.hs view
@@ -24,11 +24,11 @@ -- A @'Lens' s t a b@ is a purely functional reference. -- -- While a 'Control.Lens.Traversal.Traversal' could be used for--- 'Control.Lens.Getter.Getting' like a valid 'Control.Lens.Fold.Fold',--- it wasn't a valid 'Control.Lens.Getter.Getter' as 'Applicative' wasn't a superclass of--- 'Control.Lens.Getter.Gettable'.+-- 'Control.Lens.Getter.Getting' like a valid 'Control.Lens.Fold.Fold', it+-- wasn't a valid 'Control.Lens.Getter.Getter' as a+-- 'Control.Lens.Getter.Getter' can't require an 'Applicative' constraint. ----- 'Functor', however is the superclass of both.+-- 'Functor', however, is a constraint on both. -- -- @ -- type 'Lens' s t a b = forall f. 'Functor' f => (a -> f b) -> s -> f t@@ -38,13 +38,13 @@ -- -- Every 'Lens' can be used for 'Control.Lens.Getter.Getting' like a -- 'Control.Lens.Fold.Fold' that doesn't use the 'Applicative' or--- 'Control.Lens.Getter.Gettable'.+-- 'Contravariant'. -- -- Every 'Lens' is a valid 'Control.Lens.Traversal.Traversal' that only uses -- the 'Functor' part of the 'Applicative' it is supplied. -- -- Every 'Lens' can be used for 'Control.Lens.Getter.Getting' like a valid--- 'Control.Lens.Getter.Getter', since 'Functor' is a superclass of 'Control.Lens.Getter.Gettable'.+-- 'Control.Lens.Getter.Getter'. -- -- Since every 'Lens' can be used for 'Control.Lens.Getter.Getting' like a -- valid 'Control.Lens.Getter.Getter' it follows that it must view exactly one element in the@@ -135,6 +135,7 @@ import Data.Profunctor.Rep import Data.Profunctor.Unsafe import Data.Void+import Prelude  #ifdef HLINT {-# ANN module "HLint: ignore Use ***" #-}@@ -366,6 +367,12 @@ -- 'inside' :: 'Lens' s t a b -> 'Lens' (e -> s) (e -> t) (e -> a) (e -> b) -- @ --+--+-- >>> (\x -> (x-1,x+1)) ^. inside _1 $ 5+-- 4+--+-- >>> runState (modify (1:) >> modify (2:)) ^. (inside _2) $ []+-- [2,1] inside :: Corepresentable p => ALens s t a b -> Lens (p e s) (p e t) (p e a) (p e b) inside l f es = o <$> f i where   i = cotabulate $ \ e -> ipos $ l sell (corep es e)@@ -826,7 +833,7 @@ -- Setting and Remembering State ------------------------------------------------------------------------------- --- | Modify the target of a 'Lens' into your 'Monad'\'s state by a user supplied+-- | Modify the target of a 'Lens' into your 'Monad''s state by a user supplied -- function and return the result. -- -- When applied to a 'Control.Lens.Traversal.Traversal', it this will return a monoidal summary of all of the intermediate@@ -844,7 +851,7 @@ {-# INLINE (<%=) #-}  --- | Add to the target of a numerically valued 'Lens' into your 'Monad'\'s state+-- | Add to the target of a numerically valued 'Lens' into your 'Monad''s state -- and return the result. -- -- When you do not need the result of the addition, ('Control.Lens.Setter.+=') is more@@ -858,7 +865,7 @@ l <+= a = l <%= (+ a) {-# INLINE (<+=) #-} --- | Subtract from the target of a numerically valued 'Lens' into your 'Monad'\'s+-- | Subtract from the target of a numerically valued 'Lens' into your 'Monad''s -- state and return the result. -- -- When you do not need the result of the subtraction, ('Control.Lens.Setter.-=') is more@@ -872,7 +879,7 @@ l <-= a = l <%= subtract a {-# INLINE (<-=) #-} --- | Multiply the target of a numerically valued 'Lens' into your 'Monad'\'s+-- | Multiply the target of a numerically valued 'Lens' into your 'Monad''s -- state and return the result. -- -- When you do not need the result of the multiplication, ('Control.Lens.Setter.*=') is more@@ -886,7 +893,7 @@ l <*= a = l <%= (* a) {-# INLINE (<*=) #-} --- | Divide the target of a fractionally valued 'Lens' into your 'Monad'\'s state+-- | Divide the target of a fractionally valued 'Lens' into your 'Monad''s state -- and return the result. -- -- When you do not need the result of the division, ('Control.Lens.Setter.//=') is more flexible.@@ -899,7 +906,7 @@ l <//= a = l <%= (/ a) {-# INLINE (<//=) #-} --- | Raise the target of a numerically valued 'Lens' into your 'Monad'\'s state+-- | Raise the target of a numerically valued 'Lens' into your 'Monad''s state -- to a non-negative 'Integral' power and return the result. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.^=') is more flexible.@@ -912,7 +919,7 @@ l <^= e = l <%= (^ e) {-# INLINE (<^=) #-} --- | Raise the target of a fractionally valued 'Lens' into your 'Monad'\'s state+-- | Raise the target of a fractionally valued 'Lens' into your 'Monad''s state -- to an 'Integral' power and return the result. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.^^=') is more flexible.@@ -925,7 +932,7 @@ l <^^= e = l <%= (^^ e) {-# INLINE (<^^=) #-} --- | Raise the target of a floating-point valued 'Lens' into your 'Monad'\'s+-- | Raise the target of a floating-point valued 'Lens' into your 'Monad''s -- state to an arbitrary power and return the result. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.**=') is more flexible.@@ -938,7 +945,7 @@ l <**= a = l <%= (** a) {-# INLINE (<**=) #-} --- | Logically '||' a Boolean valued 'Lens' into your 'Monad'\'s state and return+-- | Logically '||' a Boolean valued 'Lens' into your 'Monad''s state and return -- the result. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.||=') is more flexible.@@ -951,7 +958,7 @@ l <||= b = l <%= (|| b) {-# INLINE (<||=) #-} --- | Logically '&&' a Boolean valued 'Lens' into your 'Monad'\'s state and return+-- | Logically '&&' a Boolean valued 'Lens' into your 'Monad''s state and return -- the result. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.&&=') is more flexible.@@ -964,7 +971,7 @@ l <&&= b = l <%= (&& b) {-# INLINE (<&&=) #-} --- | Modify the target of a 'Lens' into your 'Monad'\'s state by a user supplied+-- | Modify the target of a 'Lens' into your 'Monad''s state by a user supplied -- function and return the /old/ value that was replaced. -- -- When applied to a 'Control.Lens.Traversal.Traversal', it this will return a monoidal summary of all of the old values@@ -983,7 +990,7 @@ l <<%= f = l %%= lmap (\a -> (a,a)) (second' f) {-# INLINE (<<%=) #-} --- | Replace the target of a 'Lens' into your 'Monad'\'s state with a user supplied+-- | Replace the target of a 'Lens' into your 'Monad''s state with a user supplied -- value and return the /old/ value that was replaced. -- -- When applied to a 'Control.Lens.Traversal.Traversal', it this will return a monoidal summary of all of the old values@@ -1000,7 +1007,7 @@ l <<.= b = l %%= \a -> (a,b) {-# INLINE (<<.=) #-} --- | Modify the target of a 'Lens' into your 'Monad'\'s state by adding a value+-- | Modify the target of a 'Lens' into your 'Monad''s state by adding a value -- and return the /old/ value that was replaced. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.+=') is more flexible.@@ -1013,7 +1020,7 @@ l <<+= n = l %%= \a -> (a, a + n) {-# INLINE (<<+=) #-} --- | Modify the target of a 'Lens' into your 'Monad'\'s state by subtracting a value+-- | Modify the target of a 'Lens' into your 'Monad''s state by subtracting a value -- and return the /old/ value that was replaced. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.-=') is more flexible.@@ -1026,7 +1033,7 @@ l <<-= n = l %%= \a -> (a, a - n) {-# INLINE (<<-=) #-} --- | Modify the target of a 'Lens' into your 'Monad'\'s state by multipling a value+-- | Modify the target of a 'Lens' into your 'Monad''s state by multipling a value -- and return the /old/ value that was replaced. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.*=') is more flexible.@@ -1052,7 +1059,7 @@ l <<//= n = l %%= \a -> (a, a / n) {-# INLINE (<<//=) #-} --- | Modify the target of a 'Lens' into your 'Monad'\'s state by raising it by a non-negative power+-- | Modify the target of a 'Lens' into your 'Monad''s state by raising it by a non-negative power -- and return the /old/ value that was replaced. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.^=') is more flexible.@@ -1065,7 +1072,7 @@ l <<^= n = l %%= \a -> (a, a ^ n) {-# INLINE (<<^=) #-} --- | Modify the target of a 'Lens' into your 'Monad'\'s state by raising it by an integral power+-- | Modify the target of a 'Lens' into your 'Monad''s state by raising it by an integral power -- and return the /old/ value that was replaced. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.^^=') is more flexible.@@ -1078,7 +1085,7 @@ l <<^^= n = l %%= \a -> (a, a ^^ n) {-# INLINE (<<^^=) #-} --- | Modify the target of a 'Lens' into your 'Monad'\'s state by raising it by an arbitrary power+-- | Modify the target of a 'Lens' into your 'Monad''s state by raising it by an arbitrary power -- and return the /old/ value that was replaced. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.**=') is more flexible.@@ -1091,7 +1098,7 @@ l <<**= n = l %%= \a -> (a, a ** n) {-# INLINE (<<**=) #-} --- | Modify the target of a 'Lens' into your 'Monad'\'s state by taking its logical '||' with a value+-- | Modify the target of a 'Lens' into your 'Monad''s state by taking its logical '||' with a value -- and return the /old/ value that was replaced. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.||=') is more flexible.@@ -1104,7 +1111,7 @@ l <<||= b = l %%= \a -> (a, a || b) {-# INLINE (<<||=) #-} --- | Modify the target of a 'Lens' into your 'Monad'\'s state by taking its logical '&&' with a value+-- | Modify the target of a 'Lens' into your 'Monad''s state by taking its logical '&&' with a value -- and return the /old/ value that was replaced. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.&&=') is more flexible.@@ -1117,7 +1124,7 @@ l <<&&= b = l %%= \a -> (a, a && b) {-# INLINE (<<&&=) #-} --- | Modify the target of a 'Lens' into your 'Monad'\'s state by 'mappend'ing a value+-- | Modify the target of a 'Lens' into your 'Monad''s state by 'mappend'ing a value -- and return the /old/ value that was replaced. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.<>=') is more flexible.@@ -1155,7 +1162,7 @@ {-# INLINE (<<>~) #-}  -- | 'mappend' a monoidal value onto the end of the target of a 'Lens' into--- your 'Monad'\'s state and return the result.+-- your 'Monad''s state and return the result. -- -- When you do not need the result of the operation, ('Control.Lens.Setter.<>=') is more flexible. (<<>=) :: (MonadState s m, Monoid r) => LensLike' ((,)r) s r -> r -> m r
src/Control/Lens/Operators.hs view
@@ -15,15 +15,8 @@ ---------------------------------------------------------------------------- module Control.Lens.Operators   ( -- output from scripts/operators -h-  -- * "Control.Lens.Action"-    (^!)-  , (^!!)-  , (^!?)-  , (^@!)-  , (^@!!)-  , (^@!?)   -- * "Control.Lens.Cons"-  , (<|)+    (<|)   , (|>)   -- * "Control.Lens.Fold"   , (^..)
src/Control/Lens/Prism.hs view
@@ -60,6 +60,7 @@ #else import Data.Profunctor.Unsafe #endif+import Prelude  {-# ANN module "HLint: ignore Use camelCase" #-}
src/Control/Lens/Reified.hs view
@@ -18,11 +18,10 @@ import Control.Arrow import qualified Control.Category as Cat import Control.Comonad-import Control.Lens.Action import Control.Lens.Fold import Control.Lens.Getter import Control.Lens.Internal.Indexed-import Control.Lens.Traversal (ignored,beside)+import Control.Lens.Traversal (ignored) import Control.Lens.Type import Control.Monad import Control.Monad.Reader.Class@@ -457,122 +456,6 @@   second' l = IndexedFold $ \f (c,s) ->     coerce $ runIndexedFold l (dimap ((,) c) coerce f) s   {-# INLINE second' #-}----------------------------------------------------------------------------------- MonadicFold----------------------------------------------------------------------------------- | Reify a 'MonadicFold' so it can be stored safely in a container.----newtype ReifiedMonadicFold m s a = MonadicFold { runMonadicFold :: MonadicFold m s a }--instance Profunctor (ReifiedMonadicFold m) where-  dimap f g l = MonadicFold (to f . runMonadicFold l . to g)-  {-# INLINE dimap #-}-  rmap g l = MonadicFold (runMonadicFold l . to g)-  {-# INLINE rmap #-}-  lmap f l = MonadicFold (to f . runMonadicFold l)-  {-# INLINE lmap #-}--instance Strong (ReifiedMonadicFold m) where-  first' l = MonadicFold $ \f (s,c) ->-    coerce $ runMonadicFold l (dimap (flip (,) c) coerce f) s-  {-# INLINE first' #-}-  second' l = MonadicFold $ \f (c,s) ->-    coerce $ runMonadicFold l (dimap ((,) c) coerce f) s-  {-# INLINE second' #-}--instance Choice (ReifiedMonadicFold m) where-  left' (MonadicFold l) = MonadicFold $-    to tuplify.beside (folded.l.to Left) (folded.to Right)-    where-      tuplify (Left lval) = (Just lval,Nothing)-      tuplify (Right rval) = (Nothing,Just rval)-  {-# INLINE left' #-}--instance Cat.Category (ReifiedMonadicFold m) where-  id = MonadicFold id-  l . r = MonadicFold (runMonadicFold r . runMonadicFold l)-  {-# INLINE (.) #-}--instance Arrow (ReifiedMonadicFold m) where-  arr f = MonadicFold (to f)-  {-# INLINE arr #-}-  first = first'-  {-# INLINE first #-}-  second = second'-  {-# INLINE second #-}--instance ArrowChoice (ReifiedMonadicFold m) where-  left = left'-  {-# INLINE left #-}-  right = right'-  {-# INLINE right #-}--instance ArrowApply (ReifiedMonadicFold m) where-  app = MonadicFold $ \cHandler (argFold,b) ->-     runMonadicFold (pure b >>> argFold) cHandler (argFold,b)-  {-# INLINE app #-}--instance Functor (ReifiedMonadicFold m s) where-  fmap f l = MonadicFold (runMonadicFold l.to f)-  {-# INLINE fmap #-}--instance Apply (ReifiedMonadicFold m s) where-  mf <.> ma = mf &&& ma >>> (MonadicFold $ to (uncurry ($)))-  {-# INLINE (<.>) #-}--instance Applicative (ReifiedMonadicFold m s) where-  pure a = MonadicFold $ folding $ \_ -> [a]-  {-# INLINE pure #-}-  mf <*> ma = mf <.> ma-  {-# INLINE (<*>) #-}--instance Alternative (ReifiedMonadicFold m s) where-  empty = MonadicFold ignored-  {-# INLINE empty #-}-  MonadicFold ma <|> MonadicFold mb = MonadicFold $ to (\x->(x,x)).beside ma mb-  {-# INLINE (<|>) #-}--instance Bind (ReifiedMonadicFold m s) where-  ma >>- f = ((ma >>^ f) &&& returnA) >>> app -  {-# INLINE (>>-) #-}--instance Monad (ReifiedMonadicFold m s) where-  return a = MonadicFold $ folding $ \_ -> [a]-  {-# INLINE return #-}-  ma >>= f = ((ma >>^ f) &&& returnA) >>> app -  {-# INLINE (>>=) #-}--instance MonadReader s (ReifiedMonadicFold m s) where-  ask = returnA-  {-# INLINE ask #-}-  local f ma = f ^>> ma -  {-# INLINE local #-}--instance MonadPlus (ReifiedMonadicFold m s) where-  mzero = empty-  {-# INLINE mzero #-}-  mplus = (<|>)-  {-# INLINE mplus #-}--instance Semigroup (ReifiedMonadicFold m s a) where-  (<>) = (<|>)-  {-# INLINE (<>) #-}--instance Monoid (ReifiedMonadicFold m s a) where-  mempty = MonadicFold ignored-  {-# INLINE mempty #-}-  mappend = (<|>)-  {-# INLINE mappend #-}--instance Alt (ReifiedMonadicFold m s) where-  (<!>) = (<|>)-  {-# INLINE (<!>) #-}--instance Plus (ReifiedMonadicFold m s) where-  zero = MonadicFold ignored-  {-# INLINE zero #-}  ------------------------------------------------------------------------------ -- Setter
src/Control/Lens/Setter.hs view
@@ -90,6 +90,7 @@ import Data.Profunctor import Data.Profunctor.Rep import Data.Profunctor.Unsafe+import Prelude  #ifdef HLINT {-# ANN module "HLint: ignore Avoid lambda" #-}
src/Control/Lens/TH.hs view
@@ -51,6 +51,7 @@   , simpleLenses   , createClass   , generateSignatures+  , generateUpdateableOptics   ) where  import Control.Applicative@@ -100,6 +101,14 @@ generateSignatures f r =   fmap (\x -> r { _generateSigs = x}) (f (_generateSigs r)) +-- | Generate "updateable" optics when 'True'. When 'False', 'Fold's will be+-- generated instead of 'Traversal's and 'Getter's will be generated instead+-- of 'Lens'es. This mode is intended to be used for types with invariants+-- which must be maintained by "smart" constructors.+generateUpdateableOptics :: Lens' LensRules Bool+generateUpdateableOptics f r =+  fmap (\x -> r { _allowUpdates = x}) (f (_allowUpdates r))+ -- | Create the class if the constructor is 'Control.Lens.Type.Simple' and the -- 'lensClass' rule matches. createClass :: Lens' LensRules Bool@@ -137,6 +146,7 @@   , _generateSigs    = True   , _generateClasses = False   , _allowIsos       = True+  , _allowUpdates    = True   , _classyLenses    = const Nothing   , _fieldToDef      = \_ _ n ->        case nameBase n of@@ -162,6 +172,7 @@   , _generateSigs    = True   , _generateClasses = True   , _allowIsos       = False -- generating Isos would hinder "subtyping"+  , _allowUpdates    = True   , _classyLenses    = \n ->         case nameBase n of           x:xs -> Just (mkName ("Has" ++ x:xs), mkName (toLower x:xs))@@ -667,6 +678,7 @@   , _generateSigs    = True   , _generateClasses = True  -- classes will still be skipped if they already exist   , _allowIsos       = False -- generating Isos would hinder field class reuse+  , _allowUpdates    = True   , _classyLenses    = const Nothing   , _fieldToDef      = camelCaseNamer   }
src/Control/Lens/Traversal.hs view
@@ -209,11 +209,11 @@ -- --  * a 'Traversal' if @f@ is 'Applicative', -----  * a 'Getter' if  @f@ is only 'Gettable',+--  * a 'Getter' if @f@ is only a 'Functor' and 'Contravariant', -- --  * a 'Lens' if @p@ is only a 'Functor', -----  * a 'Fold' if 'f' is 'Gettable' and 'Applicative'.+--  * a 'Fold' if @f@ is 'Functor', 'Contravariant' and 'Applicative'. type Traversing p f s t a b = Over p (BazaarT p f a b) s t a b  type Traversing1 p f s t a b = Over p (BazaarT1 p f a b) s t a b@@ -741,8 +741,6 @@ -- 'beside' :: 'Lens' s t a b                     -> 'Lens' s' t' a b                     -> 'Traversal' (s,s') (t,t') a b -- 'beside' :: 'Fold' s a                         -> 'Fold' s' a                          -> 'Fold' (s,s') a -- 'beside' :: 'Getter' s a                       -> 'Getter' s' a                        -> 'Fold' (s,s') a--- 'beside' :: 'Action' m s a                     -> 'Action' m s' a                      -> 'MonadicFold' m (s,s') a--- 'beside' :: 'MonadicFold' m s a                -> 'MonadicFold' m s' a                 -> 'MonadicFold' m (s,s') a -- @ -- -- @@@ -750,8 +748,6 @@ -- 'beside' :: 'IndexedLens' i s t a b            -> 'IndexedLens' i s' t' a b            -> 'IndexedTraversal' i (s,s') (t,t') a b -- 'beside' :: 'IndexedFold' i s a                -> 'IndexedFold' i s' a                 -> 'IndexedFold' i (s,s') a -- 'beside' :: 'IndexedGetter' i s a              -> 'IndexedGetter' i s' a               -> 'IndexedFold' i (s,s') a--- 'beside' :: 'IndexedAction' i m s a            -> 'IndexedAction' i m s' a             -> 'IndexedMonadicFold' i m (s,s') a--- 'beside' :: 'IndexedMonadicFold' i m s a       -> 'IndexedMonadicFold' i m s' a        -> 'IndexedMonadicFold' i m (s,s') a -- @ -- -- @@@ -759,8 +755,6 @@ -- 'beside' :: 'IndexPreservingLens' s t a b      -> 'IndexPreservingLens' s' t' a b      -> 'IndexPreservingTraversal' (s,s') (t,t') a b -- 'beside' :: 'IndexPreservingFold' s a          -> 'IndexPreservingFold' s' a           -> 'IndexPreservingFold' (s,s') a -- 'beside' :: 'IndexPreservingGetter' s a        -> 'IndexPreservingGetter' s' a         -> 'IndexPreservingFold' (s,s') a--- 'beside' :: 'IndexPreservingAction' m s a      -> 'IndexPreservingAction' m s' a       -> 'IndexPreservingMonadicFold' m (s,s') a--- 'beside' :: 'IndexPreservingMonadicFold' m s a -> 'IndexPreservingMonadicFold' m s' a  -> 'IndexPreservingMonadicFold' m (s,s') a -- @ -- -- >>> ("hello",["world","!!!"])^..beside id traverse@@ -1071,7 +1065,7 @@     Nothing          -> pure m   {-# INLINE traverseMax #-} --- | Traverse the /nth/ element 'elementOf' a 'Traversal', 'Lens' or+-- | Traverse the /nth/ 'elementOf' a 'Traversal', 'Lens' or -- 'Iso' if it exists. -- -- >>> [[1],[3,4]] & elementOf (traverse.traverse) 1 .~ 5@@ -1119,7 +1113,7 @@ elementsOf l p iafb s = snd $ runIndexing (l (\a -> Indexing (\i -> i `seq` (i + 1, if p i then indexed iafb i a else pure a))) s) 0 {-# INLINE elementsOf #-} --- | Traverse elements of a 'Traversable' container where their ordinal positions matches a predicate.+-- | Traverse elements of a 'Traversable' container where their ordinal positions match a predicate. -- -- @ -- 'elements' ≡ 'elementsOf' 'traverse'@@ -1165,6 +1159,12 @@ -- -- Mutatis mutandis for 'Fold'. --+-- >>> [0,1,2,3] ^? failing (ix 1) (ix 2)+-- Just 1+--+-- >>> [0,1,2,3] ^? failing (ix 42) (ix 2)+-- Just 2+-- -- @ -- 'failing' :: 'Traversal' s t a b -> 'Traversal' s t a b -> 'Traversal' s t a b -- 'failing' :: 'Prism' s t a b     -> 'Prism' s t a b     -> 'Traversal' s t a b@@ -1201,7 +1201,7 @@   where b = l sell s infixl 5 `failing` --- | Try the second traversal. If it returns no entries, try again with for all entries from the first traversal, recursively.+-- | Try the second traversal. If it returns no entries, try again with all entries from the first traversal, recursively. -- -- @ -- 'deepOf' :: 'Fold' s s          -> 'Fold' s a                   -> 'Fold' s a
src/Control/Lens/Tuple.hs view
@@ -10,9 +10,6 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-}-#ifdef TRUSTWORTHY-{-# LANGUAGE Trustworthy #-}-#endif  ------------------------------------------------------------------------------- -- |@@ -41,6 +38,7 @@ import Control.Applicative import Control.Lens.Lens import Data.Functor.Identity+import Data.Functor.Product import Data.Profunctor (dimap) import Data.Proxy (Proxy (Proxy)) import GHC.Generics (Generic (..), (:*:) (..), K1 (..), M1 (..), U1 (..))@@ -89,6 +87,9 @@ instance Field1 (Identity a) (Identity b) a b where   _1 f (Identity a) = Identity <$> f a +instance Field1 (Product f g a) (Product f' g a) (f a) (f' a) where+  _1 f (Pair a b) = flip Pair b <$> f a+ instance Field1 ((f :*: g) p) ((f' :*: g) p) (f p) (f' p) where   _1 f (l :*: r) = (:*: r) <$> f l @@ -153,6 +154,9 @@   _2 = ix proxyN1   {-# INLINE _2 #-} #endif++instance Field2 (Product f g a) (Product f g' a) (g a) (g' a) where+  _2 f (Pair a b) = Pair a <$> f b  instance Field2 ((f :*: g) p) ((f :*: g') p) (g p) (g' p) where   _2 f (l :*: r) = (l :*:) <$> f r
src/Control/Lens/Type.hs view
@@ -32,7 +32,6 @@   , Setter, Setter'   , Getter, Fold   , Fold1-  , Action, MonadicFold, RelevantMonadicFold   -- * Indexed   , IndexedLens, IndexedLens'   , IndexedTraversal, IndexedTraversal'@@ -40,8 +39,6 @@   , IndexedSetter, IndexedSetter'   , IndexedGetter, IndexedFold   , IndexedFold1-  , IndexedAction, IndexedMonadicFold-  , IndexedRelevantMonadicFold   -- * Index-Preserving   , IndexPreservingLens, IndexPreservingLens'   , IndexPreservingTraversal, IndexPreservingTraversal'@@ -49,8 +46,6 @@   , IndexPreservingSetter, IndexPreservingSetter'   , IndexPreservingGetter, IndexPreservingFold   , IndexPreservingFold1-  , IndexPreservingAction, IndexPreservingMonadicFold-  , IndexPreservingRelevantMonadicFold   -- * Common   , Simple   , LensLike, LensLike'@@ -61,18 +56,19 @@   ) where  import Control.Applicative-import Control.Lens.Internal.Action import Control.Lens.Internal.Setter import Control.Lens.Internal.Indexed import Data.Functor.Contravariant import Data.Functor.Apply import Data.Profunctor+import Prelude ()  -- $setup -- >>> :set -XNoOverloadedStrings -- >>> import Control.Lens -- >>> import Debug.SimpleReflect.Expr -- >>> import Debug.SimpleReflect.Vars as Vars hiding (f,g,h)+-- >>> import Prelude -- >>> 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@@ -485,55 +481,6 @@ type Fold1 s a = forall f. (Contravariant f, Apply f) => (a -> f a) -> s -> f s type IndexedFold1 i s a = forall p f.  (Indexable i p, Contravariant f, Apply f) => p a (f a) -> s -> f s type IndexPreservingFold1 s a = forall p f. (Conjoined p, Contravariant f, Apply f) => p a (f a) -> p s (f s)------------------------------------------------------------------------------------ Actions------------------------------------------------------------------------------------ | An 'Action' is a 'Getter' enriched with access to a 'Monad' for side-effects.------ Every 'Getter' can be used as an 'Action'.------ You can compose an 'Action' with another 'Action' using ('Prelude..') from the @Prelude@.-type Action m s a = forall f r. Effective m r f => (a -> f a) -> s -> f s---- | An 'IndexedAction' is an 'IndexedGetter' enriched with access to a 'Monad' for side-effects.------ Every 'Getter' can be used as an 'Action'.------ You can compose an 'Action' with another 'Action' using ('Prelude..') from the @Prelude@.-type IndexedAction i m s a = forall p f r. (Indexable i p, Effective m r f) => p a (f a) -> s -> f s---- | An 'IndexPreservingAction' can be used as a 'Action', but when composed with an 'IndexedTraversal',--- 'IndexedFold', or 'IndexedLens' yields an 'IndexedMonadicFold', 'IndexedMonadicFold' or 'IndexedAction' respectively.-type IndexPreservingAction m s a = forall p f r. (Conjoined p, Effective m r f) => p a (f a) -> p s (f s)------------------------------------------------------------------------------------ MonadicFolds------------------------------------------------------------------------------------ | A 'MonadicFold' is a 'Fold' enriched with access to a 'Monad' for side-effects.------ A 'MonadicFold' can use side-effects to produce parts of the structure being folded (e.g. reading them from file).------ Every 'Fold' can be used as a 'MonadicFold', that simply ignores the access to the 'Monad'.------ You can compose a 'MonadicFold' with another 'MonadicFold' using ('Prelude..') from the @Prelude@.-type MonadicFold m s a = forall f r. (Effective m r f, Applicative f) => (a -> f a) -> s -> f s-type RelevantMonadicFold m s a = forall f r. (Effective m r f, Apply f) => (a -> f a) -> s -> f s---- | An 'IndexedMonadicFold' is an 'IndexedFold' enriched with access to a 'Monad' for side-effects.------ Every 'IndexedFold' can be used as an 'IndexedMonadicFold', that simply ignores the access to the 'Monad'.------ You can compose an 'IndexedMonadicFold' with another 'IndexedMonadicFold' using ('Prelude..') from the @Prelude@.-type IndexedMonadicFold i m s a = forall p f r. (Indexable i p, Effective m r f, Applicative f) => p a (f a) -> s -> f s-type IndexedRelevantMonadicFold i m s a = forall p f r. (Indexable i p, Effective m r f, Apply f) => p a (f a) -> s -> f s---- | An 'IndexPreservingFold' can be used as a 'Fold', but when composed with an 'IndexedTraversal',--- 'IndexedFold', or 'IndexedLens' yields an 'IndexedFold' respectively.-type IndexPreservingMonadicFold m s a = forall p f r. (Conjoined p, Effective m r f, Applicative f) => p a (f a) -> p s (f s)-type IndexPreservingRelevantMonadicFold m s a = forall p f r. (Conjoined p, Effective m r f, Apply f) => p a (f a) -> p s (f s)  ------------------------------------------------------------------------------- -- Simple Overloading
src/Control/Lens/Zoom.hs view
@@ -29,7 +29,6 @@   ) where  import Control.Lens.Getter-import Control.Lens.Internal.Action import Control.Lens.Internal.Zoom import Control.Lens.Type import Control.Monad@@ -50,6 +49,7 @@ import Control.Monad.Trans.Maybe import Data.Monoid import Data.Profunctor.Unsafe+import Prelude  -- $setup -- >>> import Control.Lens
src/Control/Monad/Error/Lens.hs view
@@ -33,8 +33,9 @@ import Control.Monad import Control.Monad.Error.Class import Data.Functor.Plus-import Data.Monoid (Monoid(..), First(..))+import qualified Data.Monoid as M import Data.Semigroup (Semigroup(..))+import Prelude  ------------------------------------------------------------------------------ -- Catching@@ -50,7 +51,7 @@ -- 'catching' :: 'MonadError' e m => 'Getter' e a     -> m r -> (a -> m r) -> m r -- 'catching' :: 'MonadError' e m => 'Fold' e a       -> m r -> (a -> m r) -> m r -- @-catching :: MonadError e m => Getting (First a) e a -> m r -> (a -> m r) -> m r+catching :: MonadError e m => Getting (M.First a) e a -> m r -> (a -> m r) -> m r catching l = catchJust (preview l) {-# INLINE catching #-} @@ -67,7 +68,7 @@ -- 'catching_' :: 'MonadError' e m => 'Getter' e a     -> m r -> m r -> m r -- 'catching_' :: 'MonadError' e m => 'Fold' e a       -> m r -> m r -> m r -- @-catching_ :: MonadError e m => Getting (First a) e a -> m r -> m r -> m r+catching_ :: MonadError e m => Getting (M.First a) e a -> m r -> m r -> m r catching_ l a b = catchJust (preview l) a (const b) {-# INLINE catching_ #-} @@ -86,7 +87,7 @@ -- 'handling' :: 'MonadError' e m => 'Fold' e a       -> (a -> m r) -> m r -> m r -- 'handling' :: 'MonadError' e m => 'Getter' e a     -> (a -> m r) -> m r -> m r -- @-handling :: MonadError e m => Getting (First a) e a -> (a -> m r) -> m r -> m r+handling :: MonadError e m => Getting (M.First a) e a -> (a -> m r) -> m r -> m r handling l = flip (catching l) {-# INLINE handling #-} @@ -101,7 +102,7 @@ -- 'handling_' :: 'MonadError' e m => 'Getter' e a     -> m r -> m r -> m r -- 'handling_' :: 'MonadError' e m => 'Fold' e a       -> m r -> m r -> m r -- @-handling_ :: MonadError e m => Getting (First a) e a -> m r -> m r -> m r+handling_ :: MonadError e m => Getting (M.First a) e a -> m r -> m r -> m r handling_ l = flip (catching_ l) {-# INLINE handling_ #-} @@ -120,7 +121,7 @@ -- 'trying' :: 'MonadError' e m => 'Getter' e a     -> m r -> m ('Either' a r) -- 'trying' :: 'MonadError' e m => 'Fold' e a       -> m r -> m ('Either' a r) -- @-trying :: MonadError e m => Getting (First a) e a -> m r -> m (Either a r)+trying :: MonadError e m => Getting (M.First a) e a -> m r -> m (Either a r) trying l m = catching l (liftM Right m) (return . Left)  ------------------------------------------------------------------------------@@ -173,7 +174,7 @@   {-# INLINE fmap #-}  instance Monad m => Semigroup (Handler e m a) where-  (<>) = mappend+  (<>) = M.mappend   {-# INLINE (<>) #-}  instance Monad m => Alt (Handler e m) where@@ -186,7 +187,7 @@   zero = Handler (const Nothing) undefined   {-# INLINE zero #-} -instance Monad m => Monoid (Handler e m a) where+instance Monad m => M.Monoid (Handler e m a) where   mempty = zero   {-# INLINE mempty #-}   mappend = (<!>)
src/Data/Bits/Lens.hs view
@@ -235,8 +235,8 @@ -- If you supply this an 'Integer', the result will be an infinite 'Traversal', -- which can be productively consumed, but not reassembled. ----- Why is this function called @bytes@ to match 'bits'? Alas, there is already--- a function by that name in "Data.ByteString.Lens".+-- Why is'nt this function called @bytes@ to match 'bits'? Alas, there+-- is already a function by that name in "Data.ByteString.Lens". bytewise :: (Integral b, Bits b) => IndexedTraversal' Int b Word8 bytewise f b = Prelude.foldr step 0 <$> traverse g bs where   g n = (,) n <$> indexed f n (fromIntegral $ b `shiftR` (n*8))
src/Data/Data/Lens.hs view
@@ -64,6 +64,7 @@ import           Data.IORef import           Data.Monoid import           GHC.Exts (realWorld#)+import           Prelude  #ifdef HLINT {-# ANN module "HLint: ignore Eta reduce" #-}
src/Data/List/Split/Lens.hs view
@@ -166,12 +166,12 @@ delimiters f s@Splitter { delimiter = Delimiter ds } = f ds <&> \ds' -> s { delimiter = Delimiter ds' } {-# INLINE delimiters #-} --- | Modify or retrieve the policy for what a 'Splitter' to do with delimiters.+-- | Modify or retrieve the policy for what a 'Splitter' should do with delimiters. delimiting :: Lens' (Splitter a) DelimPolicy delimiting f s@Splitter { delimPolicy = p } = f p <&> \p' -> s { delimPolicy = p' } {-# INLINE delimiting #-} --- | Modify or retrieve the policy for what a 'Splitter' should about consecutive delimiters.+-- | Modify or retrieve the policy for what a 'Splitter' should do about consecutive delimiters. condensing :: Lens' (Splitter a) CondensePolicy condensing f s@Splitter { condensePolicy = p } = f p <&> \p' -> s { condensePolicy = p' } {-# INLINE condensing #-}
src/Data/Sequence/Lens.hs view
@@ -20,6 +20,7 @@ import Control.Lens import Data.Monoid import Data.Sequence as Seq+import Prelude  -- $setup -- >>> import Debug.SimpleReflect.Expr
src/Data/Text/Lazy/Lens.hs view
@@ -1,9 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-#ifdef TRUSTWORTHY-{-# LANGUAGE Trustworthy #-}-#endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.Text.Lazy.Lens
src/Data/Text/Lens.hs view
@@ -2,9 +2,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-}-#ifdef TRUSTWORTHY-{-# LANGUAGE Trustworthy #-}-#endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.Text.Lens
src/Data/Text/Strict/Lens.hs view
@@ -1,8 +1,5 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}-#ifdef TRUSTWORTHY-{-# LANGUAGE Trustworthy #-}-#endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.Text.Strict.Lens
src/Data/Typeable/Lens.hs view
@@ -1,8 +1,5 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-}-#ifdef TRUSTWORTHY-{-# LANGUAGE Trustworthy #-}-#endif ----------------------------------------------------------------------------- -- | -- Module      :  Data.Typeable.Lens
src/Data/Vector/Generic/Lens.hs view
@@ -28,6 +28,7 @@   , sliced   -- * Traversal of individual indices   , ordinals+  , vectorIx   ) where  import Control.Applicative@@ -114,3 +115,10 @@ ordinals is f v = fmap (v //) $ traverse (\i -> (,) i <$> indexed f i (v ! i)) $ nub $ filter (\i -> 0 <= i && i < l) is where   l = length v {-# INLINE ordinals #-}++-- | Like 'ix' but polymorphic in the vector type.+vectorIx :: V.Vector v a => Int -> Traversal' (v a) a+vectorIx i f v+  | 0 <= i && i < V.length v = f (v V.! i) <&> \a -> v V.// [(i, a)]+  | otherwise                = pure v+{-# INLINE vectorIx #-}
src/Language/Haskell/TH/Lens.hs view
@@ -280,6 +280,7 @@ #if MIN_VERSION_template_haskell(2,8,0) import Data.Word #endif+import Prelude  -- | Has a 'Name' class HasName t where
src/Numeric/Lens.hs view
@@ -34,7 +34,7 @@ -- >>> :set -XNoOverloadedStrings -- >>> import Data.Monoid (Sum(..)) --- | This 'Prism' extracts can be used to model the fact that every 'Integral'+-- | This 'Prism' can be used to model the fact that every 'Integral' -- type is a subset of 'Integer'. -- -- Embedding through the 'Prism' only succeeds if the 'Integer' would pass
src/System/FilePath/Lens.hs view
@@ -91,7 +91,7 @@ l <<</>= b = l %%= \a -> (a, a </> b) {-# INLINE (<<</>=) #-} --- | Modify the path by adding extension.+-- | Modify the path by adding an extension. -- -- >>> both <.>~ "txt" $ ("hello","world") -- ("hello.txt","world.txt")@@ -143,7 +143,13 @@ l <<.>= r = l <%= (<.> r) {-# INLINE (<<.>=) #-} -+-- | Add an extension onto the end of the target of a 'Lens' but+-- return the old value+--+-- >>> _1 <<<.>~ "txt" $ ("hello","world")+-- ("hello",("hello.txt","world"))+--+-- When you do not need the old value, ('<.>~') is more flexible. (<<<.>~) :: Optical' (->) q ((,)FilePath) s FilePath -> String -> q s (FilePath, s) l <<<.>~ b = l $ \a -> (a, a <.> b) {-# INLINE (<<<.>~) #-}
tests/templates.hs view
@@ -23,51 +23,70 @@ module Main where  import Control.Lens-import Data.List (nub) -- import Test.QuickCheck (quickCheck)  data Bar a b c = Bar { _baz :: (a, b) } makeLenses ''Bar--- baz :: Lens (Bar a b c) (Bar a' b' c) (a,b) (a',b')--- upgrades to:--- baz :: Iso (Bar a b c) (Bar a' b' c') (a, b) (a', b') +checkBaz :: Iso (Bar a b c) (Bar a' b' c') (a, b) (a', b')+checkBaz = baz+ data Quux a b = Quux { _quaffle :: Int, _quartz :: Double } makeLenses ''Quux--- quaffle :: Lens (Quux a b) (Quux a' b') Int Int--- quartz :: Lens (Quux a b) (Quux a' b') Double Double +checkQuaffle :: Lens (Quux a b) (Quux a' b') Int Int+checkQuaffle = quaffle++checkQuartz :: Lens (Quux a b) (Quux a' b') Double Double+checkQuartz = quartz+ data Quark a = Qualified   { _gaffer :: a }              | Unqualified { _gaffer :: a, _tape :: a } makeLenses ''Quark--- gaffer :: Simple Lens (Quark a) a--- tape :: Simple Traversal (Quark a) a +checkGaffer :: Lens' (Quark a) a+checkGaffer = gaffer++checkTape :: Traversal' (Quark a) a+checkTape = tape+ data Hadron a b = Science { _a1 :: a, _a2 :: a, _c :: b } makeLenses ''Hadron--- a1 :: Simple Lens (Hadron a b) a--- a2 :: Simple Lens (Hadron a b) a--- c :: Lens (Hadron a b) (Hadron a b') b b' +checkA1 :: Lens' (Hadron a b) a+checkA1 = a1++checkA2 :: Lens' (Hadron a b) a+checkA2 = a2 ++checkC :: Lens (Hadron a b) (Hadron a b') b b'+checkC = c+ data Perambulation a b   = Mountains { _terrain :: a, _altitude :: b }   | Beaches   { _terrain :: a, _dunes :: a } makeLenses ''Perambulation--- terrain :: Simple Lens (Perambulation a b) a--- altitude :: Traversal (Perambulation a b) (Parambulation a b') b b'--- dunes :: Simple Traversal (Perambulation a b) a++checkTerrain :: Lens' (Perambulation a b) a+checkTerrain = terrain++checkAltitude :: Traversal (Perambulation a b) (Perambulation a b') b b'+checkAltitude = altitude++checkDunes :: Traversal' (Perambulation a b) a+checkDunes = dunes+ makeLensesFor [("_terrain", "allTerrain"), ("_dunes", "allTerrain")] ''Perambulation--- allTerrain :: Traversal (Perambulation a b) (Perambulation a' b) a a' +checkAllTerrain :: Traversal (Perambulation a b) (Perambulation a' b) a a'+checkAllTerrain = allTerrain+ data LensCrafted a = Still { _still :: a }                    | Works { _still :: a } makeLenses ''LensCrafted--- still :: Lens (LensCrafted a) (LensCrafted b) a b -data Danger a = Zone { _highway :: a }-              | Twilight---makeLensesWith (partialLenses .~ True $ buildTraversals .~ False $ lensRules) ''Danger--- highway :: Lens (Danger a) (Danger a') a a'+checkStill :: Lens (LensCrafted a) (LensCrafted b) a b+checkStill = still  data Task a = Task   { taskOutput :: a -> IO ()@@ -77,22 +96,49 @@  makeLensesFor [("taskOutput", "outputLens"), ("taskState", "stateLens"), ("taskStop", "stopLens")] ''Task +checkOutputLens :: Lens' (Task a) (a -> IO ())+checkOutputLens = outputLens++checkStateLens :: Lens' (Task a) a+checkStateLens = stateLens++checkStopLens :: Lens' (Task a) (IO ())+checkStopLens = stopLens+ data Mono a = Mono { _monoFoo :: a, _monoBar :: Int } makeClassy ''Mono -- class HasMono t where --   mono :: Simple Lens t Mono -- instance HasMono Mono where --   mono = id--- monoFoo :: HasMono t => Simple Lens t Int--- monoBar :: HasMono t => Simple Lens t Int +checkMono :: HasMono t a => Lens' t (Mono a)+checkMono = mono++checkMono' :: Lens' (Mono a) (Mono a)+checkMono' = mono++checkMonoFoo :: HasMono t a => Lens' t a+checkMonoFoo = monoFoo++checkMonoBar :: HasMono t a => Lens' t Int+checkMonoBar = monoBar+ data Nucleosis = Nucleosis { _nuclear :: Mono Int } makeClassy ''Nucleosis -- class HasNucleosis t where --   nucleosis :: Simple Lens t Nucleosis -- instance HasNucleosis Nucleosis--- nuclear :: HasNucleosis t => Simple Lens t Mono +checkNucleosis :: HasNucleosis t => Lens' t Nucleosis+checkNucleosis = nucleosis++checkNucleosis' :: Lens' Nucleosis Nucleosis+checkNucleosis' = nucleosis++checkNuclear :: HasNucleosis t => Lens' t (Mono Int)+checkNuclear = nuclear+ instance HasMono Nucleosis Int where   mono = nuclear @@ -100,30 +146,95 @@ data Foo = Foo { _fooX, _fooY :: Int } makeClassy ''Foo +checkFoo :: HasFoo t => Lens' t Foo+checkFoo = foo +checkFoo' :: Lens' Foo Foo+checkFoo' = foo++checkFooX :: HasFoo t => Lens' t Int+checkFooX = fooX++checkFooY :: HasFoo t => Lens' t Int+checkFooY = fooY+ data Dude a = Dude     { dudeLevel        :: Int     , dudeAlias        :: String     , dudeLife         :: ()     , dudeThing        :: a     }+makeFields ''Dude++checkLevel :: HasLevel t a => Lens' t a+checkLevel = level++checkLevel' :: Lens' (Dude a) Int+checkLevel' = level++checkAlias :: HasAlias t a => Lens' t a+checkAlias = alias++checkAlias' :: Lens' (Dude a) String+checkAlias' = alias++checkLife :: HasLife t a => Lens' t a+checkLife = life++checkLife' :: Lens' (Dude a) ()+checkLife' = life++checkThing :: HasThing t a => Lens' t a+checkThing = thing++checkThing' :: Lens' (Dude a) a+checkThing' = thing+ data Lebowski a = Lebowski     { _lebowskiAlias    :: String     , _lebowskiLife     :: Int     , _lebowskiMansion  :: String     , _lebowskiThing    :: Maybe a     }+makeFields ''Lebowski++checkAlias2 :: Lens' (Lebowski a) String+checkAlias2 = alias++checkLife2 :: Lens' (Lebowski a) Int+checkLife2 = life++checkMansion :: HasMansion t a => Lens' t a+checkMansion = mansion++checkMansion' :: Lens' (Lebowski a) String+checkMansion' = mansion++checkThing2 :: Lens' (Lebowski a) (Maybe a)+checkThing2 = thing+ data AbideConfiguration a = AbideConfiguration     { _acLocation       :: String     , _acDuration       :: Int     , _acThing          :: a     }+makeLensesWith abbreviatedFields ''AbideConfiguration +checkLocation :: HasLocation t a => Lens' t a+checkLocation = location -makeFields ''Dude-makeFields ''Lebowski-makeLensesWith abbreviatedFields ''AbideConfiguration+checkLocation' :: Lens' (AbideConfiguration a) String+checkLocation' = location +checkDuration :: HasDuration t a => Lens' t a+checkDuration = duration++checkDuration' :: Lens' (AbideConfiguration a) Int+checkDuration' = duration++checkThing3 :: Lens' (AbideConfiguration a) a+checkThing3 = thing+ dudeDrink :: String dudeDrink      = (Dude 9 "El Duderino" () "white russian")      ^. thing  lebowskiCarpet :: Maybe String@@ -136,28 +247,48 @@                 | Unqualified1 { gaffer1 :: a, tape1 :: a }   |] -- data Quark1 a = Qualified1 a | Unqualified1 a a--- gaffer1 :: Lens' (Quark1 a) a--- tape1 :: Traversal (Quark1 a) (Quark1 b) a b +checkGaffer1 :: Lens' (Quark1 a) a+checkGaffer1 = gaffer1++checkTape1 :: Traversal' (Quark1 a) a+checkTape1 = tape1+ declarePrisms [d|   data Exp = Lit Int | Var String | Lambda { bound::String, body::Exp }   |] -- data Exp = Lit Int | Var String | Lambda { bound::String, body::Exp }--- _Lit :: Prism' Exp Int--- _Var :: Prism' Exp String--- _Lambda :: Prism' Exp (String, Exp) +checkLit :: Int -> Exp+checkLit = Lit++checkVar :: String -> Exp+checkVar = Var++checkLambda :: String -> Exp -> Exp+checkLambda = Lambda++check_Lit :: Prism' Exp Int+check_Lit = _Lit++check_Var :: Prism' Exp String+check_Var = _Var++check_Lambda :: Prism' Exp (String, Exp)+check_Lambda = _Lambda++ declarePrisms [d|   data Banana = Banana Int String   |] -- data Banana = Banana Int String--- _Banana :: Iso' Banana (Int, String)++check_Banana :: Iso' Banana (Int, String)+check_Banana = _Banana+ cavendish :: Banana cavendish = _Banana # (4, "Cavendish") -banana :: Iso' (Int, String) Banana-banana = from _Banana- data family Family a b c  #if __GLASGOW_HASKELL >= 706@@ -165,8 +296,12 @@   data instance Family Int (a, b) a = FamilyInt { fm0 :: (b, a), fm1 :: Int }   |] -- data instance Family Int (a, b) a = FamilyInt a b--- fm0 :: Lens (Family Int (a, b) a) (Family Int (a', b') a') (b, a) (b', a')--- fm1 :: Lens' (Family Int (a, b) a) Int+checkFm0 :: Lens (Family Int (a, b) a) (Family Int (a', b') a') (b, a) (b', a')+checkFm0 = fm0++checkFm1 :: Lens' (Family Int (a, b) a) Int+checkFm1 = fm1+ #endif  class Class a where@@ -182,37 +317,50 @@ -- instance Class Int where --   data Associated Int = AssociatedInt Double --   method = id--- mochi :: Iso' (Associated Int) Double -#if __GLASGOW_HASKELL >= 706+checkMochi :: Iso' (Associated Int) Double+checkMochi = mochi++#if __GLASGOW_HASKELL__ >= 706 declareFields [d|   data DeclaredFields f a-    = DeclaredField1 { declaredFieldsA :: f a    , declaredFieldsB :: Int }-    | DeclaredField2 { declaredFieldsC :: String , declaredFieldsB :: Int }+    = DeclaredField1 { declaredFieldsA0 :: f a    , declaredFieldsB0 :: Int }+    | DeclaredField2 { declaredFieldsC0 :: String , declaredFieldsB0 :: Int }     deriving (Show)   |] -declaredFieldsUse1 :: [Bool]-declaredFieldsUse1 = view fieldsA (DeclaredField1 [True] 0)+checkA0 :: HasA0 t a => Traversal' t a+checkA0 = a0 -declaredFieldsUse2 :: [DeclaredFields [] ()]-declaredFieldsUse2 = over (traverse.fieldsB) (+1) [DeclaredField1 [()] 0, DeclaredField2 "" 1]+checkB0 :: HasB0 t a => Lens' t a+checkB0 = b0++checkC0 :: HasC0 t a => Traversal' t a+checkC0 = c0++checkA0' :: Traversal' (DeclaredFields f a) (f a)+checkA0' = a0++checkB0' :: Lens' (DeclaredFields f a) Int+checkB0' = b0++checkC0' :: Traversal' (DeclaredFields f a) String+checkC0' = c0 #endif  data Rank2Tests   = C1 { _r2length :: forall a. [a] -> Int-       , _r2nub    :: forall a. Eq a=> [a] -> [a]+       , _r2nub    :: forall a. Eq a => [a] -> [a]        }   | C2 { _r2length :: forall a. [a] -> Int }  makeLenses ''Rank2Tests -useFold1 :: Maybe [Bool]-useFold1  = C1 length nub ^? r2nub . to ($ [False,True,True])-useFold2 :: Maybe [Bool]-useFold2  = C2 length     ^? r2nub . to ($ [False,True,True])-useLength :: Int-useLength = C1 length nub ^. r2length . to ($ [False,True,True])+checkR2length :: Getter Rank2Tests ([a] -> Int)+checkR2length = r2length++checkR2nub :: Eq a => Fold Rank2Tests ([a] -> [a])+checkR2nub = r2nub  data PureNoFields = PureNoFieldsA | PureNoFieldsB { _pureNoFields :: Int } makeLenses ''PureNoFields