Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-foldl for openSUSE:Factory checked in at 2024-09-06 17:18:48 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-foldl (Old) and /work/SRC/openSUSE:Factory/.ghc-foldl.new.10096 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-foldl" Fri Sep 6 17:18:48 2024 rev:29 rq:1199090 version:1.4.17 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-foldl/ghc-foldl.changes 2024-03-20 21:16:02.517745088 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-foldl.new.10096/ghc-foldl.changes 2024-09-06 17:19:13.537588177 +0200 @@ -1,0 +2,15 @@ +Thu Aug 29 16:00:20 UTC 2024 - Peter Simons <[email protected]> + +- Update foldl to version 1.4.17. + Upstream has edited the change log file since the last release in + a non-trivial way, i.e. they did more than just add a new entry + at the top. You can review the file at: + http://hackage.haskell.org/package/foldl-1.4.17/src/CHANGELOG.md + +------------------------------------------------------------------- +Wed Aug 21 03:35:03 UTC 2024 - Peter Simons <[email protected]> + +- Update foldl to version 1.4.16 revision 1. + Upstream has revised the Cabal build instructions on Hackage. + +------------------------------------------------------------------- Old: ---- foldl-1.4.16.tar.gz New: ---- foldl-1.4.17.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-foldl.spec ++++++ --- /var/tmp/diff_new_pack.hGDTpX/_old 2024-09-06 17:19:14.065610116 +0200 +++ /var/tmp/diff_new_pack.hGDTpX/_new 2024-09-06 17:19:14.065610116 +0200 @@ -20,7 +20,7 @@ %global pkgver %{pkg_name}-%{version} %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.4.16 +Version: 1.4.17 Release: 0 Summary: Composable, streaming, and efficient left folds License: BSD-3-Clause ++++++ foldl-1.4.16.tar.gz -> foldl-1.4.17.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foldl-1.4.16/CHANGELOG.md new/foldl-1.4.17/CHANGELOG.md --- old/foldl-1.4.16/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 +++ new/foldl-1.4.17/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,6 +1,11 @@ +1.4.17 + +- Add [Fold1 utilities](): `purely`, `purely_`, `premap`, `handles`, `foldOver`, `folded1` +- Add pattern synonym `Fold1_` that makes the initial, step and extraction functions explicit. + 1.4.16 -- Add [`Control.Foldl.postmapM`] +- Add [`Control.Foldl.postmapM`](https://github.com/Gabriella439/foldl/pull/205) 1.4.15 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foldl-1.4.16/bench/Foldl.hs new/foldl-1.4.17/bench/Foldl.hs --- old/foldl-1.4.16/bench/Foldl.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/foldl-1.4.17/bench/Foldl.hs 2001-09-09 03:46:40.000000000 +0200 @@ -3,11 +3,16 @@ module Main (main) where import Control.Foldl hiding (map) +import qualified Control.Foldl.NonEmpty as Foldl1 import Criterion.Main import qualified Data.List import Prelude hiding (length, sum) import qualified Prelude import qualified Data.Foldable as Foldable +import Data.Functor.Contravariant (Contravariant(..)) +import Data.Profunctor (Profunctor(..)) +import Data.List.NonEmpty (NonEmpty(..)) +import qualified Data.List.NonEmpty as NonEmpty main :: IO () main = defaultMain @@ -50,9 +55,27 @@ nf sumAndLength_foldl ] ] + , env (return $ 1 :| [2..10000 :: Int]) $ \ns -> + bgroup "1 :| [2..10000 :: Int]" + [ bgroup "handles" $ map ($ ns) + [ bench "fold (handles (to succ) list)" . + nf (fold (handles (to succ) list)) + , bench "foldM (handlesM (to succ) (generalize list))" . + nfIO . foldM (handlesM (to succ) (generalize list)) + , bench "NonEmpty.map succ" . + nf (NonEmpty.map succ) + , bench "Foldl1.fold1 (Foldl1.handles (to succ) (Foldl1.fromFold list))" . + nf (Foldl1.fold1 (Foldl1.handles (to succ) (Foldl1.fromFold list))) + ] + ] ] +-- local definition to avoid importing Control.Lens.Getter.to +to :: (Profunctor p, Contravariant f) => (s -> a) -> p a (f a) -> p s (f s) +to k = dimap k (contramap k) +{-# INLINE to #-} + sumAndLength :: Num a => [a] -> (a, Int) sumAndLength xs = (Prelude.sum xs, Prelude.length xs) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foldl-1.4.16/foldl.cabal new/foldl-1.4.17/foldl.cabal --- old/foldl-1.4.16/foldl.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/foldl-1.4.17/foldl.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,5 @@ Name: foldl -Version: 1.4.16 +Version: 1.4.17 Cabal-Version: >=1.10 Build-Type: Simple License: BSD3 @@ -33,7 +33,7 @@ vector >= 0.7 && < 0.14, containers >= 0.5.0.0 && < 0.8 , unordered-containers < 0.3 , - hashable < 1.5 , + hashable < 1.6 , contravariant < 1.6 , profunctors >= 4.3.2 && < 5.7 , semigroupoids >= 1.0 && < 6.1 , @@ -62,7 +62,8 @@ Build-Depends: base, criterion, - foldl + foldl, + profunctors GHC-Options: -O2 -Wall -rtsopts -with-rtsopts=-T Default-Language: Haskell2010 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foldl-1.4.16/src/Control/Foldl/NonEmpty.hs new/foldl-1.4.17/src/Control/Foldl/NonEmpty.hs --- old/foldl-1.4.16/src/Control/Foldl/NonEmpty.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/foldl-1.4.17/src/Control/Foldl/NonEmpty.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,3 +1,9 @@ +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE CPP #-} + {-| This module provides a `Fold1` type that is a \"non-empty\" analog of the `Fold` type, meaning that it requires at least one input element in order to produce a result @@ -7,33 +13,125 @@ which can make use of the non-empty input guarantee (e.g. `head`). For all other utilities you can convert them from the equivalent `Fold` using `fromFold`. + + Import this module qualified to avoid clashing with the Prelude: + +>>> import qualified Control.Foldl.NonEmpty as Foldl1 + + Use 'fold1' to apply a 'Fold1' to a non-empty list: + +>>> Foldl1.fold1 Foldl1.last (1 :| [2..10]) +10 + -} -module Control.Foldl.NonEmpty where +module Control.Foldl.NonEmpty ( + -- * Fold Types + Fold1(.., Fold1_) + + -- * Folding + , Control.Foldl.NonEmpty.fold1 + + -- * Conversion between Fold and Fold1 + , fromFold + , toFold + + -- * Folds + , sconcat + , head + , last + , maximum + , maximumBy + , minimum + , minimumBy + + -- ** Non-empty Container Folds + , nonEmpty + + -- * Utilities + , purely + , purely_ + , premap + , FromMaybe(..) + , Handler1 + , handles + , foldOver + , folded1 + ) where -import Control.Applicative (liftA2) +import Control.Applicative (liftA2, Const(..)) import Control.Foldl (Fold(..)) import Control.Foldl.Internal (Either'(..)) import Data.List.NonEmpty (NonEmpty(..)) +import Data.Monoid (Dual(..)) +import Data.Functor.Apply (Apply) import Data.Profunctor (Profunctor(..)) -import Data.Semigroup.Foldable (Foldable1(..)) +import Data.Semigroup.Foldable (Foldable1(..), traverse1_) +import Data.Functor.Contravariant (Contravariant(..)) + import Prelude hiding (head, last, minimum, maximum) import qualified Control.Foldl as Foldl +{- $setup + +>>> import qualified Control.Foldl.NonEmpty as Foldl1 +>>> import qualified Data.List.NonEmpty as NonEmpty +>>> import Data.Functor.Apply (Apply(..)) +>>> import Data.Semigroup.Traversable (Traversable1(..)) +>>> import Data.Monoid (Sum(..)) + +>>> _2 f (x, y) = fmap (\i -> (x, i)) (f y) + +>>> both f (x, y) = (,) <$> f x <.> f y + +-} + {-| A `Fold1` is like a `Fold` except that it consumes at least one input element -} data Fold1 a b = Fold1 (a -> Fold a b) +{-| @Fold1_@ is an alternative to the @Fold1@ constructor if you need to + explicitly work with an initial, step and extraction function. + + @Fold1_@ is similar to the @Fold@ constructor, which also works with an + initial, step and extraction function. However, note that @Fold@ takes the + step function as the first argument and the initial accumulator as the + second argument, whereas @Fold1_@ takes them in swapped order: + + @Fold1_ @ @ initial @ @ step @ @ extract@ + + While @Fold@ resembles 'Prelude.foldl', @Fold1_@ resembles + 'Data.Foldable1.foldlMap1'. +-} +pattern Fold1_ :: forall a b. forall x. (a -> x) -> (x -> a -> x) -> (x -> b) -> Fold1 a b +pattern Fold1_ begin step done <- (toFold_ -> (begin, step, done)) + where Fold1_ begin step done = Fold1 $ \a -> Fold step (begin a) done +#if __GLASGOW_HASKELL__ >= 902 +{-# INLINABLE Fold1_ #-} +#endif +{-# COMPLETE Fold1_ :: Fold1 #-} + +toFold_ :: Fold1 a b -> (a -> Fold a b, Fold a b -> a -> Fold a b, Fold a b -> b) +toFold_ (Fold1 (f :: a -> Fold a b)) = (begin', step', done') + where + done' :: Fold a b -> b + done' (Fold _step begin done) = done begin + + step' :: Fold a b -> a -> Fold a b + step' (Fold step begin done) a = Fold step (step begin a) done + + begin' :: a -> Fold a b + begin' = f +{-# INLINABLE toFold_ #-} + instance Functor (Fold1 a) where fmap f (Fold1 k) = Fold1 (fmap (fmap f) k) {-# INLINE fmap #-} instance Profunctor Fold1 where - lmap f (Fold1 k) = Fold1 k' - where - k' a = lmap f (k (f a)) + lmap = premap {-# INLINE lmap #-} rmap = fmap @@ -221,3 +319,115 @@ GT -> y _ -> x {-# INLINABLE minimumBy #-} + +-- | Upgrade a fold to accept the 'Fold1' type +purely :: (forall x . (a -> x) -> (x -> a -> x) -> (x -> b) -> r) -> Fold1 a b -> r +purely f (Fold1_ begin step done) = f begin step done +{-# INLINABLE purely #-} + +-- | Upgrade a more traditional fold to accept the `Fold1` type +purely_ :: (forall x . (a -> x) -> (x -> a -> x) -> x) -> Fold1 a b -> b +purely_ f (Fold1_ begin step done) = done (f begin step) +{-# INLINABLE purely_ #-} + +{-| @(premap f folder)@ returns a new 'Fold1' where f is applied at each step + +> Foldl1.fold1 (premap f folder) list = Foldl1.fold1 folder (NonEmpty.map f list) + +>>> Foldl1.fold1 (premap Sum Foldl1.sconcat) (1 :| [2..10]) +Sum {getSum = 55} + +>>> Foldl1.fold1 Foldl1.sconcat $ NonEmpty.map Sum (1 :| [2..10]) +Sum {getSum = 55} + +> premap id = id +> +> premap (f . g) = premap g . premap f + +> premap k (pure r) = pure r +> +> premap k (f <*> x) = premap k f <*> premap k x +-} +premap :: (a -> b) -> Fold1 b r -> Fold1 a r +premap f (Fold1 k) = Fold1 k' + where + k' a = lmap f (k (f a)) +{-# INLINABLE premap #-} + +{-| +> instance Monad m => Semigroup (FromMaybe m a) where +> mappend (FromMaybe f) (FromMaybe g) = FromMaybeM (f . Just . g) +-} +newtype FromMaybe b = FromMaybe { appFromMaybe :: Maybe b -> b } + +instance Semigroup (FromMaybe b) where + FromMaybe f <> FromMaybe g = FromMaybe (f . (Just $!) . g) + {-# INLINE (<>) #-} + +{-| A handler for the upstream input of a `Fold1` + + This is compatible with van Laarhoven optics as defined in the lens package. + Any lens, fold1 or traversal1 will type-check as a `Handler1`. +-} +type Handler1 a b = + forall x. (b -> Const (Dual (FromMaybe x)) b) -> a -> Const (Dual (FromMaybe x)) a + +{-| @(handles t folder)@ transforms the input of a `Fold1` using a Lens, + Traversal1, or Fold1 optic: + +> handles _1 :: Fold1 a r -> Fold1 (a, b) r +> handles traverse1 :: Traversable1 t => Fold1 a r -> Fold1 (t a) r +> handles folded1 :: Foldable1 t => Fold1 a r -> Fold1 (t a) r + +>>> Foldl1.fold1 (handles traverse1 Foldl1.nonEmpty) $ (1 :| [2..4]) :| [ 5 :| [6,7], 8 :| [9,10] ] +1 :| [2,3,4,5,6,7,8,9,10] + +>>> Foldl1.fold1 (handles _2 Foldl1.sconcat) $ (1,"Hello ") :| [(2,"World"),(3,"!")] +"Hello World!" + +> handles id = id +> +> handles (f . g) = handles f . handles g + +> handles t (pure r) = pure r +> +> handles t (f <*> x) = handles t f <*> handles t x +-} +handles :: forall a b r. Handler1 a b -> Fold1 b r -> Fold1 a r +handles k (Fold1_ begin step done) = Fold1_ begin' step' done + where + begin' = stepAfromMaybe Nothing + step' x = stepAfromMaybe (Just $! x) + stepAfromMaybe = flip (appFromMaybe . getDual . getConst . k (Const . Dual . FromMaybe . flip stepBfromMaybe)) + stepBfromMaybe = maybe begin step +{-# INLINABLE handles #-} + +{- | @(foldOver f folder xs)@ folds all values from a Lens, Traversal1 or Fold1 optic with the given folder + +>>> foldOver (_2 . both) Foldl1.nonEmpty (1, (2, 3)) +2 :| [3] + +> Foldl1.foldOver f folder xs == Foldl1.fold1 folder (xs ^.. f) + +> Foldl1.foldOver (folded1 . f) folder == Foldl1.fold1 (Foldl1.handles f folder) + +> Foldl1.foldOver folded1 == Foldl1.fold1 + +-} +foldOver :: Handler1 s a -> Fold1 a b -> s -> b +foldOver l (Fold1_ begin step done) = + done . stepSfromMaybe Nothing + where + stepSfromMaybe = flip (appFromMaybe . getDual . getConst . l (Const . Dual . FromMaybe . flip stepAfromMaybe)) + stepAfromMaybe = maybe begin step +{-# INLINABLE foldOver #-} + +{-| +> handles folded1 :: Foldable1 t => Fold1 a r -> Fold1 (t a) r +-} +folded1 + :: (Contravariant f, Apply f, Foldable1 t) + => (a -> f a) -> (t a -> f (t a)) +folded1 k ts = contramap (\_ -> ()) (traverse1_ k ts) +{-# INLINABLE folded1 #-} + diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foldl-1.4.16/src/Control/Foldl.hs new/foldl-1.4.17/src/Control/Foldl.hs --- old/foldl-1.4.16/src/Control/Foldl.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/foldl-1.4.17/src/Control/Foldl.hs 2001-09-09 03:46:40.000000000 +0200 @@ -92,11 +92,11 @@ , Control.Foldl.mapM_ , sink - -- * Generic Folds + -- ** Generic Folds , genericLength , genericIndex - -- * Container folds + -- ** Container Folds , list , revList , nub @@ -160,8 +160,7 @@ import Data.Functor.Identity (Identity, runIdentity) import Data.Functor.Contravariant (Contravariant(..)) import Data.HashMap.Strict (HashMap) -import Data.Map.Strict (Map, alter) -import Data.Maybe (fromMaybe) +import Data.Map.Strict (Map) import Data.Monoid hiding ((<>)) import Data.Semigroupoid (Semigroupoid) import Data.Functor.Extend (Extend(..)) @@ -210,6 +209,7 @@ {- $setup >>> import qualified Control.Foldl as Foldl +>>> import Data.Functor.Apply (Apply(..)) >>> _2 f (x, y) = fmap (\i -> (x, i)) (f y) @@ -219,7 +219,7 @@ >>> in Control.Foldl.Optics.prism Just maybeEither >>> :} ->>> both f (x, y) = (,) <$> f x <*> f y +>>> both f (x, y) = (,) <$> f x <.> f y -} @@ -979,7 +979,7 @@ Fold (step0 :: x -> a -> x) (ini0 :: x) (end0 :: x -> b) -> let step :: Map k x -> (k,a) -> Map k x - step mp (k,a) = Map.alter addToMap k mp where + step !mp (k,a) = Map.alter addToMap k mp where addToMap Nothing = Just $ step0 ini0 a addToMap (Just existing) = Just $ step0 existing a @@ -1350,7 +1350,7 @@ >>> fold (handles traverse sum) [[1..5],[6..10]] 55 ->>> fold (handles (traverse.traverse) sum) [[Nothing, Just 2, Just 7],[Just 13, Nothing, Just 20]] +>>> fold (handles (traverse . traverse) sum) [[Nothing, Just 2, Just 7],[Just 13, Nothing, Just 20]] 42 >>> fold (handles (filtered even) sum) [1..10] @@ -1383,7 +1383,7 @@ > Foldl.foldOver f folder xs == Foldl.fold folder (xs^..f) -> Foldl.foldOver (folded.f) folder == Foldl.fold (handles f folder) +> Foldl.foldOver (folded . f) folder == Foldl.fold (handles f folder) > Foldl.foldOver folded == Foldl.fold @@ -1444,7 +1444,7 @@ {- | @(foldOverM f folder xs)@ folds all values from a Lens, Traversal, Prism or Fold monadically with the given folder -> Foldl.foldOverM (folded.f) folder == Foldl.foldM (handlesM f folder) +> Foldl.foldOverM (folded . f) folder == Foldl.foldM (handlesM f folder) > Foldl.foldOverM folded == Foldl.foldM @@ -1490,10 +1490,8 @@ group. -} -groupBy :: Ord g => (a -> g) -> Fold a r -> Fold a (Map g r) -groupBy grouper (Fold f i e) = Fold f' mempty (fmap e) - where - f' !m !a = alter (\o -> Just (f (fromMaybe i o) a)) (grouper a) m +groupBy :: Ord k => (a -> k) -> Fold a b -> Fold a (Map k b) +groupBy f = premap (\(!a) -> (f a, a)) . foldByKeyMap {-# INLINABLE groupBy #-} {-| Combine two folds into a fold over inputs for either of them. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foldl-1.4.16/test/doctest.hs new/foldl-1.4.17/test/doctest.hs --- old/foldl-1.4.16/test/doctest.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/foldl-1.4.17/test/doctest.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,4 +1,4 @@ import Test.DocTest main :: IO () -main = doctest ["-isrc", "src/Control/Foldl.hs", "src/Control/Scanl.hs"] +main = doctest ["-isrc", "src/Control/Foldl/NonEmpty.hs", "src/Control/Foldl.hs", "src/Control/Scanl.hs"]
