Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-foundation for openSUSE:Factory checked in at 2022-10-13 15:41:59 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-foundation (Old) and /work/SRC/openSUSE:Factory/.ghc-foundation.new.2275 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-foundation" Thu Oct 13 15:41:59 2022 rev:8 rq:1008463 version:0.0.29 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-foundation/ghc-foundation.changes 2022-08-01 21:28:47.729380451 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-foundation.new.2275/ghc-foundation.changes 2022-10-13 15:42:03.054726881 +0200 @@ -1,0 +2,6 @@ +Fri Aug 19 04:42:44 UTC 2022 - Peter Simons <[email protected]> + +- Update foundation to version 0.0.29. + Upstream does not provide a change log file. + +------------------------------------------------------------------- Old: ---- foundation-0.0.28.tar.gz New: ---- foundation-0.0.29.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-foundation.spec ++++++ --- /var/tmp/diff_new_pack.TvrT1t/_old 2022-10-13 15:42:05.594731839 +0200 +++ /var/tmp/diff_new_pack.TvrT1t/_new 2022-10-13 15:42:05.598731847 +0200 @@ -19,7 +19,7 @@ %global pkg_name foundation %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.0.28 +Version: 0.0.29 Release: 0 Summary: Alternative prelude with batteries and no dependencies License: BSD-3-Clause ++++++ foundation-0.0.28.tar.gz -> foundation-0.0.29.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Array/Bitmap.hs new/foundation-0.0.29/Foundation/Array/Bitmap.hs --- old/foundation-0.0.28/Foundation/Array/Bitmap.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Array/Bitmap.hs 2022-08-19 05:10:00.000000000 +0200 @@ -42,7 +42,7 @@ import qualified Foundation.Collection as C import Foundation.Numerical -import Data.Bits +import Data.Bits hiding ((.<<.), (.>>.)) import Foundation.Bits import GHC.ST import qualified Data.List @@ -71,7 +71,6 @@ (<>) = append instance Monoid Bitmap where mempty = empty - mappend = append mconcat = concat type instance C.Element Bitmap = Bool diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Array/Chunked/Unboxed.hs new/foundation-0.0.29/Foundation/Array/Chunked/Unboxed.hs --- old/foundation-0.0.28/Foundation/Array/Chunked/Unboxed.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Array/Chunked/Unboxed.hs 2022-08-19 05:10:16.000000000 +0200 @@ -47,7 +47,6 @@ (<>) = append instance Monoid (ChunkedUArray a) where mempty = empty - mappend = append mconcat = concat type instance C.Element (ChunkedUArray ty) = ty diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Bits.hs new/foundation-0.0.29/Foundation/Bits.hs --- old/foundation-0.0.28/Foundation/Bits.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Bits.hs 2022-08-19 04:42:59.000000000 +0200 @@ -9,7 +9,7 @@ import Basement.Compat.Base import Foundation.Numerical -import Data.Bits +import Data.Bits hiding ((.<<.), (.>>.)) -- | Unsafe Shift Left Operator (.<<.) :: Bits a => a -> Int -> a diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Check/Gen.hs new/foundation-0.0.29/Foundation/Check/Gen.hs --- old/foundation-0.0.28/Foundation/Check/Gen.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Check/Gen.hs 2022-08-19 05:11:19.000000000 +0200 @@ -60,7 +60,7 @@ in ab a instance Monad Gen where - return a = Gen (\_ _ -> a) + return = pure ma >>= mb = Gen $ \rng params -> let (r1,r2) = genGenerator rng a = runGen ma r1 params diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Check/Main.hs new/foundation-0.0.29/Foundation/Check/Main.hs --- old/foundation-0.0.28/Foundation/Check/Main.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Check/Main.hs 2022-08-19 05:29:32.000000000 +0200 @@ -273,10 +273,12 @@ then return (GroupResult name 0 (planValidations st) []) else do displayCurrent name - forM_ fails $ \(PropertyResult name' nb r) -> - case r of - PropertySuccess -> whenVerbose $ displayPropertySucceed (name <> ": " <> name') nb - PropertyFailed w -> whenErrorOnly $ displayPropertyFailed (name <> ": " <> name') nb w + forM_ fails $ \fail -> case fail of + PropertyResult name' nb r -> + case r of + PropertySuccess -> whenVerbose $ displayPropertySucceed (name <> ": " <> name') nb + PropertyFailed w -> whenErrorOnly $ displayPropertyFailed (name <> ": " <> name') nb w + _ -> error "should not happen" return (GroupResult name (length fails) (planValidations st) fails) testProperty :: String -> Property -> CheckMain TestResult diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Check/Property.hs new/foundation-0.0.29/Foundation/Check/Property.hs --- old/foundation-0.0.28/Foundation/Check/Property.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Check/Property.hs 2022-08-19 05:24:02.000000000 +0200 @@ -18,7 +18,6 @@ ) where import Basement.Imports hiding (Typeable) -import Data.Proxy (Proxy(..)) import Basement.Compat.Typeable import Foundation.Check.Gen import Foundation.Check.Arbitrary diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Class/Storable.hs new/foundation-0.0.29/Foundation/Class/Storable.hs --- old/foundation-0.0.28/Foundation/Class/Storable.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Class/Storable.hs 2022-08-19 05:27:12.000000000 +0200 @@ -30,8 +30,6 @@ #include "MachDeps.h" -import GHC.Types (Double, Float) - import Foreign.Ptr (castPtr) import qualified Foreign.Ptr import qualified Foreign.Storable (peek, poke) @@ -42,7 +40,7 @@ import Basement.Types.Word128 (Word128(..)) import Basement.Types.Word256 (Word256(..)) import Foundation.Collection -import Foundation.Collection.Buildable (builderLift, build_) +import Foundation.Collection.Buildable (builderLift) import Basement.PrimType import Basement.Endianness import Foundation.Numerical diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Collection/Buildable.hs new/foundation-0.0.29/Foundation/Collection/Buildable.hs --- old/foundation-0.0.28/Foundation/Collection/Buildable.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Collection/Buildable.hs 2022-08-19 05:51:39.000000000 +0200 @@ -24,6 +24,7 @@ import Basement.Monad import Basement.MutableBuilder import Basement.Compat.MonadTrans +import Data.Kind (Type) -- $setup -- >>> import Control.Monad.ST @@ -42,7 +43,7 @@ {-# MINIMAL append, build #-} -- | Mutable collection type used for incrementally writing chunks. - type Mutable col :: * -> * + type Mutable col :: Type -> Type -- | Unit of the smallest step possible in an `append` operation. -- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Collection/Collection.hs new/foundation-0.0.29/Foundation/Collection/Collection.hs --- old/foundation-0.0.28/Foundation/Collection/Collection.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Collection/Collection.hs 2022-08-19 05:07:06.000000000 +0200 @@ -20,6 +20,7 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeOperators #-} module Foundation.Collection.Collection ( Collection(..) -- * NonEmpty Property diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Collection/Foldable.hs new/foundation-0.0.29/Foundation/Collection/Foldable.hs --- old/foundation-0.0.28/Foundation/Collection/Foldable.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Collection/Foldable.hs 2022-08-19 04:42:59.000000000 +0200 @@ -15,6 +15,10 @@ {-# LANGUAGE TypeOperators #-} #endif +#if __GLASGOW_HASKELL__ >= 904 +{-# LANGUAGE UndecidableInstances #-} +#endif + module Foundation.Collection.Foldable ( Foldable(..) , Fold1able(..) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Collection/InnerFunctor.hs new/foundation-0.0.29/Foundation/Collection/InnerFunctor.hs --- old/foundation-0.0.28/Foundation/Collection/InnerFunctor.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Collection/InnerFunctor.hs 2022-08-19 05:07:37.000000000 +0200 @@ -1,4 +1,5 @@ {-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE TypeOperators #-} module Foundation.Collection.InnerFunctor ( InnerFunctor(..) ) where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Collection/Sequential.hs new/foundation-0.0.29/Foundation/Collection/Sequential.hs --- old/foundation-0.0.28/Foundation/Collection/Sequential.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Collection/Sequential.hs 2022-08-19 05:14:19.000000000 +0200 @@ -14,6 +14,7 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeOperators #-} module Foundation.Collection.Sequential ( Sequential(..) ) where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Collection/Zippable.hs new/foundation-0.0.29/Foundation/Collection/Zippable.hs --- old/foundation-0.0.28/Foundation/Collection/Zippable.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Collection/Zippable.hs 2022-08-19 05:08:48.000000000 +0200 @@ -12,6 +12,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeOperators #-} module Foundation.Collection.Zippable ( BoxedZippable(..) , Zippable(..) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Conduit/Internal.hs new/foundation-0.0.29/Foundation/Conduit/Internal.hs --- old/foundation-0.0.28/Foundation/Conduit/Internal.hs 2021-04-25 03:00:28.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Conduit/Internal.hs 2022-08-19 05:08:31.000000000 +0200 @@ -79,7 +79,7 @@ {-# INLINE (<*>) #-} instance (Functor m, Monad m) => Monad (Pipe l i o u m) where - return = Done + return = pure {-# INLINE return #-} Yield p c o >>= fp = Yield (p >>= fp) c o diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Conduit/Textual.hs new/foundation-0.0.29/Foundation/Conduit/Textual.hs --- old/foundation-0.0.28/Foundation/Conduit/Textual.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Conduit/Textual.hs 2022-08-19 05:23:27.000000000 +0200 @@ -7,8 +7,6 @@ ) where import Basement.Imports hiding (throw) -import Basement.UArray (UArray) -import Foundation.String (String) import Foundation.Collection import qualified Basement.String as S import Foundation.Conduit.Internal diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Conduit.hs new/foundation-0.0.29/Foundation/Conduit.hs --- old/foundation-0.0.28/Foundation/Conduit.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Conduit.hs 2022-08-19 05:12:16.000000000 +0200 @@ -1,3 +1,4 @@ +{-# LANGUAGE TypeOperators #-} module Foundation.Conduit ( Conduit , ResourceT diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Exception.hs new/foundation-0.0.29/Foundation/Exception.hs --- old/foundation-0.0.28/Foundation/Exception.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Exception.hs 2022-08-19 05:30:46.000000000 +0200 @@ -5,7 +5,7 @@ ) where import Basement.Imports -import Control.Exception (Exception, SomeException) +import Control.Exception (SomeException) import Foundation.Monad.Exception finally :: MonadBracket m => m a -> m b -> m a diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Format/CSV/Types.hs new/foundation-0.0.29/Foundation/Format/CSV/Types.hs --- old/foundation-0.0.28/Foundation/Format/CSV/Types.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Format/CSV/Types.hs 2022-08-19 05:27:48.000000000 +0200 @@ -31,14 +31,13 @@ ) where import Basement.Imports -import Basement.BoxedArray (Array, length, unsafeIndex) +import Basement.BoxedArray (length, unsafeIndex) import Basement.NormalForm (NormalForm(..)) import Basement.From (Into, into) -import Basement.String (String, any, elem, null, uncons) +import Basement.String (any, elem, null, uncons) import qualified Basement.String as String (singleton) import Basement.Types.Word128 (Word128) import Basement.Types.Word256 (Word256) -import Basement.Types.OffsetSize (Offset, CountOf) import Foundation.Collection.Element (Element) import Foundation.Collection.Collection (Collection, nonEmpty_) import Foundation.Collection.Sequential (Sequential) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Hashing/SipHash.hs new/foundation-0.0.29/Foundation/Hashing/SipHash.hs --- old/foundation-0.0.28/Foundation/Hashing/SipHash.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Hashing/SipHash.hs 2022-08-19 04:42:59.000000000 +0200 @@ -17,7 +17,7 @@ , Sip2_4 ) where -import Data.Bits +import Data.Bits hiding ((.<<.), (.>>.)) import Basement.Compat.Base import Basement.Types.OffsetSize import Basement.PrimType diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/List/DList.hs new/foundation-0.0.29/Foundation/List/DList.hs --- old/foundation-0.0.28/Foundation/List/DList.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/List/DList.hs 2022-08-19 05:09:17.000000000 +0200 @@ -37,7 +37,6 @@ (<>) dl1 dl2 = DList $ unDList dl1 . unDList dl2 instance Monoid (DList a) where mempty = DList id - mappend dl1 dl2 = DList $ unDList dl1 . unDList dl2 instance Functor DList where fmap f = foldr (cons . f) mempty @@ -48,7 +47,7 @@ instance Monad DList where (>>=) m k = foldr (mappend . k) mempty m - return = singleton + return = pure type instance Element (DList a) = a diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Monad/Except.hs new/foundation-0.0.29/Foundation/Monad/Except.hs --- old/foundation-0.0.28/Foundation/Monad/Except.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Monad/Except.hs 2022-08-19 05:08:13.000000000 +0200 @@ -35,7 +35,7 @@ mFail = ExceptT . pure . Left instance Monad m => Monad (ExceptT e m) where - return a = ExceptT $ return (Right a) + return = pure m >>= k = ExceptT $ do a <- runExceptT m case a of diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Monad/Identity.hs new/foundation-0.0.29/Foundation/Monad/Identity.hs --- old/foundation-0.0.28/Foundation/Monad/Identity.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Monad/Identity.hs 2022-08-19 05:07:57.000000000 +0200 @@ -28,7 +28,7 @@ {-# INLINE (<*>) #-} instance Monad m => Monad (IdentityT m) where - return x = IdentityT (return x) + return = pure {-# INLINE return #-} ma >>= mb = IdentityT $ runIdentityT ma >>= runIdentityT . mb {-# INLINE (>>=) #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Monad/Reader.hs new/foundation-0.0.29/Foundation/Monad/Reader.hs --- old/foundation-0.0.28/Foundation/Monad/Reader.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Monad/Reader.hs 2022-08-19 05:22:36.000000000 +0200 @@ -34,7 +34,7 @@ {-# INLINE (<*>) #-} instance Monad m => Monad (ReaderT r m) where - return a = ReaderT $ const (return a) + return = pure {-# INLINE return #-} ma >>= mab = ReaderT $ \r -> runReaderT ma r >>= \a -> runReaderT (mab a) r {-# INLINE (>>=) #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Monad/State.hs new/foundation-0.0.29/Foundation/Monad/State.hs --- old/foundation-0.0.28/Foundation/Monad/State.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Monad/State.hs 2022-08-19 05:22:26.000000000 +0200 @@ -42,7 +42,7 @@ {-# INLINE (<*>) #-} instance (Functor m, Monad m) => Monad (StateT s m) where - return a = StateT $ \s -> (,s) `fmap` return a + return = pure {-# INLINE return #-} ma >>= mab = StateT $ runStateT ma >=> (\(a, s2) -> runStateT (mab a) s2) {-# INLINE (>>=) #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Monad.hs new/foundation-0.0.29/Foundation/Monad.hs --- old/foundation-0.0.28/Foundation/Monad.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Monad.hs 2022-08-19 05:36:56.000000000 +0200 @@ -20,7 +20,6 @@ import Foundation.Monad.Exception import Foundation.Monad.Transformer import Foundation.Numerical -import Control.Applicative (liftA2) #if MIN_VERSION_base(4,8,0) import Data.Functor.Identity @@ -66,5 +65,5 @@ where loop cnt | cnt <= 0 = pure [] - | otherwise = liftA2 (:) f (loop (cnt - 1)) + | otherwise = (:) <$> f <*> (loop (cnt - 1)) {-# INLINEABLE replicateM #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Network/IPv4.hs new/foundation-0.0.29/Foundation/Network/IPv4.hs --- old/foundation-0.0.28/Foundation/Network/IPv4.hs 2019-09-07 14:49:06.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Network/IPv4.hs 2022-08-19 05:20:53.000000000 +0200 @@ -12,6 +12,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} module Foundation.Network.IPv4 ( IPv4 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Network/IPv6.hs new/foundation-0.0.29/Foundation/Network/IPv6.hs --- old/foundation-0.0.28/Foundation/Network/IPv6.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Network/IPv6.hs 2022-08-19 05:21:25.000000000 +0200 @@ -8,6 +8,7 @@ -- IPv6 data type -- {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeOperators #-} module Foundation.Network.IPv6 ( IPv6 @@ -28,7 +29,6 @@ import Foundation.Class.Storable import Foundation.Hashing.Hashable -import Basement.Numerical.Additive (scale) import Basement.Compat.Base import Data.Proxy import Foundation.Primitive diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Parser.hs new/foundation-0.0.29/Foundation/Parser.hs --- old/foundation-0.0.28/Foundation/Parser.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Parser.hs 2022-08-19 05:10:50.000000000 +0200 @@ -24,6 +24,7 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeOperators #-} module Foundation.Parser ( Parser diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/Random/DRG.hs new/foundation-0.0.29/Foundation/Random/DRG.hs --- old/foundation-0.0.28/Foundation/Random/DRG.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/Random/DRG.hs 2022-08-19 05:11:10.000000000 +0200 @@ -44,7 +44,7 @@ in (f a, g3) instance Monad (MonadRandomState gen) where - return a = MonadRandomState $ \g -> (a, g) + return = pure (>>=) m1 m2 = MonadRandomState $ \g1 -> let (a, g2) = runRandomState m1 g1 in runRandomState (m2 a) g2 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/UUID.hs new/foundation-0.0.29/Foundation/UUID.hs --- old/foundation-0.0.28/Foundation/UUID.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/UUID.hs 2022-08-19 05:11:44.000000000 +0200 @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} module Foundation.UUID ( UUID(..) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/Foundation/VFS/FilePath.hs new/foundation-0.0.29/Foundation/VFS/FilePath.hs --- old/foundation-0.0.28/Foundation/VFS/FilePath.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/foundation-0.0.29/Foundation/VFS/FilePath.hs 2022-08-19 05:11:59.000000000 +0200 @@ -189,7 +189,6 @@ (<>) (FileName a) (FileName b) = FileName $ a `mappend` b instance Monoid FileName where mempty = FileName mempty - mappend (FileName a) (FileName b) = FileName $ a `mappend` b instance Path FilePath where type PathEnt FilePath = FileName diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/foundation-0.0.28/foundation.cabal new/foundation-0.0.29/foundation.cabal --- old/foundation-0.0.28/foundation.cabal 2022-03-03 04:08:44.000000000 +0100 +++ new/foundation-0.0.29/foundation.cabal 2022-08-19 06:33:54.000000000 +0200 @@ -1,5 +1,5 @@ name: foundation -version: 0.0.28 +version: 0.0.29 synopsis: Alternative prelude with batteries and no dependencies description: A custom prelude with no dependencies apart from base. @@ -196,7 +196,7 @@ BangPatterns DeriveDataTypeable - if impl(ghc < 8.8) || impl(ghcjs) + if impl(ghc < 8.10) || impl(ghcjs) buildable: False else build-depends: base @@ -206,7 +206,7 @@ if arch(i386) extra-libraries: gcc - build-depends: basement == 0.0.14 + build-depends: basement == 0.0.15 -- FIXME add suport for armel mipsel -- CPP-options: -DARCH_IS_LITTLE_ENDIAN
