lens 4.2 → 4.3

raw patch · 13 files changed

+88/−126 lines, 13 filesdep ~aesondep ~basedep ~transformers-compat

Dependency ranges changed: aeson, base, transformers-compat

Files

• CHANGELOG.markdown +9/−0
• lens.cabal +3/−3
• src/Control/Lens/Fold.hs +2/−2
• src/Control/Lens/Internal/Zoom.hs +1/−0
• src/Control/Lens/Iso.hs +3/−3
• src/Control/Lens/Prism.hs +42/−21
• src/Control/Lens/TH.hs +9/−81
• src/Control/Lens/Type.hs +1/−1
• src/Control/Lens/Wrapped.hs +1/−1
• src/Control/Monad/Error/Lens.hs +2/−1
• src/Data/Aeson/Lens.hs +2/−2
• src/Numeric/Lens.hs +13/−1
• tests/templates.hs +0/−10

@@ -1,3 +1,12 @@+4.3+---+* Switched the "direction" of the `Iso` argument to `au` to match the order generated by `makePrisms` and `makeLenses`.+* Removed `makeIsos` in favor of `makePrisms` and `makeLenses`. Each of these functions will construct `Iso`s when appropriate.+* Removed `declareIsos` in favor of `declarePrisms` and `declareLenses`. Each of these functions will construct `Iso`s when appropriate.+* Added `matching` for type-changing matches with `Prism`s.+* Added `withPrism` for recovering the functions passed to `prism`.+* Added `negated`, the isomorphism for the `negate` function.+ 4.2 --- * Added `_Text` isomorphisms to make the proper use with `(#)` more obvious and fit newer convention.

@@ -1,6 +1,6 @@ name:          lens category:      Data, Lenses, Generics-version:       4.2+version:       4.3 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE@@ -181,7 +181,7 @@  library   build-depends:-    aeson                     >= 0.7      && < 0.8,+    aeson                     >= 0.7.0.5  && < 0.8,     attoparsec                >= 0.10     && < 0.13,     array                     >= 0.3.0.2  && < 0.6,     base                      >= 4.3      && < 5,@@ -209,7 +209,7 @@     template-haskell          >= 2.4      && < 2.11,     text                      >= 0.11     && < 1.2,     transformers              >= 0.2      && < 0.5,-    transformers-compat       >= 0.1      && < 1,+    transformers-compat       >= 0.3      && < 1,     unordered-containers      >= 0.2      && < 0.3,     vector                    >= 0.9      && < 0.11,     void                      >= 0.5      && < 1,

@@ -702,9 +702,9 @@ -- @ -- 'Data.Foldable.product' ≡ 'productOf' 'folded' -- @-+-- -- This operation may be more strict than you would expect. If you--- want a lazier version use @'ala' 'Sum' '.' 'foldMapOf'@+-- want a lazier version use @'ala' 'Product' '.' 'foldMapOf'@ -- -- @ -- 'productOf' :: 'Num' a => 'Getter' s a     -> s -> a

@@ -6,6 +6,7 @@ #ifdef TRUSTWORTHY {-# LANGUAGE Trustworthy #-} #endif+ {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-} ----------------------------------------------------------------------------- -- |

