packages feed

lens 4.5 → 4.6

raw patch · 10 files changed

+83/−33 lines, 10 files

Files

CHANGELOG.markdown view
@@ -1,3 +1,8 @@+4.6+---+* Reduced `Review` to two arguments, like `Getter`.+* Added `abbreviatedFields` to permit `makeFieldsWith` to be invoked with an argument that lets it act like it did pre-4.5 and accept arbitrary common prefixes.+ 4.5 --- * Provide access to the typename in `lensRules` naming function.
lens.cabal view
@@ -1,6 +1,6 @@ name:          lens category:      Data, Lenses, Generics-version:       4.5+version:       4.6 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE
src/Control/Exception/Lens.hs view
@@ -272,7 +272,7 @@ -- 'throwing' :: 'Prism'' 'SomeException' t -> t -> r -- 'throwing' :: 'Iso'' 'SomeException' t   -> t -> r -- @-throwing :: AReview s SomeException a b -> b -> r+throwing :: AReview SomeException b -> b -> r throwing l = reviews l Exception.throw {-# INLINE throwing #-} @@ -303,7 +303,7 @@ -- 'throwingM' :: 'MonadThrow' m => 'Prism'' 'SomeException' t -> t -> m r -- 'throwingM' :: 'MonadThrow' m => 'Iso'' 'SomeException' t   -> t -> m r -- @-throwingM :: MonadThrow m => AReview s SomeException a b -> b -> m r+throwingM :: MonadThrow m => AReview SomeException b -> b -> m r throwingM l = reviews l throwM {-# INLINE throwingM #-} @@ -317,7 +317,7 @@ -- 'throwingTo' :: 'ThreadId' -> 'Prism'' 'SomeException' t -> t -> m a -- 'throwingTo' :: 'ThreadId' -> 'Iso'' 'SomeException' t   -> t -> m a -- @-throwingTo :: MonadIO m => ThreadId -> AReview s SomeException a b -> b -> m ()+throwingTo :: MonadIO m => ThreadId -> AReview SomeException b -> b -> m () throwingTo tid l = reviews l (liftIO . throwTo tid) {-# INLINE throwingTo #-}
src/Control/Lens/Getter.hs view
@@ -96,7 +96,7 @@ -- Getters ------------------------------------------------------------------------------- --- | Build a 'Getter' from an arbitrary Haskell function.+-- | Build an (index-preserving) 'Getter' from an arbitrary Haskell function. -- -- @ -- 'to' f '.' 'to' g ≡ 'to' (g '.' f)@@ -117,12 +117,20 @@ -- -- >>> (0, -5)^._2.to abs -- 5-to :: (s -> a) -> IndexPreservingGetter s a-to k = dimap k coerce+--+-- @+-- 'to' :: (s -> a) -> 'IndexPreservingGetter' s a+-- @+to :: (Profunctor p, Contravariant f) => (s -> a) -> Optical' p p f s a +to k = dimap k (contramap k) {-# INLINE to #-} -ito :: (s -> (i, a)) -> IndexedGetter i s a-ito k = dimap k coerce . uncurry . indexed+-- |+-- @+-- 'ito' :: (s -> (i, a)) -> 'IndexedGetter' i s a+-- @+ito :: (Indexable i p, Contravariant f) => (s -> (i, a)) -> Optical' p (->) f s a+ito k = dimap k (contramap (snd . k)) . uncurry . indexed {-# INLINE ito #-}  -- | When you see this in a type signature it indicates that you can
src/Control/Lens/Internal/PrismTH.hs view
@@ -90,7 +90,8 @@ -- -- instance AsFooBarBaz (FooBarBaz a) a -- @--- | Generate an "As" class of prisms. Names are selected by prefixing the constructor+-- +-- Generate an "As" class of prisms. Names are selected by prefixing the constructor -- name with an underscore.  Constructors with multiple fields will -- construct Prisms to tuples of those fields. makeClassyPrisms :: Name {- ^ Type constructor name -} -> DecsQ@@ -172,8 +173,7 @@   case ty of     PrismType  | stabSimple stab -> prism'TypeName  `conAppsT` [t,b]                | otherwise       -> prismTypeName   `conAppsT` [s,t,a,b]-    ReviewType | stabSimple stab -> review'TypeName `conAppsT` [t,b]-               | otherwise       -> reviewTypeName  `conAppsT` [s,t,a,b]+    ReviewType                   -> reviewTypeName  `conAppsT` [t,b]    where   vs = map PlainTV (Set.toList (setOf typeVars cx))
src/Control/Lens/Internal/TH.hs view
@@ -127,9 +127,6 @@ reviewTypeName          :: Name reviewTypeName           = mkLensName_tc "Control.Lens.Type" "Review" -review'TypeName         :: Name-review'TypeName          = mkLensName_tc "Control.Lens.Type" "Review'"- wrappedTypeName         :: Name wrappedTypeName          = mkLensName_tc "Control.Lens.Wrapped" "Wrapped"
src/Control/Lens/Review.hs view
@@ -18,8 +18,8 @@ module Control.Lens.Review   (   -- * Reviewing-    Review, Review'-  , AReview, AReview'+    Review+  , AReview   , unto   , un   , re@@ -63,17 +63,11 @@ -- -- You can generate a 'Review' by using 'unto'. You can also use any 'Prism' or 'Iso' -- directly as a 'Review'.-type Review s t a b = forall p f. (Choice p, Bifunctor p, Settable f) => Optic p f s t a b---- | A 'Simple' 'Review'-type Review' t b = Review t t b b+type Review t b = forall p f. (Choice p, Bifunctor p, Settable f) => Optic' p f t b  -- | If you see this in a signature for a function, the function is expecting a 'Review' -- (in practice, this usually means a 'Prism').-type AReview s t a b = Optic Tagged Identity s t a b---- | A 'Simple' 'AReview'-type AReview' t b = AReview t t b b+type AReview t b = Optic' Tagged Identity t b  -- | An analogue of 'to' for 'review'. --@@ -122,7 +116,7 @@ -- 're' :: 'Prism' s t a b -> 'Getter' b t -- 're' :: 'Iso' s t a b   -> 'Getter' b t -- @-re :: AReview s t a b -> Getter b t+re :: AReview t b -> Getter b t re p = to (runIdentity #. unTagged #. p .# Tagged .# Identity) {-# INLINE re #-} @@ -154,7 +148,7 @@ -- 'review' :: 'MonadReader' a m => 'Iso'' s a   -> m s -- 'review' :: 'MonadReader' a m => 'Prism'' s a -> m s -- @-review :: MonadReader b m => AReview s t a b -> m t+review :: MonadReader b m => AReview t b -> m t review p = asks (runIdentity #. unTagged #. p .# Tagged .# Identity) {-# INLINE review #-} @@ -178,10 +172,10 @@ -- @ -- (#) :: 'Iso''      s a -> a -> s -- (#) :: 'Prism''    s a -> a -> s--- (#) :: 'Review''   s a -> a -> s+-- (#) :: 'Review'    s a -> a -> s -- (#) :: 'Equality'' s a -> a -> s -- @-( # ) :: AReview s t a b -> b -> t+( # ) :: AReview t b -> b -> t ( # ) p = runIdentity #. unTagged #. p .# Tagged .# Identity {-# INLINE ( # ) #-} @@ -214,7 +208,7 @@ -- 'reviews' :: 'MonadReader' a m => 'Iso'' s a   -> (s -> r) -> m r -- 'reviews' :: 'MonadReader' a m => 'Prism'' s a -> (s -> r) -> m r -- @-reviews :: MonadReader b m => AReview s t a b -> (t -> r) -> m r+reviews :: MonadReader b m => AReview t b -> (t -> r) -> m r reviews p tr = asks (tr . runIdentity #. unTagged #. p .# Tagged .# Identity) {-# INLINE reviews #-} @@ -235,7 +229,7 @@ -- 'reuse' :: 'MonadState' a m => 'Prism'' s a -> m s -- 'reuse' :: 'MonadState' a m => 'Iso'' s a   -> m s -- @-reuse :: MonadState b m => AReview s t a b -> m t+reuse :: MonadState b m => AReview t b -> m t reuse p = gets (runIdentity #. unTagged #. p .# Tagged .# Identity) {-# INLINE reuse #-} @@ -254,6 +248,6 @@ -- 'reuses' :: 'MonadState' a m => 'Prism'' s a -> (s -> r) -> m r -- 'reuses' :: 'MonadState' a m => 'Iso'' s a   -> (s -> r) -> m r -- @-reuses :: MonadState b m => AReview s t a b -> (t -> r) -> m r+reuses :: MonadState b m => AReview t b -> (t -> r) -> m r reuses p tr = gets (tr . runIdentity #. unTagged #. p .# Tagged .# Identity) {-# INLINE reuses #-}
src/Control/Lens/TH.hs view
@@ -39,6 +39,7 @@   , defaultFieldRules   , camelCaseFields   , underscoreFields+  , abbreviatedFields   , LensRules   , DefName(..)   , lensRules@@ -564,6 +565,10 @@ -- | Field rules for fields in the form @ prefixFieldname or _prefixFieldname @ -- If you want all fields to be lensed, then there is no reason to use an @_@ before the prefix. -- If any of the record fields leads with an @_@ then it is assume a field without an @_@ should not have a lens created.+--+-- __Note__: The @prefix@ must be the same as the typename (with the first+-- letter lowercased). This is a change from lens versions before lens 4.5.+-- If you want the old behaviour, use 'makeLensesWith' 'abbreviatedFields' camelCaseFields :: LensRules camelCaseFields = defaultFieldRules @@ -584,6 +589,36 @@   computeMethod _                  = Nothing  +-- | Field rules fields in the form @ prefixFieldname or _prefixFieldname @+-- If you want all fields to be lensed, then there is no reason to use an @_@ before the prefix.+-- If any of the record fields leads with an @_@ then it is assume a field without an @_@ should not have a lens created.+--+-- Note that @prefix@ may be any string of characters that are not uppercase+-- letters. (In particular, it may be arbitrary string of lowercase letters+-- and numbers) This is the behavior that 'defaultFieldRules' had in lens+-- 4.4 and earlier.+abbreviatedFields :: LensRules+abbreviatedFields = defaultFieldRules { _fieldToDef = abbreviatedNamer }++abbreviatedNamer :: Name -> [Name] -> Name -> [DefName]+abbreviatedNamer _ fields field = maybeToList $ do++  fieldPart <- stripMaxLc (nameBase field)+  method    <- computeMethod fieldPart+  let cls = "Has" ++ fieldPart+  return (MethodName (mkName cls) (mkName method))++  where+  stripMaxLc f = do x <- stripPrefix optUnderscore f+                    case break isUpper x of+                      (p,s) | List.null p || List.null s -> Nothing+                            | otherwise                  -> Just s+  optUnderscore  = ['_' | any (isPrefixOf "_" . nameBase) fields ]++  computeMethod (x:xs) | isUpper x = Just (toLower x : xs)+  computeMethod _                  = Nothing++ -- | Generate overloaded field accessors. -- -- /e.g/@@ -612,6 +647,8 @@ -- instance HasX Bar Char where --   x = _barXLens -- @+--+-- For details, see 'camelCaseFields'. -- -- @ -- makeFields = 'makeLensesWith' 'defaultFieldRules'
src/Control/Monad/Error/Lens.hs view
@@ -208,7 +208,7 @@ -- 'throwing' :: 'MonadError' e m => 'Prism'' e t -> t -> a -- 'throwing' :: 'MonadError' e m => 'Iso'' e t   -> t -> a -- @-throwing :: MonadError e m => AReview e e t t -> t -> m x+throwing :: MonadError e m => AReview e t -> t -> m x throwing l = reviews l throwError {-# INLINE throwing #-}
tests/templates.hs view
@@ -113,14 +113,23 @@     , _lebowskiMansion  :: String     , _lebowskiThing    :: Maybe a     }+data AbideConfiguration a = AbideConfiguration+    { _acLocation       :: String+    , _acDuration       :: Int+    , _acThing          :: a+    } + makeFields ''Dude makeFields ''Lebowski+makeLensesWith abbreviatedFields ''AbideConfiguration  dudeDrink :: String dudeDrink      = (Dude 9 "El Duderino" () "white russian")      ^. thing  lebowskiCarpet :: Maybe String lebowskiCarpet = (Lebowski "Mr. Lebowski" 0 "" (Just "carpet")) ^. thing+abideAnnoyance :: String+abideAnnoyance = (AbideConfiguration "the tree" 10 "the wind")  ^. thing  declareLenses [d|   data Quark1 a = Qualified1   { gaffer1 :: a }