From 08c93f3e6b285b7eaebfc0e17eded54cc09e7328 Mon Sep 17 00:00:00 2001 From: RyanGlScott Date: Wed, 13 Jan 2016 23:47:40 -0500 Subject: [PATCH] Functions/modules added in base-4.9 See the `CHANGES` file (or the `base-4.9.0.0` section of #24) for all of the changes made. --- .travis.yml | 3 + CHANGES.markdown | 13 +++- README.markdown | 39 ++++++++-- base-compat.cabal | 2 + check/Data.Complex.Compat.index | 8 --- check/Data.Complex.Compat.types | 8 --- check/TypeCheck.hs | 1 + .../Data.Ratio.Compat.check.hs} | 2 +- check/index/Control.Monad.Compat.index | 1 + check/index/Data.Ratio.Compat.index | 4 ++ check/index/Prelude.Compat.index | 1 + check/mk-index.sh | 1 + check/type-check.cabal | 2 +- check/types/Control.Monad.Compat.types | 23 +++--- check/types/Data.Ratio.Compat.types | 4 ++ check/types/Prelude.Compat.types | 1 + src/Control/Concurrent/Compat.hs | 15 ++++ src/Control/Monad/Compat.hs | 72 ++++++++++++++++++- src/Data/Functor/Const/Compat.hs | 4 ++ src/Data/Ratio/Compat.hs | 32 +++++++++ src/Debug/Trace/Compat.hs | 35 ++++++--- src/Prelude/Compat.hs | 21 ++++-- 22 files changed, 241 insertions(+), 51 deletions(-) delete mode 100644 check/Data.Complex.Compat.index delete mode 100644 check/Data.Complex.Compat.types rename check/{Data.Complex.Compat.check.hs => check-hs/Data.Ratio.Compat.check.hs} (66%) create mode 100644 check/index/Data.Ratio.Compat.index create mode 100644 check/types/Data.Ratio.Compat.types create mode 100644 src/Data/Functor/Const/Compat.hs create mode 100644 src/Data/Ratio/Compat.hs diff --git a/.travis.yml b/.travis.yml index d177acd..702952d 100644 --- a/.travis.yml +++ b/.travis.yml @@ -67,6 +67,9 @@ matrix: - env: CABALVER=1.22 GHCVER=7.10.3 compiler: ": #GHC 7.10.3" addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}} + - env: CABALVER=1.24 GHCVER=8.0.1 + compiler: ": #GHC 8.0.1" + addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}} - env: CABALVER=head GHCVER=head compiler: ": #GHC head" addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}} diff --git a/CHANGES.markdown b/CHANGES.markdown index 4cd1489..d3f049f 100644 --- a/CHANGES.markdown +++ b/CHANGES.markdown @@ -1,16 +1,25 @@ ## Changes in next + - Sync with `base-4.9`/GHC 8.0 - Weakened `RealFloat` constraints on `realPart`, `imagPart`, `conjugate`, `mkPolar`, and `cis` in `Data.Complex.Compat` - Backport `Foreign.ForeignPtr.Safe` and `Foreign.Marshal.Safe` + - Generalize `filterM`, `forever`, `mapAndUnzipM`, `zipWithM`, `zipWithM_`, + `replicateM`, and `replicateM_` in `Control.Monad` from `Monad` to + `Applicative` - Backport `.Unsafe.Compat` modules (for `Control.Monad.ST`, `Control.Monad.ST.Lazy`, `Foreign.ForeignPtr`, and `Foreign.Marshal`) - - Backport `forkFinally` to `Control.Concurrent.Compat` + - Backport `forkFinally` and `forkOSWithUnmask` to `Control.Concurrent.Compat` + - Backport `Data.Functor.Const` - Backport `modifyIORef'`, `atomicModifyIORef'` and `atomicWriteIORef` to `Data.IORef.Compat` + - `Data.Ratio.{denominator,numerator}` have no `Integral` constraint anymore - Backport `modifySTRef'` to `Data.STRef.Compat` - Export `String`, `lines`, `words`, `unlines`, and `unwords` to `Data.String.Compat` - - Backport `unsafeFixIO` and `unsafeDupablePerformIO` to `System.IO.Unsafe.IO` + - Generalize `Debug.Trace.{traceM, traceShowM}` from `Monad` to `Applicative` + - Backport `errorWithoutStackTrace` to `Prelude.Compat` + - Backport `unsafeFixIO` and `unsafeDupablePerformIO` to + `System.IO.Unsafe.Compat` ## Changes in 0.8.2 - Backport `bitDefault`, `testBitDefault`, and `popCountDefault` in diff --git a/README.markdown b/README.markdown index 184c107..35cc999 100644 --- a/README.markdown +++ b/README.markdown @@ -14,7 +14,7 @@ [tl;dr Legal: MIT]: https://tldrlegal.com/license/mit-license "MIT License" - + ## Scope The scope of `base-compat` is to provide functions available in later versions @@ -105,7 +105,7 @@ So far the following is covered. ### For compatibility with the latest released version of `base` * `Prelude.Compat` incorporates the AMP/Foldable/Traversable changes and - exposes the same interface as `Prelude` from `base-4.8.0.0` + exposes the same interface as `Prelude` from `base-4.9.0.0` * `System.IO.Error.catch` is not re-exported from `Prelude.Compat` for older versions of `base` * `Text.Read.Compat.readMaybe` @@ -200,18 +200,49 @@ compatibility packages on Hackage. Here is a list of such packages: * [`nats`](http://hackage.haskell.org/package/nats) for the [`Natural`](http://hackage.haskell.org/package/base-4.8.0.0/docs/Numeric-Natural.html) data type, introduced in `base-4.8.0.0` +* [`semigroups`](http://hackage.haskell.org/package/semigroups) + for the [`Semigroup`](http://hackage.haskell.org/package/base-4.9.0.0/docs/Data-Semigroup.html#t:Semigroup) + typeclass and the + [`NonEmpty`](http://hackage.haskell.org/package/base-4.9.0.0/docs/Data-List-NonEmpty.html#t:NonEmpty), + [`Min`](http://hackage.haskell.org/package/base-4.9.0.0/docs/Data-Semigroup.html#t:Min), + [`Max`](http://hackage.haskell.org/package/base-4.9.0.0/docs/Data-Semigroup.html#t:Max), + [`First`](http://hackage.haskell.org/package/base-4.9.0.0/docs/Data-Semigroup.html#t:First), + [`Last`](http://hackage.haskell.org/package/base-4.9.0.0/docs/Data-Semigroup.html#t:Last), + [`WrappedMonoid`](http://hackage.haskell.org/package/base-4.9.0.0/docs/Data-Semigroup.html#t:WrappedMonoid), + [`Option`](http://hackage.haskell.org/package/base-4.9.0.0/docs/Data-Semigroup.html#t:Option), + and + [`Arg`](http://hackage.haskell.org/package/base-4.9.0.0/docs/Data-Semigroup.html#t:Arg) + data types, introduced in `base-4.9.0.0` * [`tagged`](http://hackage.haskell.org/package/tagged) for the [`Proxy`](http://hackage.haskell.org/package/base-4.7.0.0/docs/Data-Proxy.html#t:Proxy) data type, introduced in `base-4.7.0.0` * [`transformers`](http://hackage.haskell.org/package/transformers) - for the [`Identity`](http://hackage.haskell.org/package/base-4.8.0.0/docs/Data-Functor-Identity.html#t:Identity) - data type, introduced in `base-4.8.0.0` + for: + * The [`Identity`](http://hackage.haskell.org/package/base-4.8.0.0/docs/Data-Functor-Identity.html#t:Identity) + data type, introduced in `base-4.8.0.0` + * The [`MonadIO`](http://hackage.haskell.org/package/base-4.9.0.0/docs/Control-Monad-IO-Class.html#t:MonadIO), + [`Eq1`](http://hackage.haskell.org/package/base-4.9.0.0/docs/Data-Functor-Classes.html#t:Eq1), + [`Eq2`](http://hackage.haskell.org/package/base-4.9.0.0/docs/Data-Functor-Classes.html#t:Eq2), + [`Ord1`](http://hackage.haskell.org/package/base-4.9.0.0/docs/Data-Functor-Classes.html#t:Ord1), + [`Ord2`](http://hackage.haskell.org/package/base-4.9.0.0/docs/Data-Functor-Classes.html#t:Ord2), + [`Read1`](http://hackage.haskell.org/package/base-4.9.0.0/docs/Data-Functor-Classes.html#t:Read1), + [`Read2`](http://hackage.haskell.org/package/base-4.9.0.0/docs/Data-Functor-Classes.html#t:Read2), + [`Show1`](http://hackage.haskell.org/package/base-4.9.0.0/docs/Data-Functor-Classes.html#t:Show1), + and + [`Show2`](http://hackage.haskell.org/package/base-4.9.0.0/docs/Data-Functor-Classes.html#t:Show2) + typeclasses; and the + [`Compose`](http://hackage.haskell.org/package/base-4.9.0.0/docs/Data-Functor-Compose.html#t:Compose), + [`Product`](http://hackage.haskell.org/package/base-4.9.0.0/docs/Data-Functor-Product.html#t:Product), + and + [`Sum`](http://hackage.haskell.org/package/base-4.9.0.0/docs/Data-Functor-Sum.html#t:Sum) + data types, introduced in `base-4.9.0.0` * [`void`](http://hackage.haskell.org/package/void) for the [`Void`](http://hackage.haskell.org/package/base-4.8.0.0/docs/Data-Void.html#t:Void) data type, introduced in `base-4.8.0.0` ## Supported versions of GHC/`base` + * `ghc-8.0.1` / `base-4.9.0.0` * `ghc-7.10.3` / `base-4.8.2.0` * `ghc-7.10.2` / `base-4.8.1.0` * `ghc-7.10.1` / `base-4.8.0.0` diff --git a/base-compat.cabal b/base-compat.cabal index 0fc5a1c..ddfd7ab 100644 --- a/base-compat.cabal +++ b/base-compat.cabal @@ -70,9 +70,11 @@ library Data.Foldable.Compat Data.Function.Compat Data.Functor.Compat + Data.Functor.Const.Compat Data.IORef.Compat Data.List.Compat Data.Monoid.Compat + Data.Ratio.Compat Data.STRef.Compat Data.String.Compat Data.Version.Compat diff --git a/check/Data.Complex.Compat.index b/check/Data.Complex.Compat.index deleted file mode 100644 index 345f6fb..0000000 --- a/check/Data.Complex.Compat.index +++ /dev/null @@ -1,8 +0,0 @@ -cis -conjugate -imagPart -magnitude -mkPolar -phase -polar -realPart diff --git a/check/Data.Complex.Compat.types b/check/Data.Complex.Compat.types deleted file mode 100644 index ff20dd1..0000000 --- a/check/Data.Complex.Compat.types +++ /dev/null @@ -1,8 +0,0 @@ -cis :: GHC.Float.Floating a => a -> Complex a -conjugate :: GHC.Num.Num a => Complex a -> Complex a -imagPart :: Complex a -> a -magnitude :: GHC.Float.RealFloat a => Complex a -> a -mkPolar :: GHC.Float.Floating a => a -> a -> Complex a -phase :: GHC.Float.RealFloat a => Complex a -> a -polar :: GHC.Float.RealFloat a => Complex a -> (a, a) -realPart :: Complex a -> a diff --git a/check/TypeCheck.hs b/check/TypeCheck.hs index 1f04879..7d0a14b 100644 --- a/check/TypeCheck.hs +++ b/check/TypeCheck.hs @@ -34,6 +34,7 @@ modules = do excluded = [ #if !(MIN_VERSION_base(4,4,0)) "Data.Complex.Compat" + , "Data.Ratio.Compat" #endif ] diff --git a/check/Data.Complex.Compat.check.hs b/check/check-hs/Data.Ratio.Compat.check.hs similarity index 66% rename from check/Data.Complex.Compat.check.hs rename to check/check-hs/Data.Ratio.Compat.check.hs index d23fbc9..73537e4 100644 --- a/check/Data.Complex.Compat.check.hs +++ b/check/check-hs/Data.Ratio.Compat.check.hs @@ -1,3 +1,3 @@ {-# LANGUAGE NoImplicitPrelude #-} module Test where -import Data.Complex.Compat +import Data.Ratio.Compat diff --git a/check/index/Control.Monad.Compat.index b/check/index/Control.Monad.Compat.index index 1a379c4..b73d91c 100644 --- a/check/index/Control.Monad.Compat.index +++ b/check/index/Control.Monad.Compat.index @@ -13,6 +13,7 @@ foldM_ forever forM forM_ +(GHC.Base.<$) guard join liftM diff --git a/check/index/Data.Ratio.Compat.index b/check/index/Data.Ratio.Compat.index new file mode 100644 index 0000000..7ae5bb6 --- /dev/null +++ b/check/index/Data.Ratio.Compat.index @@ -0,0 +1,4 @@ +(%) +approxRational +denominator +numerator diff --git a/check/index/Prelude.Compat.index b/check/index/Prelude.Compat.index index 4b34bcd..e439572 100644 --- a/check/index/Prelude.Compat.index +++ b/check/index/Prelude.Compat.index @@ -63,6 +63,7 @@ enumFromThenTo enumFromTo EQ error +errorWithoutStackTrace even exp exponent diff --git a/check/mk-index.sh b/check/mk-index.sh index 48b1bc0..43718da 100755 --- a/check/mk-index.sh +++ b/check/mk-index.sh @@ -7,3 +7,4 @@ runhaskell dumpindex.hs Control.Monad.Compat | sort > index/Control.Monad.Compat runhaskell dumpindex.hs Data.Complex.Compat | sort > index/Data.Complex.Compat.index runhaskell dumpindex.hs Data.Foldable.Compat | sort > index/Data.Foldable.Compat.index runhaskell dumpindex.hs Data.List.Compat | sort > index/Data.List.Compat.index +runhaskell dumpindex.hs Data.Ratio.Compat | sort > index/Data.Ratio.Compat.index diff --git a/check/type-check.cabal b/check/type-check.cabal index 5879736..d8c6e0c 100644 --- a/check/type-check.cabal +++ b/check/type-check.cabal @@ -50,4 +50,4 @@ test-suite type-check-test , hspec >= 1.8 , HUnit >= 1.2.5 , process >= 1.0.1.1 - , temporary-rc + , temporary diff --git a/check/types/Control.Monad.Compat.types b/check/types/Control.Monad.Compat.types index c7073c1..5c7f7d7 100644 --- a/check/types/Control.Monad.Compat.types +++ b/check/types/Control.Monad.Compat.types @@ -6,34 +6,35 @@ (>>) :: Monad m => m a -> m b -> m b ap :: Monad m => m (a -> b) -> m a -> m b fail :: Monad m => GHC.Base.String -> m a -filterM :: Monad m => (a -> m GHC.Types.Bool) -> [a] -> m [a] +filterM :: GHC.Base.Applicative m => (a -> m GHC.Types.Bool) -> [a] -> m [a] fmap :: Functor f => (a -> b) -> f a -> f b foldM :: (Monad m, Data.Foldable.Foldable t) => (b -> a -> m b) -> b -> t a -> m b foldM_ :: (Monad m, Data.Foldable.Foldable t) => (b -> a -> m b) -> b -> t a -> m () -forever :: Monad m => m a -> m b +forever :: GHC.Base.Applicative f => f a -> f b forM :: (Monad m, Data.Traversable.Traversable t) => t a -> (a -> m b) -> m (t b) forM_ :: (Monad m, Data.Foldable.Foldable t) => t a -> (a -> m b) -> m () -guard :: Control.Applicative.Alternative f => GHC.Types.Bool -> f () +(GHC.Base.<$) :: Functor f => a -> f b -> f a +guard :: GHC.Base.Alternative f => GHC.Types.Bool -> f () join :: Monad m => m (m a) -> m a liftM :: Monad m => (a1 -> r) -> m a1 -> m r liftM2 :: Monad m => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r liftM3 :: Monad m => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r liftM4 :: Monad m => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r liftM5 :: Monad m => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r -mapAndUnzipM :: Monad m => (a -> m (b, c)) -> [a] -> m ([b], [c]) +mapAndUnzipM :: GHC.Base.Applicative m => (a -> m (b, c)) -> [a] -> m ([b], [c]) mapM :: (Monad m, Data.Traversable.Traversable t) => (a -> m b) -> t a -> m (t b) mapM_ :: (Monad m, Data.Foldable.Foldable t) => (a -> m b) -> t a -> m () mfilter :: MonadPlus m => (a -> GHC.Types.Bool) -> m a -> m a mplus :: MonadPlus m => m a -> m a -> m a -msum :: (MonadPlus m, Data.Foldable.Foldable t) => t (m a) -> m a +msum :: (Data.Foldable.Foldable t, MonadPlus m) => t (m a) -> m a mzero :: MonadPlus m => m a -replicateM :: Monad m => GHC.Types.Int -> m a -> m [a] -replicateM_ :: Monad m => GHC.Types.Int -> m a -> m () +replicateM :: GHC.Base.Applicative m => GHC.Types.Int -> m a -> m [a] +replicateM_ :: GHC.Base.Applicative m => GHC.Types.Int -> m a -> m () return :: Monad m => a -> m a sequence :: (Monad m, Data.Traversable.Traversable t) => t (m a) -> m (t a) sequence_ :: (Monad m, Data.Foldable.Foldable t) => t (m a) -> m () -unless :: Control.Applicative.Applicative f => GHC.Types.Bool -> f () -> f () +unless :: GHC.Base.Applicative f => GHC.Types.Bool -> f () -> f () void :: Functor f => f a -> f () -when :: Control.Applicative.Applicative f => GHC.Types.Bool -> f () -> f () -zipWithM :: Monad m => (a -> b -> m c) -> [a] -> [b] -> m [c] -zipWithM_ :: Monad m => (a -> b -> m c) -> [a] -> [b] -> m () +when :: GHC.Base.Applicative f => GHC.Types.Bool -> f () -> f () +zipWithM :: GHC.Base.Applicative m => (a -> b -> m c) -> [a] -> [b] -> m [c] +zipWithM_ :: GHC.Base.Applicative m => (a -> b -> m c) -> [a] -> [b] -> m () diff --git a/check/types/Data.Ratio.Compat.types b/check/types/Data.Ratio.Compat.types new file mode 100644 index 0000000..0ec24f8 --- /dev/null +++ b/check/types/Data.Ratio.Compat.types @@ -0,0 +1,4 @@ +(%) :: GHC.Real.Integral a => a -> a -> Ratio a +approxRational :: GHC.Real.RealFrac a => a -> a -> Rational +denominator :: Ratio a -> a +numerator :: Ratio a -> a diff --git a/check/types/Prelude.Compat.types b/check/types/Prelude.Compat.types index 3489b9d..0076388 100644 --- a/check/types/Prelude.Compat.types +++ b/check/types/Prelude.Compat.types @@ -63,6 +63,7 @@ enumFromThenTo :: Enum a => a -> a -> a -> [a] enumFromTo :: Enum a => a -> a -> [a] EQ :: Ordering error :: [Char] -> a +errorWithoutStackTrace :: [Char] -> a even :: Integral a => a -> Bool exp :: Floating a => a -> a exponent :: RealFloat a => a -> Int diff --git a/src/Control/Concurrent/Compat.hs b/src/Control/Concurrent/Compat.hs index 128c8d0..af81065 100644 --- a/src/Control/Concurrent/Compat.hs +++ b/src/Control/Concurrent/Compat.hs @@ -1,15 +1,23 @@ {-# LANGUAGE CPP, NoImplicitPrelude #-} +{-# LANGUAGE RankNTypes #-} module Control.Concurrent.Compat ( module Base , forkFinally +, forkOSWithUnmask ) where import Control.Concurrent as Base #if !(MIN_VERSION_base(4,6,0)) import Control.Exception +#endif + +#if !(MIN_VERSION_base(4,9,0)) +import GHC.IO (unsafeUnmask) import Prelude +#endif +#if !(MIN_VERSION_base(4,6,0)) -- | fork a thread and call the supplied function when the thread is about -- to terminate, with an exception or a returned value. The function is -- called with asynchronous exceptions masked. @@ -27,3 +35,10 @@ forkFinally action and_then = mask $ \restore -> forkIO $ try (restore action) >>= and_then #endif + +#if !(MIN_VERSION_base(4,9,0)) +-- | Like 'forkIOWithUnmask', but the child thread is a bound thread, +-- as with 'forkOS'. +forkOSWithUnmask :: ((forall a . IO a -> IO a) -> IO ()) -> IO ThreadId +forkOSWithUnmask io = forkOS (io unsafeUnmask) +#endif diff --git a/src/Control/Monad/Compat.hs b/src/Control/Monad/Compat.hs index 19114b4..5436b9d 100644 --- a/src/Control/Monad/Compat.hs +++ b/src/Control/Monad/Compat.hs @@ -19,13 +19,30 @@ module Control.Monad.Compat ( , (<$!>) #endif +#if !(MIN_VERSION_base(4,9,0)) +, forever +, filterM +, mapAndUnzipM +, zipWithM +, zipWithM_ +, replicateM +, replicateM_ +#endif ) where -#if MIN_VERSION_base(4,8,0) +#if MIN_VERSION_base(4,9,0) import Control.Monad as Base #else import Control.Monad as Base hiding ( - foldM + forever + , filterM + , mapAndUnzipM + , zipWithM + , zipWithM_ + , replicateM + , replicateM_ +# if !(MIN_VERSION_base(4,8,0)) + , foldM , foldM_ , forM , forM_ @@ -37,8 +54,9 @@ import Control.Monad as Base hiding ( , sequence_ , unless , when +# endif ) -import Control.Applicative (Alternative(..)) +import Control.Applicative import Data.Foldable.Compat import Data.Traversable import Prelude.Compat @@ -116,3 +134,51 @@ f <$!> m = do let z = f x z `seq` return z #endif + +#if !(MIN_VERSION_base(4,9,0)) +-- | @'forever' act@ repeats the action infinitely. +forever :: (Applicative f) => f a -> f b +{-# INLINE forever #-} +forever a = let a' = a *> a' in a' +-- Use explicit sharing here, as it is prevents a space leak regardless of +-- optimizations. + +-- | This generalizes the list-based 'filter' function. +{-# INLINE filterM #-} +filterM :: (Applicative m) => (a -> m Bool) -> [a] -> m [a] +filterM p = foldr (\ x -> liftA2 (\ flg -> if flg then (x:) else id) (p x)) (pure []) + +-- | The 'mapAndUnzipM' function maps its first argument over a list, returning +-- the result as a pair of lists. This function is mainly used with complicated +-- data structures or a state-transforming monad. +mapAndUnzipM :: (Applicative m) => (a -> m (b,c)) -> [a] -> m ([b], [c]) +{-# INLINE mapAndUnzipM #-} +mapAndUnzipM f xs = unzip <$> traverse f xs + +-- | The 'zipWithM' function generalizes 'zipWith' to arbitrary applicative functors. +zipWithM :: (Applicative m) => (a -> b -> m c) -> [a] -> [b] -> m [c] +{-# INLINE zipWithM #-} +zipWithM f xs ys = sequenceA (zipWith f xs ys) + +-- | 'zipWithM_' is the extension of 'zipWithM' which ignores the final result. +zipWithM_ :: (Applicative m) => (a -> b -> m c) -> [a] -> [b] -> m () +{-# INLINE zipWithM_ #-} +zipWithM_ f xs ys = sequenceA_ (zipWith f xs ys) + +-- | @'replicateM' n act@ performs the action @n@ times, +-- gathering the results. +replicateM :: (Applicative m) => Int -> m a -> m [a] +{-# INLINEABLE replicateM #-} +{-# SPECIALISE replicateM :: Int -> IO a -> IO [a] #-} +{-# SPECIALISE replicateM :: Int -> Maybe a -> Maybe [a] #-} +replicateM 0 _ = pure [] +replicateM n x = liftA2 (:) x (replicateM (pred n) x) + +-- | Like 'replicateM', but discards the result. +replicateM_ :: (Applicative m) => Int -> m a -> m () +{-# INLINEABLE replicateM_ #-} +{-# SPECIALISE replicateM_ :: Int -> IO a -> IO () #-} +{-# SPECIALISE replicateM_ :: Int -> Maybe a -> Maybe () #-} +replicateM_ 0 _ = pure () +replicateM_ n x = x *> replicateM_ (pred n) x +#endif diff --git a/src/Data/Functor/Const/Compat.hs b/src/Data/Functor/Const/Compat.hs new file mode 100644 index 0000000..483863e --- /dev/null +++ b/src/Data/Functor/Const/Compat.hs @@ -0,0 +1,4 @@ +{-# LANGUAGE CPP, NoImplicitPrelude #-} +module Data.Functor.Const.Compat (Const(..)) where + +import Control.Applicative (Const(..)) diff --git a/src/Data/Ratio/Compat.hs b/src/Data/Ratio/Compat.hs new file mode 100644 index 0000000..294b14f --- /dev/null +++ b/src/Data/Ratio/Compat.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE CPP, NoImplicitPrelude #-} +module Data.Ratio.Compat ( + module Base +#if MIN_VERSION_base(4,4,0) && !(MIN_VERSION_base(4,9,0)) +, denominator +, numerator +#endif +) where + +#if !(MIN_VERSION_base(4,4,0)) || MIN_VERSION_base(4,9,0) +import Data.Ratio as Base +#else +import Data.Ratio as Base hiding ( + denominator + , numerator + ) +import GHC.Real (Ratio(..)) +#endif + +#if MIN_VERSION_base(4,4,0) && !(MIN_VERSION_base(4,9,0)) +-- | Extract the numerator of the ratio in reduced form: +-- the numerator and denominator have no common factor and the denominator +-- is positive. +numerator :: Ratio a -> a +numerator (x :% _) = x + +-- | Extract the denominator of the ratio in reduced form: +-- the numerator and denominator have no common factor and the denominator +-- is positive. +denominator :: Ratio a -> a +denominator (_ :% y) = y +#endif diff --git a/src/Debug/Trace/Compat.hs b/src/Debug/Trace/Compat.hs index 522659a..b1bbf06 100644 --- a/src/Debug/Trace/Compat.hs +++ b/src/Debug/Trace/Compat.hs @@ -6,11 +6,20 @@ module Debug.Trace.Compat ( , traceM , traceShowM ) where +#if !(MIN_VERSION_base(4,7,0)) import Debug.Trace as Base +#else +import Debug.Trace as Base hiding ( + traceM + , traceShowM + ) +#endif -#if !(MIN_VERSION_base(4,7,0)) +#if !(MIN_VERSION_base(4,9,0)) import Prelude.Compat +#endif +#if !(MIN_VERSION_base(4,7,0)) {-| Like 'trace' but returns the message instead of a third value. @@ -26,11 +35,19 @@ Like 'traceShow' but returns the shown value instead of a third value. -} traceShowId :: (Show a) => a -> a traceShowId a = trace (show a) a +#endif +#if !(MIN_VERSION_base(4,9,0)) {-| -Like 'trace' but returning unit in an arbitrary monad. Allows for convenient -use in do-notation. Note that the application of 'trace' is not an action in the -monad, as 'traceIO' is in the 'IO' monad. +Like 'trace' but returning unit in an arbitrary 'Applicative' context. Allows +for convenient use in do-notation. + +Note that the application of 'traceM' is not an action in the 'Applicative' +context, as 'traceIO' is in the 'IO' type. While the fresh bindings in the +following example will force the 'traceM' expressions to be reduced every time +the @do@-block is executed, @traceM "not crashed"@ would only be reduced once, +and the message would only be printed once. If your monad is in 'MonadIO', +@liftIO . traceIO@ may be a better option. > ... = do > x <- ... @@ -40,20 +57,20 @@ monad, as 'traceIO' is in the 'IO' monad. /Since: 4.7.0.0/ -} -traceM :: (Monad m) => String -> m () -traceM string = trace string $ return () +traceM :: (Applicative f) => String -> f () +traceM string = trace string $ pure () {-| Like 'traceM', but uses 'show' on the argument to convert it to a 'String'. > ... = do > x <- ... -> traceMShow $ x +> traceShowM $ x > y <- ... -> traceMShow $ x + y +> traceShowM $ x + y /Since: 4.7.0.0/ -} -traceShowM :: (Show a, Monad m) => a -> m () +traceShowM :: (Show a, Applicative f) => a -> f () traceShowM = traceM . show #endif diff --git a/src/Prelude/Compat.hs b/src/Prelude/Compat.hs index fb14619..9573422 100644 --- a/src/Prelude/Compat.hs +++ b/src/Prelude/Compat.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP, NoImplicitPrelude #-} module Prelude.Compat ( -#if MIN_VERSION_base(4,8,0) +#if MIN_VERSION_base(4,9,0) module Base #else either @@ -101,6 +101,7 @@ module Prelude.Compat ( , (||) , ($) , error +, errorWithoutStackTrace , undefined , seq @@ -257,7 +258,7 @@ module Prelude.Compat ( ) where -#if MIN_VERSION_base(4,8,0) +#if MIN_VERSION_base(4,9,0) import Prelude as Base @@ -290,9 +291,21 @@ import Prelude hiding ( , sum ) -import Data.Word import Data.Foldable.Compat import Data.Traversable -import Data.Monoid + +# if !(MIN_VERSION_base(4,8,0)) import Control.Applicative +import Data.Monoid +import Data.Word +# endif +#endif + +#if !(MIN_VERSION_base(4,9,0)) +-- | A variant of 'error' that does not produce a stack trace. +-- +-- /Since: 4.9.0.0/ +errorWithoutStackTrace :: [Char] -> a +errorWithoutStackTrace s = error s +{-# NOINLINE errorWithoutStackTrace #-} #endif