packages feed

lens 4.4.0.2 → 4.5

raw patch · 13 files changed

+112/−304 lines, 13 filesdep −zlib

Dependencies removed: zlib

Files

.travis.yml view
@@ -3,7 +3,7 @@ env:   - GHCVER=7.4.2   - GHCVER=7.6.3-  - GHCVER=7.8.2+  - GHCVER=7.8.3   - GHCVER=head   # - >   #   GHCVER=7.4.2@@ -37,7 +37,7 @@    # Update happy when building with GHC head   - |-    if [ $GHCVER = "head" ] || [ $GHCVER = "7.8.2" ]; then+    if [ $GHCVER = "head" ] || [ $GHCVER = "7.8.3" ]; then       $CABAL install happy alex       export PATH=$HOME/.cabal/bin:$PATH     fi
CHANGELOG.markdown view
@@ -1,3 +1,12 @@+4.5+---+* Provide access to the typename in `lensRules` naming function.+* `makeFields` camelcasing rules now properly support types with camelcasing. `MyType` with field `myTypeFieldA` generates `fieldA` now. Previously the prefix ignore capitalization and the field would need to be named `mytypeFieldA`.+* `makeClassy` works on types even when none of the fields would generate optics.+* Added `Monad`, `MonadReader`, `MonadPlus` and `Bind` instances for `ReifiedMonadicFold`+* Added missing fixity declarations on many operators.+* Migrated `Codec.Compression.Zlib.Lens` to `zlib-lens` package.+ 4.4.0.2 --- * `text` 1.2.0.0 support
lens.cabal view
@@ -1,6 +1,6 @@ name:          lens category:      Data, Lenses, Generics-version:       4.4.0.2+version:       4.5 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE@@ -209,11 +209,9 @@     transformers-compat       >= 0.3      && < 1,     unordered-containers      >= 0.2      && < 0.3,     vector                    >= 0.9      && < 0.11,-    void                      >= 0.5      && < 1,-    zlib                      >= 0.5.4    && < 0.6+    void                      >= 0.5      && < 1    exposed-modules:-    Codec.Compression.Zlib.Lens     Control.Exception.Lens     Control.Lens     Control.Lens.Action@@ -334,15 +332,11 @@   type: exitcode-stdio-1.0   main-is: templates.hs   build-depends: base, lens-  ghc-options: -Wall -threaded+  ghc-options: -Wall -Werror -threaded   hs-source-dirs: tests    if flag(dump-splices)     ghc-options: -ddump-splices--  if impl(ghc<7.6.1)-    ghc-options: -Werror-  -- Verify the properties of lenses with QuickCheck test-suite properties
− src/Codec/Compression/Zlib/Lens.hs 
@@ -1,231 +0,0 @@-{-# LANGUAGE Rank2Types #-}--------------------------------------------------------------------------------- |--- Module      :  Codec.Compression.Zlib.Lens--- Copyright   :  (C) 2012-14 Edward Kmett--- License     :  BSD-style (see the file LICENSE)--- Maintainer  :  Edward Kmett <ekmett@gmail.com>--- Stability   :  provisional--- Portability :  portable------ @lens@ support for the @zlib@ library------------------------------------------------------------------------------module Codec.Compression.Zlib.Lens-  ( -- * High-Level API-    gzipped,-    zlibbed,-    deflated,-    compressed,-    Format,-    gzip,-    zlib,-    deflate,-    -- * Low-Level API-    zlibbed',-    gzipped',-    deflated',-    compressed',-    Params,-    defaultParams,-    levelC,-    methodC,-    windowBitsC,-    windowBitsD,-    memoryLevelC,-    strategyC,-    bufferSizeC,-    bufferSizeD,-    dictionary,-    CompressionLevel,-    defaultCompression,-    noCompression,-    bestSpeed,-    bestCompression,-    compressionLevel,-    Method,-    deflateMethod,-    WindowBits,-    defaultWindowBits,-    windowBits,-    MemoryLevel,-    defaultMemoryLevel,-    minMemoryLevel,-    maxMemoryLevel,-    memoryLevel,-    CompressionStrategy,-    defaultStrategy,-    filteredStrategy,-    huffmanOnlyStrategy-  ) where--import Control.Applicative-import Codec.Compression.Zlib.Internal-import Control.Lens-import qualified Data.ByteString      as S (ByteString)-import qualified Data.ByteString.Lazy as L (ByteString)---- |--- The 'zlib' compression format.-zlib :: Format-zlib = zlibFormat-{-# INLINE zlib #-}---- |--- The 'gzip' compression format.-gzip :: Format-gzip = gzipFormat-{-# INLINE gzip #-}---- |--- The 'deflate' compression format.-deflate :: Format-deflate = rawFormat-{-# INLINE deflate #-}---- |--- Compresses a 'L.ByteString' using the 'gzip' compression format.------ @--- 'gzipped' = 'compressed' 'gzip'--- 'gzipped' = 'gzipped'' 'defaultParams'--- @-gzipped :: Iso' L.ByteString L.ByteString-gzipped = compressed gzip-{-# INLINE gzipped #-}---- |--- Compresses a 'L.ByteString' using the 'zlib' compression format.------ @--- 'zlibbed' = 'compressed' 'zlib'--- 'zlibbed' = 'zlibbed\'' 'defaultParams'--- @-zlibbed :: Iso' L.ByteString L.ByteString-zlibbed = compressed zlib-{-# INLINE zlibbed #-}---- |--- Compresses a 'L.ByteString' using the 'deflate' compression format.------ @--- 'deflated' = 'compressed' 'deflate'--- 'deflated' = 'deflated'' 'defaultParams'--- @-deflated :: Iso' L.ByteString L.ByteString-deflated = compressed deflate-{-# INLINE deflated #-}---- |--- Compresses a 'L.ByteString' using the given compression format.------ @--- 'compressed' fmt = 'compressed'' fmt 'defaultParams'--- @-compressed :: Format -> Iso' L.ByteString L.ByteString-compressed fmt = compressed' fmt defaultParams-{-# INLINE compressed #-}---- |--- Compresses a 'L.ByteString' using the 'gzip' compression format and the given advanced parameters.------ @--- 'gzipped' = 'compressed' 'gzip'--- 'gzipped' = 'gzipped'' 'defaultParams'--- @-gzipped' :: Params -> Iso' L.ByteString L.ByteString-gzipped' = compressed' gzip-{-# INLINE gzipped' #-}---- |--- Compresses a 'L.ByteString' using the 'zlib' compression format and the given advanced parameters.------ @--- 'zlibbed' = 'compressed' 'zlib'--- 'zlibbed' = 'zlibbed'' 'defaultParams'--- @-zlibbed' :: Params -> Iso' L.ByteString L.ByteString-zlibbed' = compressed' zlib-{-# INLINE zlibbed' #-}---- |--- Compresses a 'L.ByteString' using the 'deflate' compression format and the given advanced parameters.------ @--- 'deflated' = 'compressed' 'deflate'--- 'deflated' = 'deflated'' 'defaultParams'--- @-deflated' :: Params -> Iso' L.ByteString L.ByteString-deflated' = compressed' deflate-{-# INLINE deflated' #-}---- |--- Compresses a 'L.ByteString' using the given compression format and the given advanced parameters.-compressed' :: Format -> Params -> Iso' L.ByteString L.ByteString-compressed' fmt (Params c d) = iso (compress fmt c) (decompress fmt d)-{-# INLINE compressed' #-}---- |--- The advanced parameters needed by 'gzipped'', 'zlibbed'', 'deflated'', and 'compressed''.------ Use 'defaultParams' and the provided 'Lens'es to construct custom 'Params'.-data Params = Params !CompressParams !DecompressParams---- |--- The default advanced parameters for compression and decompression.-defaultParams :: Params-defaultParams = Params defaultCompressParams defaultDecompressParams-{-# INLINE defaultParams #-}---- |--- The compression level.-levelC :: Lens' Params CompressionLevel-levelC = \ f (Params c d) -> (\l -> Params (c {compressLevel = l}) d) <$> f (compressLevel c)-{-# INLINE levelC #-}---- |--- The compression method.-methodC :: Lens' Params Method-methodC = \ f (Params c d) -> (\m -> Params (c {compressMethod = m}) d) <$> f (compressMethod c)-{-# INLINE methodC #-}---- |--- The number of bits in the compression window.-windowBitsC :: Lens' Params WindowBits-windowBitsC = \ f (Params c d) -> (\wb -> Params (c {compressWindowBits = wb}) d) <$> f (compressWindowBits c)-{-# INLINE windowBitsC #-}---- |--- The number of bits in the decompression window.-windowBitsD :: Lens' Params WindowBits-windowBitsD = \ f (Params c d) -> (\wb -> Params c (d {decompressWindowBits = wb})) <$> f (decompressWindowBits d)-{-# INLINE windowBitsD #-}---- |--- The amount of memory allowed for the internal compression state.-memoryLevelC :: Lens' Params MemoryLevel-memoryLevelC = \ f (Params c d) -> (\ml -> Params (c {compressMemoryLevel = ml}) d) <$> f (compressMemoryLevel c)-{-# INLINE memoryLevelC #-}---- |--- The compression strategy.-strategyC :: Lens' Params CompressionStrategy-strategyC = \ f (Params c d) -> (\s -> Params (c {compressStrategy = s}) d) <$> f (compressStrategy c)-{-# INLINE strategyC #-}---- |--- The initial buffer size during compression.-bufferSizeC :: Lens' Params Int-bufferSizeC = \ f (Params c d) -> (\bs -> Params (c {compressBufferSize = bs}) d) <$> f (compressBufferSize c)-{-# INLINE bufferSizeC #-}---- |--- The initial buffer size during decompression.-bufferSizeD :: Lens' Params Int-bufferSizeD = \ f (Params c d) -> (\bs -> Params c (d {decompressBufferSize = bs})) <$> f (decompressBufferSize d)-{-# INLINE bufferSizeD #-}---- |--- 'Just' the custom (de)compression dictionary to use, or 'Nothing' to not use a custom dictionary.-dictionary :: Lens' Params (Maybe S.ByteString)-dictionary = \f (Params c d) -> (\mbs -> Params (c {compressDictionary = mbs}) (d {decompressDictionary = mbs})) <$> f (compressDictionary c <|> decompressDictionary d)-{-# INLINE dictionary #-}
src/Control/Lens.hs view
@@ -14,20 +14,24 @@ -- -- @ -- import Control.Lens--- data Foo a = Foo { _fooArgs :: ['String'], _fooValue :: a }--- 'makeLenses' ''Foo+-- +-- data FooBar a+--   = Foo { _x :: ['Int'], _y :: a }+--   | Bar { _x :: ['Int'] }+-- 'makeLenses' ''FooBar -- @ -- -- This defines the following lenses: -- -- @--- fooArgs :: 'Lens'' (Foo a) ['String']--- fooValue :: 'Lens' (Foo a) (Foo b) a b+-- x :: 'Lens'' (FooBar a) ['Int']+-- y :: 'Traversal' (FooBar a) (FooBar b) a b -- @ ----- You can then access the value with ('^.') and set the value of the field--- with ('.~') and can use almost any other combinator that is re-exported--- here on those fields.+-- You can then access the value of @_x@ with ('^.'), the value of @_y@ –+-- with ('^?') or ('^?!') (since it can fail), set the values with ('.~'),+-- modify them with ('%~'), and use almost any other combinator that is+-- re-exported here on those fields. -- -- The combinators here have unusually specific type signatures, so for -- particularly tricky ones, the simpler type signatures you might want to
src/Control/Lens/Each.hs view
@@ -32,7 +32,6 @@  import Control.Applicative import Control.Lens.Iso-import Control.Lens.Type import Control.Lens.Traversal import Data.Array.Unboxed as Unboxed import Data.Array.IArray as IArray@@ -80,7 +79,7 @@ class Each s t a b | s -> a, t -> b, s b -> t, t a -> s where   each :: Traversal s t a b #ifndef HLINT-  default each :: (Applicative f, Traversable g, s ~ g a, t ~ g b) => LensLike f s t a b+  default each :: (Traversable g, s ~ g a, t ~ g b) => Traversal s t a b   each = traverse   {-# INLINE each #-} #endif
src/Control/Lens/Internal/Deque.hs view
@@ -6,6 +6,10 @@ #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif+#ifndef MIN_VERSION_base+#define MIN_VERSION_base(x,y,z) 1+#endif+ ----------------------------------------------------------------------------- -- | -- Module      :  Control.Lens.Internal.Deque@@ -33,7 +37,12 @@ import Control.Lens.Lens import Control.Lens.Prism import Control.Monad+#if MIN_VERSION_base(4,8,0)+import Data.Foldable hiding (null)+import qualified Data.Foldable as Foldable+#else import Data.Foldable as Foldable+#endif import Data.Function import Data.Functor.Bind import Data.Functor.Plus
src/Control/Lens/Internal/FieldTH.hs view
@@ -86,7 +86,7 @@      let defs = Map.toList perDef      case _classyLenses rules tyName of        Just (className, methodName) ->-         makeClassyDriver rules className methodName defs+         makeClassyDriver rules className methodName s defs        Nothing -> do decss  <- traverse (makeFieldOptic rules) defs                      return (concat decss) @@ -98,7 +98,7 @@    -- Map a (possibly missing) field's name to zero-to-many optic definitions   expandName :: [Name] -> Maybe Name -> [DefName]-  expandName allFields = concatMap (_fieldToDef rules allFields) . maybeToList+  expandName allFields = concatMap (_fieldToDef rules tyName allFields) . maybeToList  -- | Normalized the Con type into a uniform positional representation, -- eliminating the variance between records, infix constructors, and normal@@ -268,25 +268,27 @@   LensRules ->   Name ->   Name ->+  Type {- ^ Outer 's' type -} ->   [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))] ->   DecsQ-makeClassyDriver rules className methodName defs = sequenceA (cls ++ inst)+makeClassyDriver rules className methodName s defs = sequenceA (cls ++ inst)    where-  cls | _generateClasses rules = [makeClassyClass className methodName defs]+  cls | _generateClasses rules = [makeClassyClass className methodName s defs]       | otherwise = [] -  inst = [makeClassyInstance rules className methodName defs]+  inst = [makeClassyInstance rules className methodName s defs]   makeClassyClass ::   Name ->   Name ->+  Type {- ^ Outer 's' type -} ->   [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))] ->   DecQ-makeClassyClass className methodName defs = do+makeClassyClass className methodName s defs = do   let ss   = map (stabToS . view (_2 . _2)) defs-  (sub,s') <- unifyTypes ss+  (sub,s') <- unifyTypes (s : ss)   c <- newName "c"   let vars = toListOf typeVars s'       fd   | null vars = []@@ -309,9 +311,10 @@   LensRules ->   Name ->   Name ->+  Type {- ^ Outer 's' type -} ->   [(DefName, (OpticType, OpticStab, [(Name, Int, [Int])]))] ->   DecQ-makeClassyInstance rules className methodName defs = do+makeClassyInstance rules className methodName s defs = do   methodss <- traverse (makeFieldOptic rules') defs    instanceD (cxt[]) (return instanceHead)@@ -320,7 +323,6 @@    where   instanceHead = className `conAppsT` (s : map VarT vars)-  s            = stabToS (view (_2 . _2) (head defs))   vars         = toListOf typeVars s   rules'       = rules { _generateSigs    = False                        , _generateClasses = False@@ -367,11 +369,6 @@ -- given a constructor name and the number of fields on that -- constructor. makePureClause :: Name -> Int -> ClauseQ--makePureClause conName 0 =-  -- clause: _ _ = pure Con-  clause [wildP, wildP] (normalB (appE (varE pureValName) (conE conName))) []- makePureClause conName fieldCount =   do xs <- replicateM fieldCount (newName "x")      -- clause: _ (Con x1..xn) = pure (Con x1..xn)@@ -523,7 +520,8 @@   , _generateSigs :: Bool   , _generateClasses :: Bool   , _allowIsos    :: Bool-  , _fieldToDef   :: [Name] -> Name -> [DefName]+  , _fieldToDef   :: Name -> [Name] -> Name -> [DefName]+       -- ^ Type Name -> Field Names -> Target Field Name -> Definition Names   , _classyLenses :: Name -> Maybe (Name,Name)        -- type name to class name and top method   }
src/Control/Lens/Lens.hs view
@@ -154,7 +154,9 @@  infixl 8 ^# infixr 4 %%@~, <%@~, <<%@~, %%~, <+~, <*~, <-~, <//~, <^~, <^^~, <**~, <&&~, <||~, <<>~, <%~, <<%~, <<.~, <#~, #~, #%~, <#%~, #%%~+       , <<+~, <<-~, <<*~, <<//~, <<^~, <<^^~, <<**~, <<||~, <<&&~, <<<>~ infix  4 %%@=, <%@=, <<%@=, %%=, <+=, <*=, <-=, <//=, <^=, <^^=, <**=, <&&=, <||=, <<>=, <%=, <<%=, <<.=, <#=, #=, #%=, <#%=, #%%=+       , <<+=, <<-=, <<*=, <<//=, <<^=, <<^^=, <<**=, <<||=, <<&&=, <<<>= infixr 2 <<~ infixl 1 &, <&>, ??, &~
src/Control/Lens/Reified.hs view
@@ -534,6 +534,28 @@   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 (<>) #-}
src/Control/Lens/TH.hs view
@@ -67,7 +67,7 @@ import Control.Lens.Internal.TH import Control.Lens.Internal.FieldTH import Control.Lens.Internal.PrismTH-import Data.Char (toLower, toUpper, isUpper)+import Data.Char (toLower, isUpper) import Data.Foldable hiding (concat, any) import Data.List as List import Data.Map as Map hiding (toList,map,filter)@@ -112,7 +112,13 @@ -- provides the names of all fields in the type as well as the current field. -- This extra generality enables field naming conventions that depend on the -- full set of names in a type.-lensField :: Lens' LensRules ([Name] -> Name -> [DefName])+--+-- The field naming rule has access to the type name, the names of all the field+-- of that type (including the field being named), and the name of the field+-- being named.+--+-- TypeName -> FieldNames -> FieldName -> DefinitionNames+lensField :: Lens' LensRules (Name -> [Name] -> Name -> [DefName]) lensField f r = fmap (\x -> r { _fieldToDef = x}) (f (_fieldToDef r))  -- | Retrieve options such as the name of the class and method to put in it to@@ -131,7 +137,7 @@   , _generateClasses = False   , _allowIsos       = True   , _classyLenses    = const Nothing-  , _fieldToDef      = \_ n ->+  , _fieldToDef      = \_ _ n ->        case nameBase n of          '_':x:xs -> [TopName (mkName (toLower x:xs))]          _        -> []@@ -144,8 +150,8 @@   LensRules lensRulesFor fields = lensRules & lensField .~ mkNameLookup fields -mkNameLookup :: [(String,String)] -> [Name] -> Name -> [DefName]-mkNameLookup kvs _ field =+mkNameLookup :: [(String,String)] -> Name -> [Name] -> Name -> [DefName]+mkNameLookup kvs _ _ field =   [ TopName (mkName v) | (k,v) <- kvs, k == nameBase field]  -- | Rules for making lenses and traversals that precompose another 'Lens'.@@ -159,7 +165,7 @@         case nameBase n of           x:xs -> Just (mkName ("Has" ++ x:xs), mkName (toLower x:xs))           []   -> Nothing-  , _fieldToDef      = \_ n ->+  , _fieldToDef      = \_ _ n ->         case nameBase n of           '_':x:xs -> [TopName (mkName (toLower x:xs))]           _        -> []@@ -178,7 +184,7 @@  classyRules_ :: LensRules classyRules_-  = classyRules & lensField .~ \_ n -> [TopName (mkName ('_':nameBase n))]+  = classyRules & lensField .~ \_ _ n -> [TopName (mkName ('_':nameBase n))]  -- | Build lenses (and traversals) with a sensible default configuration. --@@ -300,14 +306,14 @@ declareLenses   = declareLensesWith   $ lensRules-  & lensField .~ \_ n -> [TopName n]+  & lensField .~ \_ _ n -> [TopName n]  -- | Similar to 'makeLensesFor', but takes a declaration quote. declareLensesFor :: [(String, String)] -> DecsQ -> DecsQ declareLensesFor fields   = declareLensesWith   $ lensRulesFor fields-  & lensField .~ \_ n -> [TopName n]+  & lensField .~ \_ _ n -> [TopName n]  -- | For each record in the declaration quote, make lenses and traversals for -- it, and create a class when the type has no arguments. All record syntax@@ -335,7 +341,7 @@ declareClassy   = declareLensesWith   $ classyRules-  & lensField .~ \_ n -> [TopName n]+  & lensField .~ \_ _ n -> [TopName n]  -- | Similar to 'makeClassyFor', but takes a declaration quote. declareClassyFor ::@@ -343,7 +349,7 @@ declareClassyFor classes fields   = declareLensesWith   $ classyRulesFor (`Prelude.lookup`classes) fields-  & lensField .~ \_ n -> [TopName n]+  & lensField .~ \_ _ n -> [TopName n]  -- | Generate a 'Prism' for each constructor of each data type. --@@ -375,7 +381,7 @@   forM_ maybeDecs emit   return dec --- | @ declareFields = 'declareFieldsWith' 'defaultFieldRules' @+-- | @ declareFields = 'declareLensesWith' 'defaultFieldRules' @ declareFields :: DecsQ -> DecsQ declareFields = declareLensesWith defaultFieldRules @@ -542,8 +548,8 @@ underscoreFields :: LensRules underscoreFields = defaultFieldRules & lensField .~ underscoreNamer -underscoreNamer :: [Name] -> Name -> [DefName]-underscoreNamer _ field = maybeToList $ do+underscoreNamer :: Name -> [Name] -> Name -> [DefName]+underscoreNamer _ _ field = maybeToList $ do   _      <- prefix field'   method <- niceLens   cls    <- classNaming@@ -561,31 +567,21 @@ camelCaseFields :: LensRules camelCaseFields = defaultFieldRules -camelCaseNamer :: [Name] -> Name -> [DefName]-camelCaseNamer fields field = maybeToList $ do-  _      <- prefix-  method <- niceLens-  cls    <- classNaming+camelCaseNamer :: Name -> [Name] -> Name -> [DefName]+camelCaseNamer tyName fields field = maybeToList $ do++  fieldPart <- stripPrefix expectedPrefix (nameBase field)+  method    <- computeMethod fieldPart+  let cls = "Has" ++ fieldPart   return (MethodName (mkName cls) (mkName method))-  where-    field'  = nameBase field-    fields' = map nameBase fields-    sepUpper x = case break isUpper x of-        (p, s) | List.null p || List.null s -> Nothing-               | otherwise                  -> Just (p,s) -    prefix = fmap fst . sepUpper =<< dealWith_+  where+  expectedPrefix = optUnderscore ++ overHead toLower (nameBase tyName) -    niceLens    = overHead toLower . snd <$> sepUpper field'-    classNaming = niceLens <&> \ (n:ns) -> "Has" ++ toUpper n : ns+  optUnderscore  = ['_' | any (isPrefixOf "_" . nameBase) fields ] -    dealWith_ :: Maybe String-    dealWith_ | not $ any (fst . leading_) fields' = Just field'-              | otherwise = if leading then Just trailing else Nothing-      where-        leading_ ('_':xs) = (True, xs)-        leading_      xs  = (False, xs)-        (leading, trailing) = leading_ field'+  computeMethod (x:xs) | isUpper x = Just (toLower x : xs)+  computeMethod _                  = Nothing   -- | Generate overloaded field accessors.@@ -602,6 +598,8 @@ -- will create -- -- @+-- _fooXLens :: Lens' (Foo a) Int+-- _fooYLens :: Lens (Foo a) (Foo b) a b -- class HasX s a | s -> a where --   x :: Lens' s a -- instance HasX (Foo a) Int where@@ -610,6 +608,7 @@ --   y :: Lens' s a -- instance HasY (Foo a) a where --   y = _fooYLens+-- _barXLens :: Iso' Bar Char -- instance HasX Bar Char where --   x = _barXLens -- @
src/Generics/Deriving/Lens.hs view
@@ -76,9 +76,9 @@   tinplated :: Typeable b => Maybe TypeRep -> Traversal' (f a) b  instance (Generic a, GTraversal (Generic.Rep a), Typeable a) => GTraversal (K1 i a) where-  tinplated rec f (K1 a) = case cast a `maybeArg1Of` f of+  tinplated prev f (K1 a) = case cast a `maybeArg1Of` f of     Just b  -> K1 . fromJust . cast <$> f b-    Nothing -> case rec of+    Nothing -> case prev of                  Just rep | rep == typeOf a -> pure (K1 a)                  _ -> K1 <$> fmap generic (tinplated (Just (typeOf a))) f a   {-# INLINE tinplated #-}@@ -101,5 +101,5 @@   {-# INLINE tinplated #-}  instance GTraversal a => GTraversal (M1 i c a) where-  tinplated rec f (M1 x) = M1 <$> tinplated rec f x+  tinplated prev f (M1 x) = M1 <$> tinplated prev f x   {-# INLINE tinplated #-}
tests/templates.hs view
@@ -205,5 +205,8 @@ useLength :: Int useLength = C1 length nub ^. r2length . to ($ [False,True,True]) +data PureNoFields = PureNoFieldsA | PureNoFieldsB { _pureNoFields :: Int }+makeLenses ''PureNoFields+ main :: IO () main = putStrLn "test/templates.hs: ok"