diff --git a/CHANGES.markdown b/CHANGES.markdown --- a/CHANGES.markdown +++ b/CHANGES.markdown @@ -1,3 +1,15 @@ +## Changes in 0.6 [2017.04.10] + - Backported new instances from GHC 8.2/`base-4.10` + (see https://github.com/haskell-compat/base-orphans/issues/39): + * `Data` instance for `Const` + * `Eq1`, `Ord1`, `Read1`, and `Show1` instances for `NonEmpty` + * `Semigroup` instances for `IO`, `Event`, and `Lifetime` + - Backported `Typeable` instances for `(:+:)`, `(:*:)`, `(:.:)`, `M1`, `Rec1`, + `ArrowMonad`, `Kleisli`, `WrappedArrow`, `WrappedMonad`, and `Any` on GHC + 7.6 and earlier + - Backported `Data` instances for `(:+:)`, `(:*:)`, `(:.:)`, `M1`, and `Rec1` + on GHC 7.6 and earlier + ## Changes in 0.5.4 - Backported `Bits`, `FiniteBits`, `Floating`, `Fractional`, `Integral`, `IsString`, `Num`, `Real`, `RealFloat`, and `RealFrac` instances for diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2015-2016 Simon Hengel , João Cristóvão , Ryan Scott +Copyright (c) 2015-2017 Simon Hengel , João Cristóvão , Ryan Scott Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -40,13 +40,14 @@ * `Bits` instance for `Bool` * `Bits`, `Bounded`, and `Integral` instances for `CDev` * `Bits`, `Bounded`, `Enum`, `FiniteBits`, `Floating`, `Fractional`, `Integral`, `IsString`, `Ix`, `Num`, `Real`, `RealFloat`, `RealFrac`, and `Storable` instances for `Const` and `Identity` - * `Data` instances for `All` and `Any` + * `Data` instances for `All`, `Any`, and `Const` * `Data`, `MonadFix` and `MonadZip` instances for `Alt`, `Dual`, `First`, `Last`, `Product`, and `Sum` * `Data` and `IsList` instances for `Version` * `Eq` and `Ord` instances for `Control.Exception.ErrorCall` * `Eq`, `Ord`, `Read`, and `Show` instances for data types in `GHC.Generics` * `Eq`, `Ord`, `Read`, `Show`, `Foldable`, and `Traversable` instances for `ZipList` + * `Eq1`, `Ord1`, `Read1`, and `Show1` instances for `NonEmpty` * `Foldable` instance for `Either`, `(,)` and `Const` * `Functor` instance for `Handler`, `ArgOrder`, `OptDescr`, and `ArgDescr` * `Functor`, `Applicative`, `Alternative`, and `MonadPlus` instances for `ArrowMonad` @@ -58,6 +59,7 @@ * `Num` instance for `Sum` and `Product` * `Read` instance for `Fixed` * `Read` and `Show` instances for `Down` + * `Semigroup` instances for `IO`, `Event` and `Lifetime` * `Show` instance for `Fingerprint` * `Storable` instance for `()`, `Complex`, and `Ratio` * `Traversable` instance for `Either`, `(,)` and `Const` @@ -76,6 +78,8 @@ ## Supported versions of GHC/`base` + * `ghc-8.2.1` / `base-4.10.0.0` + * `ghc-8.0.2` / `base-4.9.1.0` * `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` diff --git a/base-orphans.cabal b/base-orphans.cabal --- a/base-orphans.cabal +++ b/base-orphans.cabal @@ -1,9 +1,9 @@ --- This file has been generated from package.yaml by hpack version 0.12.0. +-- This file has been generated from package.yaml by hpack version 0.17.0. -- -- see: https://github.com/sol/hpack name: base-orphans -version: 0.5.4 +version: 0.6 synopsis: Backwards-compatible orphan instances for base description: @base-orphans@ defines orphan instances that mimic instances available in later versions of @base@ to a wider (older) range of compilers. @base-orphans@ does not export anything except the orphan instances themselves and complements @@. See the README for what instances are covered: . See also the section. @@ -16,9 +16,9 @@ maintainer: Simon Hengel , João Cristóvão , Ryan Scott -copyright: (c) 2012-2016 Simon Hengel, - (c) 2014-2016 João Cristóvão, - (c) 2015-2016 Ryan Scott +copyright: (c) 2012-2017 Simon Hengel, + (c) 2014-2017 João Cristóvão, + (c) 2015-2017 Ryan Scott license: MIT license-file: LICENSE build-type: Simple diff --git a/src/Data/Orphans.hs b/src/Data/Orphans.hs --- a/src/Data/Orphans.hs +++ b/src/Data/Orphans.hs @@ -24,6 +24,10 @@ {-# LANGUAGE NullaryTypeClasses #-} #endif +#if __GLASGOW_HASKELL__ >= 800 +{-# LANGUAGE TypeInType #-} +#endif + {-# OPTIONS_GHC -fno-warn-deprecations #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-| @@ -65,7 +69,7 @@ # endif #endif -#if !(MIN_VERSION_base(4,9,0)) +#if !(MIN_VERSION_base(4,10,0)) import Data.Orphans.Prelude #endif @@ -877,17 +881,15 @@ empty = Comp1 empty Comp1 x <|> Comp1 y = Comp1 (x <|> y) -# if MIN_VERSION_base(4,7,0) -deriving instance (Data (f p), Typeable f, Data p) => Data (Rec1 f p) -deriving instance (Data p, Data (f p), Typeable c, Typeable i, Typeable f) +deriving instance (Data (f p), Typeable1 f, Data p) => Data (Rec1 f p) +deriving instance (Data p, Data (f p), Typeable c, Typeable i, Typeable1 f) => Data (M1 i c f p) -deriving instance (Typeable f, Typeable g, Data p, Data (f p), Data (g p)) +deriving instance (Typeable1 f, Typeable1 g, Data p, Data (f p), Data (g p)) => Data ((f :+: g) p) -deriving instance (Typeable f, Typeable g, Data p, Data (f p), Data (g p)) +deriving instance (Typeable1 f, Typeable1 g, Data p, Data (f p), Data (g p)) => Data ((f :*: g) p) -deriving instance (Typeable f, Typeable g, Data p, Data (f (g p))) +deriving instance (Typeable1 f, Typeable1 g, Data p, Data (f (g p))) => Data ((f :.: g) p) -# endif # if MIN_VERSION_base(4,8,0) instance Bifunctor (K1 i) where @@ -896,6 +898,46 @@ # endif #endif +#if !(MIN_VERSION_base(4,10,0)) +# if MIN_VERSION_base(4,9,0) +deriving instance (Typeable k, Data a, Typeable (b :: k)) => Data (Const a b) +# else +deriving instance (Data a, Data b) => Data (Const a b) +# endif + +# if MIN_VERSION_base(4,9,0) +instance Eq1 NonEmpty where + liftEq eq (a :| as) (b :| bs) = eq a b && liftEq eq as bs + +instance Ord1 NonEmpty where + liftCompare cmp (a :| as) (b :| bs) = cmp a b <> liftCompare cmp as bs + +instance Read1 NonEmpty where + liftReadsPrec rdP rdL p s = readParen (p > 5) (\s' -> do + (a, s'') <- rdP 6 s' + (":|", s''') <- lex s'' + (as, s'''') <- rdL s''' + return (a :| as, s'''')) s + +instance Show1 NonEmpty where + liftShowsPrec shwP shwL p (a :| as) = showParen (p > 5) $ + shwP 6 a . showString " :| " . shwL as + +instance Semigroup a => Semigroup (IO a) where + (<>) = liftA2 (<>) + +# if !defined(mingw32_HOST_OS) && !defined(ghcjs_HOST_OS) +instance Semigroup Event where + (<>) = mappend + stimes = stimesMonoid + +instance Semigroup Lifetime where + (<>) = mappend + stimes = stimesMonoid +# endif +# endif +#endif + #if __GLASGOW_HASKELL__ < 710 deriving instance Typeable All deriving instance Typeable AnnotationWrapper @@ -984,6 +1026,83 @@ deriving instance Typeable S deriving instance Typeable1 U1 deriving instance Typeable1 V1 + +# if __GLASGOW_HASKELL__ >= 708 +-- Data types which use poly-kinded Typeable... +deriving instance Typeable (:+:) +deriving instance Typeable (:*:) +deriving instance Typeable (:.:) +deriving instance Typeable M1 +deriving instance Typeable Rec1 +# else +-- ...but we can hack around that if need be. +instance (Typeable1 f, Typeable1 g) => Typeable1 (f :+: g) where + typeOf1 t = mkTyConApp conSumTyCon [typeOf1 (f t), typeOf1 (g t)] + where + f :: (f :+: g) p -> f p + f = undefined + + g :: (f :+: g) p -> g p + g = undefined + +conSumTyCon :: TyCon +conSumTyCon = mkTyCon3 ghcGenericsPackage "GHC.Generics" ":+:" + +instance (Typeable1 f, Typeable1 g) => Typeable1 (f :*: g) where + typeOf1 t = mkTyConApp conProductTyCon [typeOf1 (f t), typeOf1 (g t)] + where + f :: (f :*: g) p -> f p + f = undefined + + g :: (f :*: g) p -> g p + g = undefined + +conProductTyCon :: TyCon +conProductTyCon = mkTyCon3 ghcGenericsPackage "GHC.Generics" ":*:" + +instance (Typeable1 f, Typeable1 g) => Typeable1 (f :.: g) where + typeOf1 t = mkTyConApp conComposeTyCon [typeOf1 (f t), typeOf1 (g t)] + where + f :: (f :.: g) p -> f p + f = undefined + + g :: (f :.: g) p -> g p + g = undefined + +conComposeTyCon :: TyCon +conComposeTyCon = mkTyCon3 ghcGenericsPackage "GHC.Generics" ":.:" + +instance (Typeable i, Typeable c, Typeable1 f) => Typeable1 (M1 i c f) where + typeOf1 t = mkTyConApp m1TyCon [typeOf (i t), typeOf (c t), typeOf1 (f t)] + where + i :: M1 i c f p -> i + i = undefined + + c :: M1 i c f p -> c + c = undefined + + f :: M1 i c f p -> f p + f = undefined + +m1TyCon :: TyCon +m1TyCon = mkTyCon3 ghcGenericsPackage "GHC.Generics" "M1" + +instance Typeable1 f => Typeable1 (Rec1 f) where + typeOf1 t = mkTyConApp rec1TyCon [typeOf1 (f t)] + where + f :: Rec1 f a -> f a + f = undefined + +rec1TyCon :: TyCon +rec1TyCon = mkTyCon3 ghcGenericsPackage "GHC.Generics" "Rec1" + +ghcGenericsPackage :: String +# if MIN_VERSION_base(4,6,0) +ghcGenericsPackage = "base" +# else +ghcGenericsPackage = "ghc-prim" +# endif +# endif # endif # if MIN_VERSION_base(4,5,0) @@ -1019,6 +1138,80 @@ # endif # if __GLASGOW_HASKELL__ >= 708 +-- Data types which use poly-kinded Typeable... +deriving instance Typeable ArrowMonad +deriving instance Typeable Kleisli +deriving instance Typeable WrappedArrow +deriving instance Typeable WrappedMonad +deriving instance Typeable Exts.Any +# else +-- ...but we can hack around that if need be. +instance Typeable2 a => Typeable1 (ArrowMonad a) where + typeOf1 t = mkTyConApp arrowMonadTyCon [typeOf2 (a t)] + where + a :: ArrowMonad a b -> a () b + a = undefined + +arrowMonadTyCon :: TyCon +# if MIN_VERSION_base(4,4,0) +arrowMonadTyCon = mkTyCon3 "base" "Control.Arrow" "ArrowMonad" +# else +arrowMonadTyCon = mkTyCon "Control.Arrow.ArrowMonad" +# endif + +instance Typeable1 m => Typeable2 (Kleisli m) where + typeOf2 t = mkTyConApp kleisliTyCon [typeOf1 (m t)] + where + m :: Kleisli m a b -> m b + m = undefined + +kleisliTyCon :: TyCon +# if MIN_VERSION_base(4,4,0) +kleisliTyCon = mkTyCon3 "base" "Control.Arrow" "Kleisli" +# else +kleisliTyCon = mkTyCon "Control.Arrow.Kleisli" +# endif + +instance Typeable2 a => Typeable2 (WrappedArrow a) where + typeOf2 t = mkTyConApp wrappedArrowTyCon [typeOf2 (a t)] + where + a :: WrappedArrow a b c -> a b c + a = undefined + +wrappedArrowTyCon :: TyCon +# if MIN_VERSION_base(4,4,0) +wrappedArrowTyCon = mkTyCon3 "base" "Control.Applicative" "WrappedArrow" +# else +wrappedArrowTyCon = mkTyCon "Control.Applicative.WrappedArrow" +# endif + +instance Typeable1 m => Typeable1 (WrappedMonad m) where + typeOf1 t = mkTyConApp wrappedMonadTyCon [typeOf1 (m t)] + where + m :: WrappedMonad m a -> m a + m = undefined + +wrappedMonadTyCon :: TyCon +# if MIN_VERSION_base(4,4,0) +wrappedMonadTyCon = mkTyCon3 "base" "Control.Applicative" "WrappedMonad" +# else +wrappedMonadTyCon = mkTyCon "Control.Applicative.WrappedMonad" +# endif + +-- GHC will get confused if you try deriving a Typeable instance for Any +-- prior to GHC 7.8, sadly +instance Typeable Exts.Any where + typeOf _ = mkTyConApp anyTyCon [] + +anyTyCon :: TyCon +# if MIN_VERSION_base(4,4,0) +anyTyCon = mkTyCon3 "ghc-prim" "GHC.Prim" "Any" +# else +anyTyCon = mkTyCon "GHC.Prim.Any" +# endif +# endif + +# if __GLASGOW_HASKELL__ >= 708 -- Data types which have more than seven type arguments deriving instance Typeable (,,,,,,,) deriving instance Typeable (,,,,,,,,) @@ -1075,18 +1268,6 @@ deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) deriving instance Typeable (,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) - --- Data types which require PolyKinds -deriving instance Typeable (:+:) -deriving instance Typeable (:*:) -deriving instance Typeable (:.:) -deriving instance Typeable Exts.Any -deriving instance Typeable ArrowMonad -deriving instance Typeable Kleisli -deriving instance Typeable M1 -deriving instance Typeable Rec1 -deriving instance Typeable WrappedArrow -deriving instance Typeable WrappedMonad -- Typeclasses deriving instance Typeable Arrow diff --git a/src/Data/Orphans/Prelude.hs b/src/Data/Orphans/Prelude.hs --- a/src/Data/Orphans/Prelude.hs +++ b/src/Data/Orphans/Prelude.hs @@ -1,4 +1,9 @@ {-# LANGUAGE CPP #-} + +#if __GLASGOW_HASKELL__ >= 706 +{-# LANGUAGE ExplicitNamespaces #-} +#endif + {-# OPTIONS_GHC -fno-warn-deprecations #-} {-| @@ -10,7 +15,7 @@ Note that this module does not export any modules that could introduce name clashes. -} module Data.Orphans.Prelude -#if MIN_VERSION_base(4,9,0) +#if MIN_VERSION_base(4,10,0) () where #else (module OrphansPrelude, realPart, imagPart) where @@ -25,6 +30,7 @@ import Data.Bits as OrphansPrelude import Data.Char as OrphansPrelude import Data.Complex as OrphansPrelude (Complex(..)) +import Data.Data as OrphansPrelude (Data) import Data.Fixed as OrphansPrelude import Data.Int as OrphansPrelude import Data.Ix as OrphansPrelude @@ -85,7 +91,7 @@ # if MIN_VERSION_base(4,6,0) import GHC.GHCi as OrphansPrelude -import GHC.TypeLits as OrphansPrelude +import GHC.TypeLits as OrphansPrelude hiding (type (*)) # endif # if MIN_VERSION_base(4,6,0) && !(MIN_VERSION_base(4,8,2)) @@ -104,6 +110,12 @@ # if MIN_VERSION_base(4,8,0) import Data.Bifunctor as OrphansPrelude import Data.Functor.Identity as OrphansPrelude +# endif + +# if MIN_VERSION_base(4,9,0) +import Data.Functor.Classes as OrphansPrelude +import Data.List.NonEmpty as OrphansPrelude (NonEmpty(..)) +import Data.Semigroup as OrphansPrelude (Semigroup(..), stimesMonoid) # endif # if MIN_VERSION_base(4,4,0) diff --git a/test/Data/Version/OrphansSpec.hs b/test/Data/Version/OrphansSpec.hs --- a/test/Data/Version/OrphansSpec.hs +++ b/test/Data/Version/OrphansSpec.hs @@ -17,7 +17,12 @@ spec = do describe "Data Version instance" $ it "allows obtaining a Version constructor" $ - dataTypeName (dataTypeOf (Version [1,2,3] [])) `shouldBe` "Data.Version.Version" + dataTypeName (dataTypeOf (Version [1,2,3] [])) `shouldBe` +#if __GLASGOW_HASKELL__ >= 801 + "Version" +#else + "Data.Version.Version" +#endif #if MIN_VERSION_base(4,7,0) describe "IsList Version instance" $