Hello community, here is the log from the commit of package ghc-data-fix for openSUSE:Factory checked in at 2020-08-10 14:53:29 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-data-fix (Old) and /work/SRC/openSUSE:Factory/.ghc-data-fix.new.3399 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-data-fix" Mon Aug 10 14:53:29 2020 rev:2 rq:824307 version:0.3.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-data-fix/ghc-data-fix.changes 2020-07-09 13:17:36.576936243 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-data-fix.new.3399/ghc-data-fix.changes 2020-08-10 14:53:48.379867706 +0200 @@ -1,0 +2,8 @@ +Thu Jul 23 02:00:26 UTC 2020 - [email protected] + +- Update data-fix to version 0.3.0. + Upstream added a new change log file in this release. With no + previous version to compare against, the automatic updater cannot + reliable determine the relevante entries for this release. + +------------------------------------------------------------------- Old: ---- data-fix-0.2.1.tar.gz data-fix.cabal New: ---- data-fix-0.3.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-data-fix.spec ++++++ --- /var/tmp/diff_new_pack.5qHBl2/_old 2020-08-10 14:53:49.735868421 +0200 +++ /var/tmp/diff_new_pack.5qHBl2/_new 2020-08-10 14:53:49.739868423 +0200 @@ -18,14 +18,15 @@ %global pkg_name data-fix Name: ghc-%{pkg_name} -Version: 0.2.1 +Version: 0.3.0 Release: 0 Summary: Fixpoint data types License: BSD-3-Clause URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal BuildRequires: ghc-Cabal-devel +BuildRequires: ghc-deepseq-devel +BuildRequires: ghc-hashable-devel BuildRequires: ghc-rpm-macros %description @@ -46,7 +47,6 @@ %prep %setup -q -n %{pkg_name}-%{version} -cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build @@ -64,5 +64,6 @@ %license LICENSE %files devel -f %{name}-devel.files +%doc CHANGELOG.md %changelog ++++++ data-fix-0.2.1.tar.gz -> data-fix-0.3.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/data-fix-0.2.1/CHANGELOG.md new/data-fix-0.3.0/CHANGELOG.md --- old/data-fix-0.2.1/CHANGELOG.md 1970-01-01 01:00:00.000000000 +0100 +++ new/data-fix-0.3.0/CHANGELOG.md 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,20 @@ +## 0.3.0 + +- Rename `cata`, `ana` and `hylo` into `foldFix`, `unfoldFix` and `refold. + Old names are now deprecated, and will be eventually removed. + Similarly, rename monadic variants. +- Add `hoistFix` and `hoistFix'` function. +- Add `Hashable` and `NFData` instance. + Latter is available only with `deepseq >=1.4.3.0`, + which provides `NFData1` type-class +- Change `Eq`, `Ord`, `Show` and `Read` instances to use + `Eq1`, `Ord1`, `Show1` and `Read1` instances of a base functor. +- Add least and greatest fixed point types, `Mu` and `Nu`. +- Drop requirement for `Applicative m` in monadic combinators, + `Monad m` is enough. +- Remove `~>` alias for `refold` (`hylo`). +- Extend the GHC support window. + There is nothing magical in this package. +- Mark `Data.Fix` as Trustworthy (Safe Haskell) +- Make `refold` (and `refoldM`) more efficient. + This results in different effect ordering for `refoldM`. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/data-fix-0.2.1/data-fix.cabal new/data-fix-0.3.0/data-fix.cabal --- old/data-fix-0.2.1/data-fix.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/data-fix-0.3.0/data-fix.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,9 +1,9 @@ Name: data-fix -Version: 0.2.1 +Version: 0.3.0 Cabal-Version: >= 1.10 License: BSD3 License-file: LICENSE -Author: Anton Kholomiov +Author: Anton Kholomiov, Edward Kmett, Oleg Grenrus Maintainer: <[email protected]> Category: Data Synopsis: Fixpoint data types @@ -16,19 +16,53 @@ Stability: Experimental -Homepage: https://github.com/anton-k/data-fix -Bug-Reports: https://github.com/anton-k/data-fix/issues +Homepage: https://github.com/spell-music/data-fix +Bug-Reports: https://github.com/spell-music/data-fix/issues -Source-repository head - Type: git - Location: https://github.com/anton-k/data-fix +Tested-With: + GHC ==7.2.2 + || ==7.4.2 + || ==7.6.3 + || ==7.8.4 + || ==7.10.3 + || ==8.0.2 + || ==8.2.2 + || ==8.4.4 + || ==8.6.5 + || ==8.8.3 + || ==8.10.1 -Library - Default-Language: Haskell2010 - Build-depends: base >= 4.7, base < 5 - Hs-source-dirs: src/ +extra-source-files: + CHANGELOG.md - ghc-options: -Wall +Source-repository head + Type: git + Location: https://github.com/spell-music/data-fix - Exposed-modules: - Data.Fix +library + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall + exposed-modules: Data.Fix + + if impl(ghc >=8.0) + ghc-options: -Wno-trustworthy-safe + + if impl(ghc >=8.4) + ghc-options: + -Wincomplete-uni-patterns -Wincomplete-record-updates + -Wredundant-constraints -Widentities -Wmissing-export-lists + + build-depends: + base >=4.4 && <4.15 + , deepseq >=1.3.0.0 && <1.5 + , hashable >=1.2.7.0 && <1.4 + + if impl(ghc <7.6) + -- for GHC.Generics + build-depends: ghc-prim + + if !impl(ghc >=8.0) + build-depends: + transformers >=0.3 && <0.6 + , transformers-compat >=0.6.5 && <0.7 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/data-fix-0.2.1/src/Data/Fix.hs new/data-fix-0.3.0/src/Data/Fix.hs --- old/data-fix-0.2.1/src/Data/Fix.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/data-fix-0.3.0/src/Data/Fix.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,13 +1,20 @@ -{-# Language - FlexibleContexts, - UndecidableInstances, - TypeSynonymInstances, - DeriveGeneric, - DeriveDataTypeable, - StandaloneDeriving #-} --- | Fix-point type. It allows to define generic recursion schemes. --- --- > Fix f = f (Fix f) +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE Trustworthy #-} + +-- needed for Data instance +{-# LANGUAGE UndecidableInstances #-} + +#define HAS_POLY_TYPEABLE MIN_VERSION_base(4,7,0) + +#if HAS_POLY_TYPEABLE +{-# LANGUAGE StandaloneDeriving #-} +#endif + +-- | Fixed points of a functor. -- -- Type @f@ should be a 'Functor' if you want to use -- simple recursion schemes or 'Traversable' if you want to @@ -16,101 +23,365 @@ -- You can imagine that a non-recursive function -- holds values of the previous iteration. -- --- Little example: +-- An example: +-- +-- First we define a base functor. The arguments @b@ are recursion points. +-- +-- >>> data ListF a b = Nil | Cons a b deriving (Show, Functor) +-- +-- The list is then a fixed point of 'ListF' +-- +-- >>> type List a = Fix (ListF a) +-- +-- We can write @length@ function. Note that the function we give +-- to 'foldFix' is not recursive. Instead the results +-- of recursive calls are in @b@ positions, and we need to deal +-- only with one layer of the structure. +-- +-- >>> :{ +-- let length :: List a -> Int +-- length = foldFix $ \x -> case x of +-- Nil -> 0 +-- Cons _ n -> n + 1 +-- :} +-- +-- If you already have recursive type, like '[Int]', +-- you can first convert it to `Fix (ListF a)` and then `foldFix`. +-- Alternatively you can use @recursion-schemes@ combinators +-- which work directly on recursive types. -- --- > type List a = Fix (L a) --- > --- > data L a b = Nil | Cons a b --- > --- > instance Functor (L a) where --- > fmap f x = case x of --- > Nil -> Nil --- > Cons a b -> Cons a (f b) --- > --- > length :: List a -> Int --- > length = cata $ \x -> case x of --- > Nil -> 0 --- > Cons _ n -> n + 1 --- > --- > sum :: Num a => List a -> a --- > sum = cata $ \x -> case x of --- > Nil -> 0 --- > Cons a s -> a + s - module Data.Fix ( - Fix(..) - -- * Simple recursion - -- | Type @f@ should be a 'Functor'. They transform - -- non-recursive functions to recursive ones. - , cata - , ana - , hylo - , (~>) - -- * Monadic recursion - -- | Type @f@ should be a 'Traversable'. - , cataM - , anaM - , hyloM - ) -where - -import GHC.Generics + -- * Fix + Fix (..), + hoistFix, + hoistFix', + foldFix, + unfoldFix, + -- * Mu - least fixed point + Mu (..), + hoistMu, + foldMu, + unfoldMu, + -- * Nu - greatest fixed point + Nu (..), + hoistNu, + foldNu, + unfoldNu, + -- * Refolding + refold, + -- * Monadic variants + foldFixM, + unfoldFixM, + refoldM, + -- * Deprecated aliases + cata, ana, hylo, + cataM, anaM, hyloM, +) where + +-- Explicit imports help dodge unused imports warnings, +-- as we say what we want from Prelude +import Data.Traversable (Traversable (..)) +import Prelude (Eq (..), Functor (..), Monad (..), Ord (..), Read (..), Show (..), showParen, showString, ($), (.), (=<<)) + +#ifdef __GLASGOW_HASKELL__ +#if! HAS_POLY_TYPEABLE +import Prelude (const, error, undefined) +#endif +#endif + +import Control.Monad (liftM) +import Data.Function (on) +import Data.Functor.Classes (Eq1, Ord1, Read1, Show1, compare1, eq1, readsPrec1, showsPrec1) +import Data.Hashable (Hashable (..)) +import Data.Hashable.Lifted (Hashable1, hashWithSalt1) +import Data.Typeable (Typeable) +import GHC.Generics (Generic) +import Text.Read (Lexeme (Ident), Read (..), lexP, parens, prec, readS_to_Prec, step) + +#if MIN_VERSION_deepseq(1,4,3) +import Control.DeepSeq (NFData (..), NFData1, rnf1) +#endif + +#if HAS_POLY_TYPEABLE +import Data.Data (Data) +#else import Data.Data -import Data.Function (on) +#endif + +-- $setup +-- >>> :set -XDeriveFunctor +-- >>> import Prelude (showChar, Int, Num (..)) +-- >>> import Data.Functor.Classes +-- >>> data ListF a b = Nil | Cons a b deriving (Show, Functor) +-- +-- >>> :{ +-- >>> instance Show a => Show1 (ListF a) where +-- >>> liftShowsPrec _ _ d Nil = showString "Nil" +-- >>> liftShowsPrec sp _ d (Cons a b) = showParen (d > 10) $ showString "Cons " . showsPrec 11 a . showChar ' ' . sp 11 b +-- >>> :} +-- +-- >>> :{ +-- >>> let elimListF n c Nil = 0 +-- >>> elimListF n c (Cons a b) = c a b +-- >>> :} + +------------------------------------------------------------------------------- +-- Fix +------------------------------------------------------------------------------- -- | A fix-point type. -newtype Fix f = Fix { unFix :: f (Fix f) } deriving (Generic, Typeable) +newtype Fix f = Fix { unFix :: f (Fix f) } + deriving (Generic) + +-- | Change base functor in 'Fix'. +hoistFix :: Functor f => (forall a. f a -> g a) -> Fix f -> Fix g +hoistFix nt = go where go (Fix f) = Fix (nt (fmap go f)) + +-- | Like 'hoistFix' but 'fmap'ping over @g@. +hoistFix' :: Functor g => (forall a. f a -> g a) -> Fix f -> Fix g +hoistFix' nt = go where go (Fix f) = Fix (fmap go (nt f)) + +-- | Fold 'Fix'. +-- +-- >>> let fp = unfoldFix (\i -> if i < 4 then Cons i (i + 1) else Nil) (0 :: Int) +-- >>> foldFix (elimListF 0 (+)) fp +-- 6 +-- +foldFix :: Functor f => (f a -> a) -> Fix f -> a +foldFix f = go where go = f . fmap go . unFix + +-- | Unfold 'Fix'. +-- +-- >>> unfoldFix (\i -> if i < 4 then Cons i (i + 1) else Nil) (0 :: Int) +-- Fix (Cons 0 (Fix (Cons 1 (Fix (Cons 2 (Fix (Cons 3 (Fix Nil)))))))) +-- +unfoldFix :: Functor f => (a -> f a) -> a -> Fix f +unfoldFix f = go where go = Fix . fmap go . f + +------------------------------------------------------------------------------- +-- Functor instances +------------------------------------------------------------------------------- + +instance Eq1 f => Eq (Fix f) where + Fix a == Fix b = eq1 a b + +instance Ord1 f => Ord (Fix f) where + compare (Fix a) (Fix b) = compare1 a b + +instance Show1 f => Show (Fix f) where + showsPrec d (Fix a) = + showParen (d >= 11) + $ showString "Fix " + . showsPrec1 11 a + +#ifdef __GLASGOW_HASKELL__ +instance Read1 f => Read (Fix f) where + readPrec = parens $ prec 10 $ do + Ident "Fix" <- lexP + fmap Fix (step (readS_to_Prec readsPrec1)) +#endif + +------------------------------------------------------------------------------- +-- hashable +------------------------------------------------------------------------------- + +instance Hashable1 f => Hashable (Fix f) where + hashWithSalt salt = hashWithSalt1 salt . unFix + +#if MIN_VERSION_deepseq(1,4,3) +instance NFData1 f => NFData (Fix f) where + rnf = rnf1 . unFix +#endif + +------------------------------------------------------------------------------- +-- Typeable and Data +------------------------------------------------------------------------------- + +#ifdef __GLASGOW_HASKELL__ +#if HAS_POLY_TYPEABLE +deriving instance Typeable Fix deriving instance (Typeable f, Data (f (Fix f))) => Data (Fix f) +#else +instance Typeable1 f => Typeable (Fix f) where + typeOf t = mkTyConApp fixTyCon [typeOf1 (undefined `asArgsTypeOf` t)] + where asArgsTypeOf :: f a -> Fix f -> f a + asArgsTypeOf = const + +fixTyCon :: TyCon +#if MIN_VERSION_base(4,4,0) +fixTyCon = mkTyCon3 "recursion-schemes" "Data.Functor.Foldable" "Fix" +#else +fixTyCon = mkTyCon "Data.Functor.Foldable.Fix" +#endif +{-# NOINLINE fixTyCon #-} + +instance (Typeable1 f, Data (f (Fix f))) => Data (Fix f) where + gfoldl f z (Fix a) = z Fix `f` a + toConstr _ = fixConstr + gunfold k z c = case constrIndex c of + 1 -> k (z (Fix)) + _ -> error "gunfold" + dataTypeOf _ = fixDataType + +fixConstr :: Constr +fixConstr = mkConstr fixDataType "Fix" [] Prefix + +fixDataType :: DataType +fixDataType = mkDataType "Data.Functor.Foldable.Fix" [fixConstr] +#endif +#endif + +------------------------------------------------------------------------------- +-- Mu +------------------------------------------------------------------------------- + +-- | Least fixed point. Efficient folding. +newtype Mu f = Mu { unMu :: forall a. (f a -> a) -> a } + +instance (Functor f, Eq1 f) => Eq (Mu f) where + (==) = (==) `on` foldMu Fix + +instance (Functor f, Ord1 f) => Ord (Mu f) where + compare = compare `on` foldMu Fix + +instance (Functor f, Show1 f) => Show (Mu f) where + showsPrec d f = showParen (d > 10) $ + showString "unfoldMu unFix " . showsPrec 11 (foldMu Fix f) + +#ifdef __GLASGOW_HASKELL__ +instance (Functor f, Read1 f) => Read (Mu f) where + readPrec = parens $ prec 10 $ do + Ident "unfoldMu" <- lexP + Ident "unFix" <- lexP + fmap (unfoldMu unFix) (step readPrec) +#endif + +-- | Change base functor in 'Mu'. +hoistMu :: (forall a. f a -> g a) -> Mu f -> Mu g +hoistMu n (Mu mk) = Mu $ \roll -> mk (roll . n) + +-- | Fold 'Mu'. +-- +-- >>> let mu = unfoldMu (\i -> if i < 4 then Cons i (i + 1) else Nil) (0 :: Int) +-- >>> foldMu (elimListF 0 (+)) mu +-- 6 +foldMu :: (f a -> a) -> Mu f -> a +foldMu f (Mu mk) = mk f + +-- | Unfold 'Mu'. +-- +-- >>> unfoldMu (\i -> if i < 4 then Cons i (i + 1) else Nil) (0 :: Int) +-- unfoldMu unFix (Fix (Cons 0 (Fix (Cons 1 (Fix (Cons 2 (Fix (Cons 3 (Fix Nil))))))))) +unfoldMu :: Functor f => (a -> f a) -> a -> Mu f +unfoldMu f x = Mu $ \mk -> refold mk f x + +------------------------------------------------------------------------------- +-- Nu +------------------------------------------------------------------------------- + +-- | Greatest fixed point. Efficient unfolding. +data Nu f = forall a. Nu (a -> f a) a + +instance (Functor f, Eq1 f) => Eq (Nu f) where + (==) = (==) `on` foldNu Fix + +instance (Functor f, Ord1 f) => Ord (Nu f) where + compare = compare `on` foldNu Fix + +instance (Functor f, Show1 f) => Show (Nu f) where + showsPrec d f = showParen (d > 10) $ + showString "unfoldNu unFix " . showsPrec 11 (foldNu Fix f) + +#ifdef __GLASGOW_HASKELL__ +instance (Functor f, Read1 f) => Read (Nu f) where + readPrec = parens $ prec 10 $ do + Ident "unfoldNu" <- lexP + Ident "unFix" <- lexP + fmap (unfoldNu unFix) (step readPrec) +#endif + +-- | Change base functor in 'Nu'. +hoistNu :: (forall a. f a -> g a) -> Nu f -> Nu g +hoistNu n (Nu next seed) = Nu (n . next) seed --- standard instances +-- | Fold 'Nu'. +-- +-- >>> let nu = unfoldNu (\i -> if i < 4 then Cons i (i + 1) else Nil) (0 :: Int) +-- >>> foldNu (elimListF 0 (+)) nu +-- 6 +-- +foldNu :: Functor f => (f a -> a) -> Nu f -> a +foldNu f (Nu next seed) = refold f next seed + +-- | Unfold 'Nu'. +-- +-- >>> unfoldNu (\i -> if i < 4 then Cons i (i + 1) else Nil) (0 :: Int) +-- unfoldNu unFix (Fix (Cons 0 (Fix (Cons 1 (Fix (Cons 2 (Fix (Cons 3 (Fix Nil))))))))) +unfoldNu :: (a -> f a) -> a -> Nu f +unfoldNu = Nu + +------------------------------------------------------------------------------- +-- refold +------------------------------------------------------------------------------- -instance Show (f (Fix f)) => Show (Fix f) where - showsPrec n x = showParen (n > 10) $ \s -> - "Fix " ++ showsPrec 11 (unFix x) s +-- | Refold one recursive type into another, one layer at the time. +-- +refold :: Functor f => (f b -> b) -> (a -> f a) -> a -> b +refold f g = h where h = f . fmap h . g -instance Read (f (Fix f)) => Read (Fix f) where - readsPrec d = readParen (d > 10) $ \r -> - [(Fix m, t) | ("Fix", s) <- lex r, (m, t) <- readsPrec 11 s] +------------------------------------------------------------------------------- +-- Monadic variants +------------------------------------------------------------------------------- -instance Eq (f (Fix f)) => Eq (Fix f) where - (==) = (==) `on` unFix +-- | Monadic 'foldFix'. +-- +foldFixM:: (Monad m, Traversable t) + => (t a -> m a) -> Fix t -> m a +foldFixM f = go where go = (f =<<) . mapM go . unFix -instance Ord (f (Fix f)) => Ord (Fix f) where - compare = compare `on` unFix +-- | Monadic anamorphism. +unfoldFixM :: (Monad m, Traversable t) + => (a -> m (t a)) -> (a -> m (Fix t)) +unfoldFixM f = go where go = liftM Fix . (mapM go =<<) . f +-- | Monadic hylomorphism. +refoldM :: (Monad m, Traversable t) + => (t b -> m b) -> (a -> m (t a)) -> (a -> m b) +refoldM phi psi = go where go = (phi =<<) . (mapM go =<<) . psi --- recursion +------------------------------------------------------------------------------- +-- Deprecated aliases +------------------------------------------------------------------------------- -- | Catamorphism or generic function fold. cata :: Functor f => (f a -> a) -> (Fix f -> a) -cata f = f . fmap (cata f) . unFix +cata = foldFix +{-# DEPRECATED cata "Use foldFix" #-} -- | Anamorphism or generic function unfold. ana :: Functor f => (a -> f a) -> (a -> Fix f) -ana f = Fix . fmap (ana f) . f +ana = unfoldFix +{-# DEPRECATED ana "Use unfoldFix" #-} -- | Hylomorphism is anamorphism followed by catamorphism. hylo :: Functor f => (f b -> b) -> (a -> f a) -> (a -> b) -hylo phi psi = cata phi . ana psi - --- | Infix version of @hylo@. -(~>) :: Functor f => (a -> f a) -> (f b -> b) -> (a -> b) -psi ~> phi = phi . fmap (hylo phi psi) . psi - --- monadic recursion +hylo = refold +{-# DEPRECATED hylo "Use refold" #-} -- | Monadic catamorphism. -cataM :: (Applicative m, Monad m, Traversable t) +cataM :: (Monad m, Traversable t) => (t a -> m a) -> Fix t -> m a -cataM f = (f =<<) . traverse (cataM f) . unFix +cataM = foldFixM +{-# DEPRECATED cataM "Use foldFixM" #-} -- | Monadic anamorphism. -anaM :: (Applicative m, Monad m, Traversable t) +anaM :: (Monad m, Traversable t) => (a -> m (t a)) -> (a -> m (Fix t)) -anaM f = fmap Fix . (traverse (anaM f) =<<) . f +anaM = unfoldFixM +{-# DEPRECATED anaM "Use unfoldFixM" #-} -- | Monadic hylomorphism. -hyloM :: (Applicative m, Monad m, Traversable t) +hyloM :: (Monad m, Traversable t) => (t b -> m b) -> (a -> m (t a)) -> (a -> m b) -hyloM phi psi = (cataM phi =<<) . anaM psi - +hyloM = refoldM +{-# DEPRECATED hyloM "Use refoldM" #-}