@@ -160,10 +160,10 @@ -- -- This version is generalized to accept any 'Iso', not just a @newtype@. ----- >>> au (_Unwrapping Sum) foldMap [1,2,3,4]+-- >>> au (_Wrapping Sum) foldMap [1,2,3,4] -- 10-au :: AnIso s t a b -> ((s -> a) -> e -> b) -> e -> t-au k = withIso k $ \ sa bt f e -> bt (f sa e)+au :: AnIso s t a b -> ((b -> t) -> e -> s) -> e -> a+au k = withIso k $ \ sa bt f e -> sa (f bt e) {-# INLINE au #-}  -- | Based on @ala'@ from Conor McBride's work on Epigram.

@@ -23,12 +23,14 @@   , prism   , prism'   -- * Consuming Prisms+  , withPrism   , clonePrism   , outside   , aside   , without   , below   , isn't+  , matching   -- * Common Prisms   , _Left   , _Right@@ -85,21 +87,21 @@ type APrism' s a = APrism s s a a  -- | Convert 'APrism' to the pair of functions that characterize it.-runPrism :: APrism s t a b -> Market a b s t+withPrism :: APrism s t a b -> ((b -> t) -> (s -> Either t a) -> r) -> r #ifdef SAFE-runPrism k = case k (Market Identity Right) of-  Market bt seta -> Market (runIdentity #. bt) (either (Left . runIdentity) Right . seta)+withPrism k f = case k (Market Identity Right) of+  Market bt seta -> f (runIdentity #. bt) (either (Left . runIdentity) Right . seta) #else-runPrism k = unsafeCoerce (k (Market Identity Right))+withPrism k f = case unsafeCoerce (k (Market Identity Right)) of+  Market bt seta -> f bt seta #endif-{-# INLINE runPrism #-}+{-# INLINE withPrism #-}  -- | Clone a 'Prism' so that you can reuse the same monomorphically typed 'Prism' for different purposes. -- -- See 'Control.Lens.Lens.cloneLens' and 'Control.Lens.Traversal.cloneTraversal' for examples of why you might want to do this. clonePrism :: APrism s t a b -> Prism s t a b-clonePrism k = case runPrism k of-  Market bt seta -> prism bt seta+clonePrism k = withPrism k prism {-# INLINE clonePrism #-}  ------------------------------------------------------------------------------@@ -126,8 +128,8 @@  -- TODO: can we make this work with merely Strong? outside :: Representable p => APrism s t a b -> Lens (p t r) (p s r) (p b r) (p a r)-outside k = case runPrism k of-  Market bt seta -> \f ft -> f (lmap bt ft) <&> \fa -> tabulate $ either (rep ft) (rep fa) . seta+outside k = withPrism k $ \bt seta f ft ->+  f (lmap bt ft) <&> \fa -> tabulate $ either (rep ft) (rep fa) . seta {-# INLINE outside #-}  -- | Given a pair of prisms, project sums.@@ -136,26 +138,32 @@ without :: APrism s t a b         -> APrism u v c d         -> Prism (Either s u) (Either t v) (Either a c) (Either b d)-without k = case runPrism k of-  Market bt seta -> \ k' -> case runPrism k' of-    Market dv uevc -> prism (bimap bt dv) $ \su -> case su of-      Left s  -> bimap Left Left (seta s)-      Right u -> bimap Right Right (uevc u)+without k =+  withPrism k         $ \bt seta k' ->+  withPrism k'        $ \dv uevc    ->+  prism (bimap bt dv) $ \su ->+  case su of+    Left s  -> bimap Left Left (seta s)+    Right u -> bimap Right Right (uevc u) {-# INLINE without #-}  -- | Use a 'Prism' to work over part of a structure. -- aside :: APrism s t a b -> Prism (e, s) (e, t) (e, a) (e, b)-aside k = case runPrism k of-  Market bt seta -> prism (fmap bt) $ \(e,s) -> case seta s of+aside k =+  withPrism k     $ \bt seta ->+  prism (fmap bt) $ \(e,s) ->+  case seta s of     Left t  -> Left  (e,t)     Right a -> Right (e,a) {-# INLINE aside #-}  -- | 'lift' a 'Prism' through a 'Traversable' functor, giving a Prism that matches only if all the elements of the container match the 'Prism'. below :: Traversable f => APrism' s a -> Prism' (f s) (f a)-below k = case runPrism k of-  Market bt seta -> prism (fmap bt) $ \s -> case traverse seta s of+below k =+  withPrism k     $ \bt seta ->+  prism (fmap bt) $ \s ->+  case traverse seta s of     Left _  -> Left s     Right t -> Right t {-# INLINE below #-}@@ -171,11 +179,24 @@ -- >>> isn't _Empty [] -- False isn't :: APrism s t a b -> s -> Bool-isn't k s = case runPrism k of-  Market _ seta -> case seta s of-    Left _ -> True+isn't k s =+  case matching k s of+    Left  _ -> True     Right _ -> False {-# INLINE isn't #-}++-- | Retrieve the value targeted by a 'Prism' or return the+-- original value while allowing the type to change if it does+-- not match.+--+-- >>> matching _Just (Just 12)+-- Right 12+--+-- >>> matching _Just (Nothing :: Maybe Int) :: Either (Maybe Bool) Int+-- Left Nothing+matching :: APrism s t a b -> s -> Either t a+matching k = withPrism k $ \_ seta -> seta+{-# INLINE matching #-}  ------------------------------------------------------------------------------ -- Common Prisms

@@ -24,14 +24,12 @@   -- * Constructing Lenses Automatically     makeLenses, makeLensesFor   , makeClassy, makeClassyFor, makeClassy_-  , makeIso   , makePrisms   , makeWrapped   , makeFields   -- * Constructing Lenses Given a Declaration Quote   , declareLenses, declareLensesFor   , declareClassy, declareClassyFor-  , declareIso   , declarePrisms   , declareWrapped   , declareFields@@ -49,7 +47,6 @@   , lensRules   , classyRules   , classyRules_-  , isoRules   , lensIso   , lensField   , lensClass@@ -60,7 +57,6 @@   , buildTraversals   , handleSingletons   , singletonIso-  , backwardIso   , singletonRequired   , createClass   , createInstance@@ -117,7 +113,6 @@   | BuildTraversals   | SingletonAndField   | SingletonIso-  | BackwardIso   | HandleSingletons   | SingletonRequired   | CreateClass@@ -156,10 +151,6 @@ singletonIso      :: Lens' LensRules Bool singletonIso       = lensFlags.contains SingletonIso --- | When generating an 'Iso' put the field type as the "outer" type.-backwardIso      :: Lens' LensRules Bool-backwardIso       = lensFlags.contains BackwardIso- -- | Expect a single constructor, single field newtype or data type. singletonRequired :: Lens' LensRules Bool singletonRequired  = lensFlags.contains SingletonRequired@@ -282,14 +273,6 @@     classy n@(a:as) = Just ("Has" ++ n, toLower a:as)     classy _ = Nothing --- | Rules for making an isomorphism from a data type.-isoRules :: LensRules-isoRules = defaultRules-  & handleSingletons  .~ True-  & singletonRequired .~ True-  & singletonAndField .~ True-  & backwardIso       .~ True- -- | Build lenses (and traversals) with a sensible default configuration. -- -- /e.g./@@ -355,30 +338,6 @@ makeClassy_ :: Name -> Q [Dec] makeClassy_ = makeLensesWith classyRules_ --- | Make a top level isomorphism injecting /into/ the type.------ The supplied name is required to be for a type with a single constructor--- that has a single argument.------ /e.g./------ @--- newtype 'List' a = 'List' [a]--- 'makeIso' ''List--- @------ will create------ @--- 'list' :: 'Iso' [a] [b] ('List' a) ('List' b)--- @------ @--- 'makeIso' = 'makeLensesWith' 'isoRules'--- @-makeIso :: Name -> Q [Dec]-makeIso = makeLensesWith isoRules- -- | Derive lenses and traversals, specifying explicit pairings -- of @(fieldName, lensName)@. --@@ -500,35 +459,6 @@ declareClassyFor classes fields = declareLensesWith $   classyRulesFor (`Prelude.lookup`classes) fields & lensField .~ Just --- | For each datatype declaration, make a top level isomorphism injecting--- /into/ the type. The types are required to be for a type with a single--- constructor that has a single argument.------ All record syntax in the input will be stripped off.------ /e.g./------ @--- declareIso [d|---   newtype WrappedInt = Wrap { unwrap :: 'Int' }---   newtype 'List' a = 'List' [a]---   |]--- @------ will create------ @--- newtype WrappedList = Wrap 'Int'--- newtype List a = List [a]--- 'wrap' :: 'Iso'' Int WrappedInt--- 'unwrap' :: 'Iso'' WrappedInt Int--- 'list' :: 'Iso' [a] [b] ('List' a) ('List' b)--- @------ @ declareIso = 'declareLensesWith' ('isoRules' '&' 'lensField' '.~' 'Just') @-declareIso :: Q [Dec] -> Q [Dec]-declareIso = declareLensesWith $ isoRules & lensField .~ Just- -- | Generate a 'Prism' for each constructor of each data type. -- -- /e.g./@@ -605,8 +535,11 @@   _                        ->     fail "makePrismsForCons: A single-constructor data type is required"   where-  rules = isoRules & lensIso     .~ (Just . ('_':))-                   & backwardIso .~ False+  rules = defaultRules+        & handleSingletons  .~ True+        & singletonRequired .~ True+        & singletonAndField .~ True+        & lensIso     .~ (Just . ('_':))  makePrismsForCons dataDecl =   concat <$> mapM (makePrismOrReviewForCon dataDecl canModifyTypeVar ) (constructors dataDecl)@@ -854,18 +787,13 @@       makeBody | lensOnly  = makeLensBody                | otherwise = makeIsoBody   isoDecls <- flip (maybe (return [])) maybeIsoName $ \isoName -> do-    let backward = cfg^.backwardIso     let decl = SigD isoName $ quantified $-          case (cfg^.simpleLenses || Map.null m, backward) of-            (True , False) -> isoCon' `apps` [sty,aty]-            (False, False) -> isoCon  `apps` [sty,tty,aty,bty]-            (True , True ) -> isoCon' `apps` [aty,sty]-            (False, True ) -> isoCon  `apps` [aty,bty,sty,tty]+          if cfg^.simpleLenses || Map.null m+            then isoCon' `apps` [sty,aty]+            else isoCon  `apps` [sty,tty,aty,bty]     (ns, f) <- makeIsoFrom aty dataConName     t <- makeIsoTo ns dataConName-    body <- if backward-             then makeBody isoName f t-             else makeBody isoName t f+    body <- makeBody isoName t f #ifndef INLINING     return $ if cfg^.generateSignatures then [decl, body] else [body] #else

@@ -346,7 +346,7 @@ -- 'Control.Lens.Fold.preview' l ('Control.Lens.Prism.review' l b) ≡ 'Just' b -- @ ----- Second, if you can extract a value @a@ using a 'Prism' @l@ from a value @s@, then the value @s@ is completely described my @l@ and @a@:+-- Second, if you can extract a value @a@ using a 'Prism' @l@ from a value @s@, then the value @s@ is completely described by @l@ and @a@: -- -- If @'Control.Lens.Fold.preview' l s ≡ 'Just' a@ then @'Control.Lens.Prism.review' l a ≡ s@ --

@@ -656,7 +656,7 @@ -- >>> ala Product foldMap [1,2,3,4] -- 24 ala :: Rewrapping s t => (Unwrapped s -> s) -> ((Unwrapped t -> t) -> e -> s) -> e -> Unwrapped s-ala = au . _Unwrapping+ala = au . _Wrapping {-# INLINE ala #-}  -- | This combinator is based on @ala'@ from Conor McBride's work on Epigram.

@@ -30,7 +30,8 @@ import Control.Applicative import Control.Lens import Control.Lens.Internal.Exception-import Control.Monad.Error+import Control.Monad+import Control.Monad.Error.Class import Data.Functor.Plus import Data.Monoid import Data.Semigroup (Semigroup(..))

@@ -237,7 +237,7 @@ -- Just (String "xyz") -- -- >>> "{\"a\": {}, \"b\": null}" ^? key "a" . nonNull--- Just (Object fromList [])+-- Just (Object (fromList [])) -- -- >>> "{\"a\": \"xyz\", \"b\": null}" ^? key "b" . nonNull -- Nothing@@ -257,7 +257,7 @@    -- |   -- >>> "{\"a\": {}, \"b\": null}" ^? key "a" . _Object-  -- Just fromList []+  -- Just (fromList [])   --   -- >>> "{\"a\": {}, \"b\": null}" ^? key "b" . _Object   -- Nothing

@@ -22,6 +22,7 @@   , multiplying   , dividing   , exponentiating+  , negated   ) where  import Control.Lens@@ -161,8 +162,19 @@ -- -- Note: This errors for n = 0 ----- >>> au (exponentiating 2._Unwrapping Sum) (foldMapOf each) (3,4) == 5+-- >>> au (_Wrapping Sum . from (exponentiating 2)) (foldMapOf each) (3,4) == 5 -- True exponentiating :: (Floating a, Eq a) => a -> Iso' a a exponentiating 0 = error "Numeric.Lens.exponentiating: exponent 0" exponentiating n = iso (**n) (**recip n)+++-- | @'negated' = 'iso' 'negate' 'negate'@+--+-- >>> au (_Wrapping Sum . negated) (foldMapOf each) (3,4) == 7+-- True+--+-- >>> au (_Wrapping Sum) (foldMapOf (each.negated)) (3,4) == -7+-- True+negated :: Num a => Iso' a a+negated = iso negate negate

@@ -130,16 +130,6 @@ -- gaffer1 :: Lens' (Quark1 a) a -- tape1 :: Traversal (Quark1 a) (Quark1 b) a b -declareIso [d|-  newtype WrappedInt = Wrap { unwrap :: Int }-  data New = New Int-  |]--- newtype WrappedInt = Wrap Int--- data New = New Int--- wrap :: Iso' Int WrappedInt--- unwrap :: Iso' WrappedInt Int--- new :: Iso' Int New- declarePrisms [d|   data Exp = Lit Int | Var String | Lambda { bound::String, body::Exp }   |]