Conditionally expose Data.Functor.* modules
authorryan.gl.scott <ryan.gl.scott@gmail.com>
Thu, 17 Dec 2015 17:09:19 +0000 (17:09 +0000)
committerryan.gl.scott <ryan.gl.scott@gmail.com>
Thu, 17 Dec 2015 17:09:19 +0000 (17:09 +0000)
As a part of #11135. This conditionally exposes `Data.Functor.Classes`, `Data.Functor.Compose`, `Data.Functor.Product`, and `Data.Functor.Sum` if using GHC 7.10 or earlier. This also backports `Typeable`, `Data`, `Generic`, and `Generic1` instances that will be introduced in `base-4.9.0.0` (GHC 8.0).

changelog
legacy/pre709/Data/Functor/Identity.hs
legacy/pre711/Data/Functor/Classes.hs [moved from Data/Functor/Classes.hs with 96% similarity]
legacy/pre711/Data/Functor/Compose.hs [moved from Data/Functor/Compose.hs with 67% similarity]
legacy/pre711/Data/Functor/Product.hs [moved from Data/Functor/Product.hs with 74% similarity]
legacy/pre711/Data/Functor/Sum.hs [moved from Data/Functor/Sum.hs with 65% similarity]
transformers.cabal

index 5752ae2..f9beae1 100644 (file)
--- a/changelog
+++ b/changelog
@@ -1,7 +1,8 @@
 -*-change-log-*-
 
 0.5.0.0 Ross Paterson <R.Paterson@city.ac.uk> Dec 2015
-       * Control.Monad.IO.Class in base for GHC >= 8.0
+       * Control.Monad.IO.Class, Data.Functor.Classes, Data.Functor.Compose,
+      Data.Functor.Product, and Data.Functor.Sum in base for GHC >= 8.0
        * Added PolyKinds for GHC >= 7.4
        * Added instances of base classes MonadZip and MonadFail
        * Changed liftings of Prelude classes to use explicit dictionaries
