packages feed

lens 5.3.3 → 5.3.4

raw patch · 14 files changed

+156/−44 lines, 14 filesdep ~containers

Dependency ranges changed: containers

Files

CHANGELOG.markdown view
@@ -1,3 +1,13 @@+5.3.4 [2025.03.03]+------------------+* Reduce the arity of `foldr1Of`, `foldl1Of`, `foldrOf'`, `foldlOf'`,+  `foldr1Of'`, `foldl1Of'`, `foldrMOf`, and `foldlMOf` so that GHC is more+  eager to inline them. On a simple benchmark involving `sumOf` (defined in+  terms of `foldlOf'`), this improves performance by 8x.+* Add `Ixed`, `Cons`, `Each`, `AsEmpty`, `Reversing`, and `Rewrapped` instances+  for strict boxed vectors when building with `vector-0.13.2` or later.+* Add an `AsEmpty` instance for primitive `Vector`s.+ 5.3.3 [2024.12.28] ------------------ * Add `makeFieldsId`, which generates overloaded field accessors using the
benchmarks/folds.hs view
@@ -31,6 +31,10 @@       [ bench "native"     $ nf (V.toList . V.indexed) v       , bench "itraversed" $ nf (itoListOf itraversed) v       ]+    , bgroup "sum"+      [ bench "native" $ whnf V.sum v+      , bench "each"   $ whnf (sumOf each) v+      ]     ]   , bgroup "unboxed-vector"     [ bgroup "toList"@@ -41,6 +45,10 @@       [ bench "native"     $ nf (U.toList . U.indexed) u       , bench "vTraverse" $ nf (itoListOf vectorTraverse) u       ]+    , bgroup "sum"+      [ bench "native" $ whnf U.sum u+      , bench "each"   $ whnf (sumOf each) u+      ]     ]   , bgroup "sequence"     [ bgroup "toList"@@ -71,6 +79,10 @@     , bgroup "itoList"       [ bench "native"     $ nf (zip [(0::Int)..]) l       , bench "itraversed" $ nf (itoListOf itraversed) l+      ]+    , bgroup "sum"+      [ bench "native" $ whnf sum l+      , bench "each"   $ whnf (sumOf each) l       ]     ]   , bgroup "map"
cabal.project view
@@ -1,17 +1,3 @@ packages: .           ./examples           ./lens-properties---- TODO: Remove this once the ecosystem has caught up with GHC 9.12-allow-newer:-  aeson:ghc-prim,-  aeson:template-haskell,-  binary-orphans:base,-  boring:base,-  indexed-traversable:base,-  indexed-traversable-instances:base,-  integer-conversion:base,-  microstache:base,-  semialign:base,-  these:base,-  uuid-types:template-haskell
examples/lens-examples.cabal view
@@ -26,7 +26,7 @@              , GHC == 9.2.8              , GHC == 9.4.8              , GHC == 9.6.6-             , GHC == 9.8.2+             , GHC == 9.8.4              , GHC == 9.10.1              , GHC == 9.12.1 @@ -58,11 +58,11 @@    build-depends:     base       >= 4.5   && < 5,-    containers >= 0.4   && < 0.8,+    containers >= 0.4   && < 0.9,     gloss      >= 1.12  && < 1.14,     lens,     mtl        >= 2.0.1 && < 2.4,-    random     >= 1.0   && < 1.3,+    random     >= 1.0   && < 1.4,     streams    >= 3.3   && < 4   main-is: Pong.hs   default-language: Haskell2010
lens-properties/lens-properties.cabal view
@@ -23,7 +23,7 @@              , GHC == 9.2.8              , GHC == 9.4.8              , GHC == 9.6.6-             , GHC == 9.8.2+             , GHC == 9.8.4              , GHC == 9.10.1              , GHC == 9.12.1
lens.cabal view
@@ -1,6 +1,6 @@ name:          lens category:      Data, Lenses, Generics-version:       5.3.3+version:       5.3.4 license:       BSD2 cabal-version: 1.18 license-file:  LICENSE@@ -22,7 +22,7 @@              , GHC == 9.2.8              , GHC == 9.4.8              , GHC == 9.6.6-             , GHC == 9.8.2+             , GHC == 9.8.4              , GHC == 9.10.1              , GHC == 9.12.1 synopsis:      Lenses, Folds and Traversals@@ -183,7 +183,7 @@     bytestring                    >= 0.10.4.0 && < 0.13,     call-stack                    >= 0.1      && < 0.5,     comonad                       >= 5.0.7    && < 6,-    containers                    >= 0.5.5.1  && < 0.8,+    containers                    >= 0.5.5.1  && < 0.9,     contravariant                 >= 1.4      && < 2,     distributive                  >= 0.5.1    && < 1,     exceptions                    >= 0.8.2.1  && < 1,
src/Control/Exception/Lens.hs view
@@ -166,11 +166,17 @@   , Bool(..)   ) --- $setup--- >>> :set -XNoOverloadedStrings--- >>> import Control.Lens--- >>> import Control.Applicative--- >>> :m + Control.Exception Control.Monad Data.List Prelude+{-+$setup+>>> :set -XNoOverloadedStrings+>>> :set -XScopedTypeVariables+>>> import Control.Lens+>>> import Control.Applicative+>>> :m + Control.Exception Control.Monad Data.List Prelude+#if MIN_VERSION_base(4,20,0)+>>> :m + Control.Exception.Context+#endif+-}  ------------------------------------------------------------------------------ -- Exceptions as Prisms@@ -674,19 +680,20 @@   -- @   __AssertionFailed :: Prism' t AssertionFailed -  -- | This t'Exception' contains provides information about what assertion failed in the 'String'.-  ---  -- @-  -- '_AssertionFailed' :: 'Prism'' 'AssertionFailed' 'String'-  -- '_AssertionFailed' :: 'Prism'' 'SomeException'   'String'-  -- @+  {- | This t'Exception' contains provides information about what assertion failed in the 'String'. -  {--  TODO: This doctest is temporarily disabled, as it does not work properly on-  GHC 9.12. See https://gitlab.haskell.org/ghc/ghc/-/issues/25610.+  @+  '_AssertionFailed' :: 'Prism'' 'AssertionFailed' 'String'+  '_AssertionFailed' :: 'Prism'' 'SomeException'   'String'+  @ +#if MIN_VERSION_base(4,20,0)+  >>> handling exception (\ (ExceptionWithContext ctxt (_ :: AssertionFailed)) -> "caught" <$ guard ("<interactive>" `isInfixOf` displayExceptionContext ctxt) ) $ assert False (return "uncaught")+  "caught"+#else   -- >>> handling _AssertionFailed (\ xs -> "caught" <$ guard ("<interactive>" `isInfixOf` xs) ) $ assert False (return "uncaught")   -- "caught"+#endif   -}   _AssertionFailed :: Prism' t String   _AssertionFailed = __AssertionFailed._AssertionFailed
src/Control/Lens/At.hs view
@@ -85,6 +85,9 @@ import qualified Data.Vector.Storable as Storable import qualified Data.Vector.Unboxed as Unboxed import Data.Vector.Unboxed (Unbox)+#if MIN_VERSION_vector(0,13,2)+import qualified Data.Vector.Strict as VectorStrict+#endif import Data.Word import Foreign.Storable (Storable) @@ -113,6 +116,9 @@ type instance Index (Prim.Vector a) = Int type instance Index (Storable.Vector a) = Int type instance Index (Unboxed.Vector a) = Int+#if MIN_VERSION_vector(0,13,2)+type instance Index (VectorStrict.Vector a) = Int+#endif type instance Index (Complex a) = Int type instance Index (Identity a) = () type instance Index (Maybe a) = ()@@ -395,6 +401,15 @@     | 0 <= i && i < Unboxed.length v = f (v Unboxed.! i) <&> \a -> v Unboxed.// [(i, a)]     | otherwise                      = pure v   {-# INLINE ix #-}++#if MIN_VERSION_vector(0,13,2)+type instance IxValue (VectorStrict.Vector a) = a+instance Ixed (VectorStrict.Vector a) where+  ix i f v+    | 0 <= i && i < VectorStrict.length v = f (v VectorStrict.! i) <&> \a -> v VectorStrict.// [(i, a)]+    | otherwise                           = pure v+  {-# INLINE ix #-}+#endif  type instance IxValue StrictT.Text = Char instance Ixed StrictT.Text where
src/Control/Lens/Cons.hs view
@@ -64,6 +64,9 @@ import qualified Data.Vector.Primitive as Prim import           Data.Vector.Unboxed (Unbox) import qualified Data.Vector.Unboxed as Unbox+#if MIN_VERSION_vector(0,13,2)+import qualified Data.Vector.Strict as VectorStrict+#endif import           Data.Word import           Control.Applicative (ZipList(..)) import           Control.Monad.State.Class as State@@ -179,6 +182,15 @@     then Left Unbox.empty     else Right (Unbox.unsafeHead v, Unbox.unsafeTail v)   {-# INLINE _Cons #-}++#if MIN_VERSION_vector(0,13,2)+instance Cons (VectorStrict.Vector a) (VectorStrict.Vector b) a b where+  _Cons = prism (uncurry VectorStrict.cons) $ \v ->+    if VectorStrict.null v+    then Left VectorStrict.empty+    else Right (VectorStrict.unsafeHead v, VectorStrict.unsafeTail v)+  {-# INLINE _Cons #-}+#endif  -- | 'cons' an element onto a container. --
src/Control/Lens/Each.hs view
@@ -54,6 +54,9 @@ import qualified Data.Vector.Storable as Storable import Data.Vector.Storable (Storable) import qualified Data.Vector.Unboxed as Unboxed+#if MIN_VERSION_vector(0,13,2)+import qualified Data.Vector.Strict as VectorStrict+#endif import Data.Vector.Unboxed (Unbox) import Data.Word import qualified Data.Strict as S@@ -194,6 +197,13 @@ instance (Unbox a, Unbox b) => Each (Unboxed.Vector a) (Unboxed.Vector b) a b where   each = vectorTraverse   {-# INLINE each #-}++#if MIN_VERSION_vector(0,13,2)+-- | @'each' :: 'Traversal' ('Vector.Vector' a) ('Vector.Vector' b) a b@+instance Each (VectorStrict.Vector a) (VectorStrict.Vector b) a b where+  each = vectorTraverse+  {-# INLINE each #-}+#endif  -- | @'each' :: 'Traversal' 'StrictT.Text' 'StrictT.Text' 'Char' 'Char'@ instance (a ~ Char, b ~ Char) => Each StrictT.Text StrictT.Text a b where
src/Control/Lens/Empty.hs view
@@ -53,6 +53,10 @@ import qualified Data.Vector.Unboxed as Unboxed import Data.Vector.Unboxed (Unbox) import qualified Data.Vector.Storable as Storable+import qualified Data.Vector.Primitive as Prim+#if MIN_VERSION_vector(0,13,2)+import qualified Data.Vector.Strict as VectorStrict+#endif import Foreign.Storable (Storable)  #if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS)@@ -161,9 +165,19 @@   _Empty = nearly Unboxed.empty Unboxed.null   {-# INLINE _Empty #-} +instance Prim.Prim a => AsEmpty (Prim.Vector a) where+  _Empty = nearly Prim.empty Prim.null+  {-# INLINE _Empty #-}+ instance Storable a => AsEmpty (Storable.Vector a) where   _Empty = nearly Storable.empty Storable.null   {-# INLINE _Empty #-}++#if MIN_VERSION_vector(0,13,2)+instance AsEmpty (VectorStrict.Vector a) where+  _Empty = nearly VectorStrict.empty VectorStrict.null+  {-# INLINE _Empty #-}+#endif  instance AsEmpty (Seq.Seq a) where   _Empty = nearly Seq.empty Seq.null
src/Control/Lens/Fold.hs view
@@ -1754,8 +1754,9 @@ -- 'foldr1Of' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a -- @ foldr1Of :: HasCallStack => Getting (Endo (Maybe a)) s a -> (a -> a -> a) -> s -> a-foldr1Of l f xs = fromMaybe (error "foldr1Of: empty structure")-                            (foldrOf l mf Nothing xs) where+-- See: NOTE: [Inlining and arity]+foldr1Of l f = fromMaybe (error "foldr1Of: empty structure")+             . foldrOf l mf Nothing where   mf x my = Just $ case my of     Nothing -> x     Just y -> f x y@@ -1780,7 +1781,8 @@ -- 'foldl1Of' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a -- @ foldl1Of :: HasCallStack => Getting (Dual (Endo (Maybe a))) s a -> (a -> a -> a) -> s -> a-foldl1Of l f xs = fromMaybe (error "foldl1Of: empty structure") (foldlOf l mf Nothing xs) where+-- See: NOTE: [Inlining and arity]+foldl1Of l f = fromMaybe (error "foldl1Of: empty structure") . foldlOf l mf Nothing where   mf mx y = Just $ case mx of     Nothing -> y     Just x  -> f x y@@ -1800,7 +1802,8 @@ -- 'foldrOf'' :: 'Traversal'' s a -> (a -> r -> r) -> r -> s -> r -- @ foldrOf' :: Getting (Dual (Endo (Endo r))) s a -> (a -> r -> r) -> r -> s -> r-foldrOf' l f z0 xs = foldlOf l f' (Endo id) xs `appEndo` z0+-- See: NOTE: [Inlining and arity]+foldrOf' l f z0 = \xs -> foldlOf l f' (Endo id) xs `appEndo` z0   where f' (Endo k) x = Endo $ \ z -> k $! f x z {-# INLINE foldrOf' #-} @@ -1818,7 +1821,8 @@ -- 'foldlOf'' :: 'Traversal'' s a -> (r -> a -> r) -> r -> s -> r -- @ foldlOf' :: Getting (Endo (Endo r)) s a -> (r -> a -> r) -> r -> s -> r-foldlOf' l f z0 xs = foldrOf l f' (Endo id) xs `appEndo` z0+-- See: NOTE: [Inlining and arity]+foldlOf' l f z0 = \xs -> foldrOf l f' (Endo id) xs `appEndo` z0   where f' x (Endo k) = Endo $ \z -> k $! f z x {-# INLINE foldlOf' #-} @@ -1838,7 +1842,8 @@ -- 'foldr1Of'' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a -- @ foldr1Of' :: HasCallStack => Getting (Dual (Endo (Endo (Maybe a)))) s a -> (a -> a -> a) -> s -> a-foldr1Of' l f xs = fromMaybe (error "foldr1Of': empty structure") (foldrOf' l mf Nothing xs) where+-- See: NOTE: [Inlining and arity]+foldr1Of' l f = fromMaybe (error "foldr1Of': empty structure") . foldrOf' l mf Nothing where   mf x Nothing = Just $! x   mf x (Just y) = Just $! f x y {-# INLINE foldr1Of' #-}@@ -1859,7 +1864,8 @@ -- 'foldl1Of'' :: 'Traversal'' s a -> (a -> a -> a) -> s -> a -- @ foldl1Of' :: HasCallStack => Getting (Endo (Endo (Maybe a))) s a -> (a -> a -> a) -> s -> a-foldl1Of' l f xs = fromMaybe (error "foldl1Of': empty structure") (foldlOf' l mf Nothing xs) where+-- See: NOTE: [Inlining and arity]+foldl1Of' l f = fromMaybe (error "foldl1Of': empty structure") . foldlOf' l mf Nothing where   mf Nothing y = Just $! y   mf (Just x) y = Just $! f x y {-# INLINE foldl1Of' #-}@@ -1881,7 +1887,8 @@ foldrMOf :: Monad m          => Getting (Dual (Endo (r -> m r))) s a          -> (a -> r -> m r) -> r -> s -> m r-foldrMOf l f z0 xs = foldlOf l f' return xs z0+-- See: NOTE: [Inlining and arity]+foldrMOf l f z0 = \xs -> foldlOf l f' return xs z0   where f' k x z = f x z >>= k {-# INLINE foldrMOf #-} @@ -1902,9 +1909,25 @@ foldlMOf :: Monad m          => Getting (Endo (r -> m r)) s a          -> (r -> a -> m r) -> r -> s -> m r-foldlMOf l f z0 xs = foldrOf l f' return xs z0+-- See: NOTE: [Inlining and arity]+foldlMOf l f z0 = \xs -> foldrOf l f' return xs z0   where f' x k z = f z x >>= k {-# INLINE foldlMOf #-}++-- NOTE: [Inlining and arity]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- GHC uses the following inlining heuristic: a function body is inlined if+-- all its arguments on the LHS are applied. So the following two definitions+-- are not equivalent from the inliner's PoV:+--+-- > foldlOf' l f z0 xs = ...+-- > foldlOf' l f z0 = \xs -> ...+--+-- GHC will be less eager to inline the first one and this results in+-- worse code. For example, a simple list summation using `sumOf` will be 8x slower+-- with the first version.+  -- | Check to see if this 'Fold' or 'Traversal' matches 1 or more entries. --
src/Control/Lens/Internal/Iso.hs view
@@ -33,6 +33,9 @@ import qualified Data.Vector.Storable  as Storable import qualified Data.Vector.Unboxed   as Unbox import Data.Vector.Unboxed (Unbox)+#if MIN_VERSION_vector(0,13,2)+import qualified Data.Vector.Strict as VectorStrict+#endif import qualified Data.Sequence         as Seq import Data.Sequence (Seq) import Foreign.Storable (Storable)@@ -100,3 +103,8 @@  instance Storable a => Reversing (Storable.Vector a) where   reversing = Storable.reverse++#if MIN_VERSION_vector(0,13,2)+instance Reversing (VectorStrict.Vector a) where+  reversing = VectorStrict.reverse+#endif
src/Control/Lens/Wrapped.hs view
@@ -150,6 +150,9 @@ import           Data.Set (Set) import           Data.Tagged import qualified Data.Vector as Vector+#if MIN_VERSION_vector(0,13,2)+import qualified Data.Vector.Strict as VectorStrict+#endif import qualified Data.Vector.Primitive as Prim import           Data.Vector.Primitive (Prim) import qualified Data.Vector.Unboxed as Unboxed@@ -676,6 +679,14 @@   _Wrapped' = iso Storable.toList Storable.fromList   {-# INLINE _Wrapped' #-} +#if MIN_VERSION_vector(0,13,2)+instance (t ~ Vector.Vector a') => Rewrapped (VectorStrict.Vector a) t+instance Wrapped (VectorStrict.Vector a) where+  type Unwrapped (VectorStrict.Vector a) = [a]+  _Wrapped' = iso VectorStrict.toList VectorStrict.fromList+  {-# INLINE _Wrapped' #-}+#endif+ -- * semigroupoids  instance (t ~ WrappedApplicative f' a') => Rewrapped (WrappedApplicative f a) t@@ -873,7 +884,11 @@ #endif  getErrorCall :: ErrorCall -> String+#if MIN_VERSION_base(4,21,0)+getErrorCall (ErrorCall x) = x+#else getErrorCall (ErrorCallWithLocation x _) = x+#endif {-# INLINE getErrorCall #-}  getRecUpdError :: RecUpdError -> String