index 87ca6d7..4e3a459 100644 (file)
@@ -4,7 +4,7 @@
 #endif
 #if __GLASGOW_HASKELL__ >= 702
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE Safe #-}
+{-# LANGUAGE Trustworthy #-}
 #endif
 #if __GLASGOW_HASKELL__ >= 708
 {-# LANGUAGE AutoDeriveTypeable #-}
similarity index 96%
rename from Data/Functor/Classes.hs
rename to legacy/pre711/Data/Functor/Classes.hs
index 211a0db..2f20210 100644 (file)
@@ -2,8 +2,9 @@
 #if __GLASGOW_HASKELL__ >= 702
 {-# LANGUAGE Safe #-}
 #endif
-#if __GLASGOW_HASKELL__ >= 710
-{-# LANGUAGE AutoDeriveTypeable #-}
+#if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE StandaloneDeriving #-}
 #endif
 -----------------------------------------------------------------------------
 -- |
@@ -68,6 +69,9 @@ module Data.Functor.Classes (
 import Control.Applicative (Const(Const))
 import Data.Functor.Identity (Identity(Identity))
 import Data.Monoid (mappend)
+#if __GLASGOW_HASKELL__ >= 708
+import Data.Typeable
+#endif
 import Text.Show (showListWith)
 
 -- | Lifting of the 'Eq' class to unary type constructors.
@@ -80,6 +84,10 @@ class Eq1 f where
     -- the second.
     liftEq :: (a -> b -> Bool) -> f a -> f b -> Bool
 
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Eq1
+#endif
+
 -- | Lift the standard @('==')@ function through the type constructor.
 eq1 :: (Eq1 f, Eq a) => f a -> f a -> Bool
 eq1 = liftEq (==)
@@ -94,6 +102,10 @@ class (Eq1 f) => Ord1 f where
     -- the second.
     liftCompare :: (a -> b -> Ordering) -> f a -> f b -> Ordering
 
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Ord1
+#endif
+
 -- | Lift the standard 'compare' function through the type constructor.
 compare1 :: (Ord1 f, Ord a) => f a -> f a -> Ordering
 compare1 = liftCompare compare
@@ -111,6 +123,10 @@ class Read1 f where
     liftReadList :: (Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
     liftReadList rp rl = readListWith (liftReadsPrec rp rl 0)
 
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Read1
+#endif
+
 -- | Read a list (using square brackets and commas), given a function
 -- for reading elements.
 readListWith :: ReadS a -> ReadS [a]
@@ -142,6 +158,10 @@ class Show1 f where
         [f a] -> ShowS
     liftShowList sp sl = showListWith (liftShowsPrec sp sl 0)
 
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Show1
+#endif
+
 -- | Lift the standard 'showsPrec' and 'showList' functions through the
 -- type constructor.
 showsPrec1 :: (Show1 f, Show a) => Int -> f a -> ShowS
@@ -157,6 +177,10 @@ class Eq2 f where
     -- the second.
     liftEq2 :: (a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
 
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Eq2
+#endif
+
 -- | Lift the standard @('==')@ function through the type constructor.
 eq2 :: (Eq2 f, Eq a, Eq b) => f a b -> f a b -> Bool
 eq2 = liftEq2 (==) (==)
@@ -172,6 +196,10 @@ class (Eq2 f) => Ord2 f where
     liftCompare2 :: (a -> b -> Ordering) -> (c -> d -> Ordering) ->
         f a c -> f b d -> Ordering
 
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Ord2
+#endif
+
 -- | Lift the standard 'compare' function through the type constructor.
 compare2 :: (Ord2 f, Ord a, Ord b) => f a b -> f a b -> Ordering
 compare2 = liftCompare2 compare compare
@@ -192,6 +220,10 @@ class Read2 f where
     liftReadList2 rp1 rl1 rp2 rl2 =
         readListWith (liftReadsPrec2 rp1 rl1 rp2 rl2 0)
 
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Read2
+#endif
+
 -- | Lift the standard 'readsPrec' function through the type constructor.
 readsPrec2 :: (Read2 f, Read a, Read b) => Int -> ReadS (f a b)
 readsPrec2 = liftReadsPrec2 readsPrec readList readsPrec readList
@@ -212,6 +244,10 @@ class Show2 f where
     liftShowList2 sp1 sl1 sp2 sl2 =
         showListWith (liftShowsPrec2 sp1 sl1 sp2 sl2 0)
 
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Show2
+#endif
+
 -- | Lift the standard 'showsPrec' function through the type constructor.
 showsPrec2 :: (Show2 f, Show a, Show b) => Int -> f a b -> ShowS
 showsPrec2 = liftShowsPrec2 showsPrec showList showsPrec showList
similarity index 67%
rename from Data/Functor/Compose.hs
rename to legacy/pre711/Data/Functor/Compose.hs
index 1b7785c..ed8556e 100644 (file)
@@ -1,12 +1,21 @@
 {-# LANGUAGE CPP #-}
 #if __GLASGOW_HASKELL__ >= 702
-{-# LANGUAGE Safe #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 #endif
 #if __GLASGOW_HASKELL__ >= 704
 {-# LANGUAGE PolyKinds #-}
 #endif
-#if __GLASGOW_HASKELL__ >= 710
+#if __GLASGOW_HASKELL__ >= 708
 {-# LANGUAGE AutoDeriveTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE KindSignatures #-}
 #endif
 -----------------------------------------------------------------------------
 -- |
@@ -28,8 +37,14 @@ module Data.Functor.Compose (
 import Data.Functor.Classes
 
 import Control.Applicative
+#if __GLASGOW_HASKELL__ >= 708
+import Data.Data
+#endif
 import Data.Foldable (Foldable(foldMap))
 import Data.Traversable (Traversable(traverse))
+#if __GLASGOW_HASKELL__ >= 702
+import GHC.Generics
+#endif
 
 infixr 9 `Compose`
 
@@ -38,6 +53,42 @@ infixr 9 `Compose`
 -- but the composition of monads is not always a monad.
 newtype Compose f g a = Compose { getCompose :: f (g a) }
 
+#if __GLASGOW_HASKELL__ >= 702
+deriving instance Generic (Compose f g a)
+
+instance Functor f => Generic1 (Compose f g) where
+    type Rep1 (Compose f g) =
+      D1 MDCompose
+        (C1 MCCompose
+          (S1 MSCompose (f :.: Rec1 g)))
+    from1 (Compose x) = M1 (M1 (M1 (Comp1 (fmap Rec1 x))))
+    to1 (M1 (M1 (M1 x))) = Compose (fmap unRec1 (unComp1 x))
+
+data MDCompose
+data MCCompose
+data MSCompose
+
+instance Datatype MDCompose where
+    datatypeName _ = "Compose"
+    moduleName   _ = "Data.Functor.Compose"
+# if __GLASGOW_HASKELL__ >= 708
+    isNewtype    _ = True
+# endif
+
+instance Constructor MCCompose where
+    conName     _ = "Compose"
+    conIsRecord _ = True
+
+instance Selector MSCompose where
+    selName _ = "getCompose"
+#endif
+
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Compose
+deriving instance (Data (f (g a)), Typeable f, Typeable g, Typeable a)
+               => Data (Compose (f :: * -> *) (g :: * -> *) (a :: *))
+#endif
+
 -- Instances of lifted Prelude classes
 
 instance (Eq1 f, Eq1 g) => Eq1 (Compose f g) where
similarity index 74%
rename from Data/Functor/Product.hs
rename to legacy/pre711/Data/Functor/Product.hs
index ea0898c..ae23e01 100644 (file)
@@ -1,12 +1,21 @@
 {-# LANGUAGE CPP #-}
 #if __GLASGOW_HASKELL__ >= 702
-{-# LANGUAGE Safe #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 #endif
 #if __GLASGOW_HASKELL__ >= 704
 {-# LANGUAGE PolyKinds #-}
 #endif
-#if __GLASGOW_HASKELL__ >= 710
+#if __GLASGOW_HASKELL__ >= 708
 {-# LANGUAGE AutoDeriveTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE KindSignatures #-}
 #endif
 -----------------------------------------------------------------------------
 -- |
@@ -31,14 +40,48 @@ import Control.Monad.Fix (MonadFix(..))
 #if MIN_VERSION_base(4,4,0)
 import Control.Monad.Zip (MonadZip(mzipWith))
 #endif
+#if __GLASGOW_HASKELL__ >= 708
+import Data.Data
+#endif
 import Data.Foldable (Foldable(foldMap))
 import Data.Functor.Classes
 import Data.Monoid (mappend)
 import Data.Traversable (Traversable(traverse))
+#if __GLASGOW_HASKELL__ >= 702
+import GHC.Generics
+#endif
 
 -- | Lifted product of functors.
 data Product f g a = Pair (f a) (g a)
 
+#if __GLASGOW_HASKELL__ >= 702
+deriving instance Generic (Product f g a)
+
+instance Generic1 (Product f g) where
+    type Rep1 (Product f g) =
+      D1 MDProduct
+        (C1 MCPair
+          (S1 NoSelector (Rec1 f) :*: S1 NoSelector (Rec1 g)))
+    from1 (Pair f g) = M1 (M1 (M1 (Rec1 f) :*: M1 (Rec1 g)))
+    to1 (M1 (M1 (M1 f :*: M1 g))) = Pair (unRec1 f) (unRec1 g)
+
+data MDProduct
+data MCPair
+
+instance Datatype MDProduct where
+    datatypeName _ = "Product"
+    moduleName   _ = "Data.Functor.Product"
+
+instance Constructor MCPair where
+    conName _ = "Pair"
+#endif
+
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Product
+deriving instance (Data (f a), Data (g a), Typeable f, Typeable g, Typeable a)
+               => Data (Product (f :: * -> *) (g :: * -> *) (a :: *))
+#endif
+
 instance (Eq1 f, Eq1 g) => Eq1 (Product f g) where
     liftEq eq (Pair x1 y1) (Pair x2 y2) = liftEq eq x1 x2 && liftEq eq y1 y2
 
similarity index 65%
rename from Data/Functor/Sum.hs
rename to legacy/pre711/Data/Functor/Sum.hs
index e7c9f55..03f90b2 100644 (file)
@@ -1,12 +1,21 @@
 {-# LANGUAGE CPP #-}
 #if __GLASGOW_HASKELL__ >= 702
-{-# LANGUAGE Safe #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 #endif
 #if __GLASGOW_HASKELL__ >= 704
 {-# LANGUAGE PolyKinds #-}
 #endif
-#if __GLASGOW_HASKELL__ >= 710
+#if __GLASGOW_HASKELL__ >= 708
 {-# LANGUAGE AutoDeriveTypeable #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE KindSignatures #-}
 #endif
 -----------------------------------------------------------------------------
 -- |
@@ -26,14 +35,53 @@ module Data.Functor.Sum (
   ) where
 
 import Control.Applicative
+#if __GLASGOW_HASKELL__ >= 708
+import Data.Data
+#endif
 import Data.Foldable (Foldable(foldMap))
 import Data.Functor.Classes
 import Data.Monoid (mappend)
 import Data.Traversable (Traversable(traverse))
+#if __GLASGOW_HASKELL__ >= 702
+import GHC.Generics
+#endif
 
 -- | Lifted sum of functors.
 data Sum f g a = InL (f a) | InR (g a)
 
+#if __GLASGOW_HASKELL__ >= 702
+deriving instance Generic (Sum f g a)
+
+instance Generic1 (Sum f g) where
+    type Rep1 (Sum f g) =
+      D1 MDSum (C1 MCInL (S1 NoSelector (Rec1 f))
+            :+: C1 MCInR (S1 NoSelector (Rec1 g)))
+    from1 (InL f) = M1 (L1 (M1 (M1 (Rec1 f))))
+    from1 (InR g) = M1 (R1 (M1 (M1 (Rec1 g))))
+    to1 (M1 (L1 (M1 (M1 f)))) = InL (unRec1 f)
+    to1 (M1 (R1 (M1 (M1 g)))) = InR (unRec1 g)
+
+data MDSum
+data MCInL
+data MCInR
+
+instance Datatype MDSum where
+    datatypeName _ = "Sum"
+    moduleName   _ = "Data.Functor.Sum"
+
+instance Constructor MCInL where
+    conName _ = "InL"
+
+instance Constructor MCInR where
+    conName _ = "InR"
+#endif
+
+#if __GLASGOW_HASKELL__ >= 708
+deriving instance Typeable Sum
+deriving instance (Data (f a), Data (g a), Typeable f, Typeable g, Typeable a)
+               => Data (Sum (f :: * -> *) (g :: * -> *) (a :: *))
+#endif
+
 instance (Eq1 f, Eq1 g) => Eq1 (Sum f g) where
     liftEq eq (InL x1) (InL x2) = liftEq eq x1 x2
     liftEq _ (InL _) (InR _) = False
index 70bf8b6..142e62e 100644 (file)
@@ -48,10 +48,18 @@ library
     hs-source-dirs: legacy/pre709
     exposed-modules: Data.Functor.Identity
   if !impl(ghc>=7.11)
-    -- Control.Monad.IO.Class was moved into base-4.9.0 (GHC 7.12)
+    -- Control.Monad.IO.Class was moved into base-4.9.0.0 (GHC 8.0)
     -- see also https://ghc.haskell.org/trac/ghc/ticket/10773
     hs-source-dirs: legacy/pre711
     exposed-modules: Control.Monad.IO.Class
+    -- Much of the Data.Functor.* hierarchy was also moved into
+    -- base-4.9.0.0 (GHC 8.0) as well
+    -- see also https://ghc.haskell.org/trac/ghc/ticket/11135
+    exposed-modules:
+      Data.Functor.Classes
+      Data.Functor.Compose
+      Data.Functor.Product
+      Data.Functor.Sum
   if impl(ghc>=7.2 && <7.5)
     -- Prior to GHC 7.5, GHC.Generics lived in ghc-prim
     build-depends: ghc-prim
@@ -76,9 +84,5 @@ library
     Control.Monad.Trans.Writer
     Control.Monad.Trans.Writer.Lazy
     Control.Monad.Trans.Writer.Strict
-    Data.Functor.Classes
-    Data.Functor.Compose
     Data.Functor.Constant
-    Data.Functor.Product
     Data.Functor.Reverse
-    Data.Functor.Sum