generic-deriving 0.4 → 1.0.1

raw patch · 12 files changed

+418/−587 lines, 12 filesdep +ghc-primPVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-prim

API changes (from Hackage documentation)

Files

• examples/Examples.hs +171/−211
• generic-deriving.cabal +13/−8
• src/Generics/Deriving.hs +0/−2
• src/Generics/Deriving/Base.hs +16/−71
• src/Generics/Deriving/Enum.hs +58/−86
• src/Generics/Deriving/Eq.hs +30/−17
• src/Generics/Deriving/Functor.hs +15/−22
• src/Generics/Deriving/Instances.hs +48/−29
• src/Generics/Deriving/Show.hs +28/−23
• src/Generics/Deriving/TH.hs +21/−7
• src/Generics/Deriving/Typeable.hs +0/−93
• src/Generics/Deriving/Uniplate.hs +18/−18

@@ -1,12 +1,16 @@ {-# LANGUAGE EmptyDataDecls #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE KindSignatures #-}
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE DeriveGeneric #-}
+#endif
 
 module Main (
   -- * Run all tests
@@ -24,13 +28,26 @@ 
 data (:/:) f a = MyType1Nil
                | MyType1Cons { myType1Rec :: (f :/: a), myType2Rec :: MyType2 }
-               | MyType1Cons2 (f :/: a) Int a (f a)
+               | MyType1Cons2 (f :/: a) Int a (f a) 
 
+#if __GLASGOW_HASKELL__ >= 701
+  deriving Generic
+#endif
+
 data MyType2 = MyType2 Float ([] :/: Int)
 
+#if __GLASGOW_HASKELL__ < 701
+
 $(deriveAll ''(:/:))
 $(deriveAll ''MyType2)
 
+#else
+
+-- deriving instance Generic (f :/: a)
+deriving instance Generic MyType2
+
+#endif
+
 --------------------------------------------------------------------------------
 -- Example: Haskell's lists and Maybe
 --------------------------------------------------------------------------------
@@ -57,41 +74,21 @@ 
 data Tree = Empty | Branch Int Tree Tree
 
-#ifdef __UHC__
-
-deriving instance GShow Tree
-deriving instance Uniplate Tree
-deriving instance GEnum Tree
-
-#else
-{-
-data Tree_
-data Empty_
-data Branch_
+#if __GLASGOW_HASKELL__ >= 701
 
-instance Datatype Tree_ where
-  datatypeName _ = "Tree"
-  moduleName   _ = "Examples"
+deriving instance Generic Tree
 
-instance Constructor Empty_  where conName _ = "Empty"
-instance Constructor Branch_ where conName _ = "Branch"
+instance GShow Tree
+instance Uniplate Tree
+instance GEnum Tree
 
--- Only a Representable0 instance is needed (no Representable1)
-type Rep0Tree = D1 Tree_ (C1 Empty_ U1 :+: 
-                          C1 Branch_ (Rec0 Int :*: (Rec0 Tree :*: Rec0 Tree)))
-instance Representable0 Tree Rep0Tree where  
-  from0 Empty          = M1 (L1 (M1 U1))
-  from0 (Branch i l r) = M1 (R1 (M1 (K1 i :*: (K1 l :*: K1 r))))
-  to0 (M1 (L1 (M1 U1)))                         = Empty
-  to0 (M1 (R1 (M1 (K1 i :*: (K1 l :*: K1 r))))) = Branch i l r
--}
+#else
 
 $(deriveAll ''Tree)
 
-instance GShow Tree where gshowsPrec = gshowsPrecdefault (undefined :: Rep0Tree_ x)
-instance Uniplate Tree where children = childrendefault (undefined :: Rep0Tree_ x)
-instance GEnum Tree where genum = genumDefault (undefined :: Rep0Tree_ x)
-instance Typeable Tree where typeOf = typeOf0default (undefined :: Rep0Tree_ x)
+instance GShow    Tree where gshowsPrec = gshowsPrecdefault
+instance Uniplate Tree where children   = childrendefault
+instance GEnum    Tree where genum      = genumDefault
 
 #endif
 
@@ -107,13 +104,20 @@ 
 data List a = Nil | Cons a (List a) 
 
-#ifdef __UHC__
+#if __GLASGOW_HASKELL__ >= 701
+  deriving Generic
+--deriving instance Generic (List a)
+#else
 
-deriving instance (GShow a) => GShow (List a)
-deriving instance GFunctor List
-deriving instance Uniplate (List a)
+type Rep0List_ a = D1 List_ ((:+:) (C1 Nil_ U1) (C1 Cons_ ((:*:) (Par0 a) (Rec0 (List a)))))
+instance Generic (List a) where
+  type Rep (List a) = Rep0List_ a
+  from Nil        = M1 (L1 (M1 U1))
+  from (Cons h t) = M1 (R1 (M1 ((:*:) (K1 h) (K1 t))))
+  to (M1 (L1 (M1 U1)))                     = Nil
+  to (M1 (R1 (M1 (K1 h :*: K1 t)))) = Cons h t
 
-#else
+#endif
 
 data List_
 data Nil_
@@ -126,49 +130,31 @@ instance Constructor Nil_  where conName _ = "Nil"
 instance Constructor Cons_ where conName _ = "Cons"
 
-type Rep0List_ a = D1 List_ ((:+:) (C1 Nil_ U1) (C1 Cons_ ((:*:) (Par0 a) (Rec0 (List a)))))
-instance Representable0 (List a) (Rep0List_ a) where
-  from0 Nil        = M1 (L1 (M1 U1))
-  from0 (Cons h t) = M1 (R1 (M1 ((:*:) (K1 h) (K1 t))))
-  to0 (M1 (L1 (M1 U1)))                     = Nil
-  to0 (M1 (R1 (M1 (K1 h :*: K1 t)))) = Cons h t
-
 type Rep1List_ = D1 List_ ((:+:) (C1 Nil_ U1) (C1 Cons_ ((:*:) Par1 (Rec1 List))))
-instance Representable1 List Rep1List_ where
+instance Generic1 List where
+  type Rep1 List = Rep1List_
   from1 Nil        = M1 (L1 (M1 U1))
   from1 (Cons h t) = M1 (R1 (M1 (Par1 h :*: Rec1 t)))
   to1 (M1 (L1 (M1 U1)))                         = Nil
   to1 (M1 (R1 (M1 (Par1 h :*: Rec1 t)))) = Cons h t
 
+#if __GLASGOW_HASKELL__ < 701
 -- Instance for generic functions (should be automatically generated)
 instance GFunctor List where
-  gmap = t undefined where
-    t :: Rep1List_ a -> (a -> b) -> List a -> List b
-    t = gmapdefault
-{-
-instance (Typeable a) => Typeable1 List where
-  typeOf1 = t undefined where
-    t :: (Typeable a) => Rep1List_ a -> List a -> TypeRep
-    t = typeOf1default
-
-
-instance GFoldable List where
-  gfoldMap = gfoldMapdefault (undefined :: RepList x)
-
-instance GTraversable List where
-  gtraverse = gtraversedefault (undefined :: RepList x)
--}
+  gmap = gmapdefault
 
 instance (GShow a) => GShow (List a) where
-  gshowsPrec = t undefined where
-    t :: (GShow a) => Rep0List_ a x -> Int -> List a -> ShowS
-    t = gshowsPrecdefault
+  gshowsPrec = gshowsPrecdefault
 
 instance (Uniplate a) => Uniplate (List a) where
-  children = t undefined where
-    t :: (Uniplate a) => Rep0List_ a x -> List a -> [List a]
-    t = childrendefault
+  children = childrendefault
 
+#else
+
+instance                 GFunctor  List
+instance (GShow a)    => GShow    (List a)
+instance (Uniplate a) => Uniplate (List a)
+
 #endif
 
 -- Example usage
@@ -189,72 +175,39 @@ 
 data Nested a = Leaf | Nested { value :: a, rec :: Nested [a] }
 
-#ifdef __UHC__
-
-deriving instance (GShow a) => GShow (Nested a)
-deriving instance GFunctor Nested
-
-#else
-{-
-data NestedD
-data NestedC
-data Leaf_
-data Value
-data Rec
-
-instance Datatype NestedD where
-  datatypeName _ = "Nested"
-  moduleName   _ = "Examples"
-
-instance Constructor NestedC where
-  conName _     = "Nested"
-  conIsRecord _ = True
-
-instance Constructor Leaf_ where conName _     = "Leaf"
-
-instance Selector Value where selName _ = "value"
-instance Selector Rec   where selName _ = "rec"
+#if __GLASGOW_HASKELL__ >= 701
+  deriving Generic
+-- deriving instance Generic (Nested a)
+#endif
 
--- Representable1 instances
-type Rep0Nested a = D1 NestedD (    C1 Leaf_ U1 
-                                :+: C1 NestedC (    S1 Value (Par0 a)
-                                                :*: S1 Rec (Rec0 (Nested [a]))))
-instance Representable0 (Nested a) (Rep0Nested a) where
-  from0 Leaf = M1 (L1 (M1 U1))
-  from0 (Nested a l) = M1 (R1 (M1 (M1 (K1 a) :*: M1 (K1 l))))
-  to0 (M1 (L1 (M1 U1))) = Leaf
-  to0 (M1 (R1 (M1 (M1 (K1 a) :*: M1 (K1 l))))) = Nested a l
--}
+$(deriveMeta ''Nested)
 
-$(deriveAll ''Nested)
+#if __GLASGOW_HASKELL__ < 701
+$(deriveRepresentable0 ''Nested)
+#endif
 
 type RepNested = D1 Nested_ (C1 Nested_Leaf_ U1 :+: C1 Nested_Nested_ (Par1 :*: Nested :.: Rec1 []))
-instance Representable1 Nested RepNested where
+instance Generic1 Nested where
+  type Rep1 Nested = RepNested
   from1 Leaf = M1 (L1 (M1 U1))
   from1 (Nested a l) = M1 (R1 (M1 (Par1 a :*: Comp1 (gmap Rec1 l))))
   to1 (M1 (L1 (M1 U1))) = Leaf
   to1 (M1 (R1 (M1 (Par1 a :*: Comp1 l)))) = Nested a (gmap unRec1 l)
 
+#if __GLASGOW_HASKELL__ < 701
 -- Instance for gshow (should be automatically generated)
 instance (GShow a) => GShow (Nested a) where
-  gshowsPrec = t undefined where
-    t :: (GShow a) => Rep0Nested_ a x -> Int -> Nested a -> ShowS
-    t = gshowsPrecdefault
+  gshowsPrec = gshowsPrecdefault
 
 instance GFunctor Nested where
-  gmap = t undefined where
-    t :: RepNested a -> (a -> b) -> Nested a -> Nested b
-    t = gmapdefault
-{-
-instance (GFoldable f) => GFoldable (GRose f) where
-  gfoldMap f (x :: GRose f a) = gfoldMapdefault (undefined :: RepGRose f x) f x
+  gmap = gmapdefault
 
-instance (GTraversable f) => GTraversable (GRose f) where
-  gtraverse f (x :: GRose f a) = gtraversedefault (undefined :: RepGRose f x) f x
--}
+#else 
 
-#endif
+instance (GShow a) => GShow (Nested a)
+instance GFunctor Nested
 
+#endif
 
 -- Example usage
 nested :: Nested Int
@@ -265,19 +218,24 @@ testsNested = [ gshow nested
               , gshow (gmap gshow nested) ]
 
-
 --------------------------------------------------------------------------------
 -- Example: Type composition
 --------------------------------------------------------------------------------
 
 data Rose a = Rose [a] [Rose a]
 
-#ifdef __UHC__
+#if __GLASGOW_HASKELL__ >= 701
+  deriving Generic
+-- deriving instance Generic (Rose a)
+#else
 
-deriving instance (GShow a) => GShow (Rose a)
-deriving instance GFunctor Rose
+type Rep0Rose a = D1 RoseD (C1 RoseC (Rec0 [a] :*: Rec0 [Rose a]))
+instance Generic (Rose a) where
+  type Rep (Rose a) = Rep0Rose a
+  from (Rose a x) = M1 (M1 (K1 a :*: K1 x))
+  to (M1 (M1 (K1 a :*: K1 x))) = Rose a x
 
-#else
+#endif
 
 data RoseD
 data RoseC
@@ -288,34 +246,26 @@ 
 instance Constructor RoseC where conName _ = "Rose"
 
--- Representable1 instances
-type Rep0Rose a = D1 RoseD (C1 RoseC (Rec0 [a] :*: Rec0 [Rose a]))
-instance Representable0 (Rose a) (Rep0Rose a) where
-  from0 (Rose a x) = M1 (M1 (K1 a :*: K1 x))
-  to0 (M1 (M1 (K1 a :*: K1 x))) = Rose a x
-
+-- Generic1 instances
 type RepRose = D1 RoseD (C1 RoseC (Rec1 [] :*: [] :.: Rec1 Rose))
-instance Representable1 Rose RepRose where
+instance Generic1 Rose where
+  type Rep1 Rose = RepRose
   from1 (Rose a x) = M1 (M1 (Rec1 a :*: Comp1 (gmap Rec1 x)))
   to1 (M1 (M1 (Rec1 a :*: Comp1 x))) = Rose a (gmap unRec1 x)
 
+#if __GLASGOW_HASKELL_ >= 701
+
+instance (GShow a) => GShow (Rose a)
+instance GFunctor Rose
+
+#else
+
 -- Instance for gshow (should be automatically generated)
 instance (GShow a) => GShow (Rose a) where
-  gshowsPrec = t undefined where
-    t :: (GShow a) => Rep0Rose a x -> Int -> Rose a -> ShowS
-    t = gshowsPrecdefault
+  gshowsPrec = gshowsPrecdefault
 
 instance GFunctor Rose where
-  gmap = t undefined where
-    t :: RepRose a -> (a -> b) -> Rose a -> Rose b
-    t = gmapdefault
-{-
-instance GFoldable Rose where
-  gfoldMap = gfoldMapdefault (undefined :: RepRose x)
-
-instance GTraversable Rose where
-  gtraverse = gtraversedefault (undefined :: RepRose x)
--}
+  gmap = gmapdefault
 
 #endif
 
@@ -326,60 +276,42 @@ testsRose = [ gshow rose1
             , gshow (gmap gshow rose1) ]
 
-
 --------------------------------------------------------------------------------
 -- Example: Higher-order kinded datatype, type composition
 --------------------------------------------------------------------------------
 
 data GRose f a = GRose (f a) (f (GRose f a))
 
-#ifdef __UHC__
-
-deriving instance (GShow (f a), GShow (f (GRose f a))) =>  GShow (GRose f a)
-deriving instance (GFunctor f) => GFunctor (GRose f)
-
-#else
-{-
-data GRoseD
-data GRoseC
-
-instance Datatype GRoseD where
-  datatypeName _ = "GRose"
-  moduleName   _ = "Examples"
-
-instance Constructor GRoseC where conName _ = "GRose"
+#if __GLASGOW_HASKELL__ >= 701
+  deriving Generic
+--deriving instance Generic (GRose f a)
+#endif
 
-type Rep0GRose f a = D1 GRoseD (C1 GRoseC (Rec0 (f a) :*: Rec0 (f (GRose f a))))
-instance Representable0 (GRose f a) (Rep0GRose f a) where
-  from0 (GRose a x) = M1 (M1 (K1 a :*: K1 x))
-  to0 (M1 (M1 (K1 a :*: K1 x))) = GRose a x
--}
+$(deriveMeta ''GRose)
 
-$(deriveAll ''GRose)
+#if __GLASGOW_HASKELL__ < 701
+$(deriveRepresentable0 ''GRose)
+#endif
 
 type Rep1GRose f = D1 GRose_ (C1 GRose_GRose_ (Rec1 f :*: f :.: (Rec1 (GRose f))))
-instance (GFunctor f) => Representable1 (GRose f) (Rep1GRose f) where
+instance (GFunctor f) => Generic1 (GRose f) where
+  type Rep1 (GRose f) = Rep1GRose f
   from1 (GRose a x) = M1 (M1 (Rec1 a :*: Comp1 (gmap Rec1 x)))
   to1 (M1 (M1 (Rec1 a :*: Comp1 x))) = GRose a (gmap unRec1 x)
 
+#if __GLASGOW_HASKELL__ < 701
 -- Requires UndecidableInstances
 instance (GShow (f a), GShow (f (GRose f a))) => GShow (GRose f a) where
-  gshowsPrec = t undefined where
-    t :: (GShow (f a), GShow (f (GRose f a))) => Rep0GRose_ f a x -> Int -> GRose f a -> ShowS
-    t = gshowsPrecdefault
+  gshowsPrec = gshowsPrecdefault
 
 instance (GFunctor f) => GFunctor (GRose f) where
-  gmap = t undefined where
-    t :: (GFunctor f) => Rep1GRose f a -> (a -> b) -> GRose f a -> GRose f b
-    t = gmapdefault
-{-
-instance (GFoldable f) => GFoldable (GRose f) where
-  gfoldMap f (x :: GRose f a) = gfoldMapdefault (undefined :: RepGRose f x) f x
+  gmap = gmapdefault
 
-instance (GTraversable f) => GTraversable (GRose f) where
-  gtraverse f (x :: GRose f a) = gtraversedefault (undefined :: RepGRose f x) f x
--}
+#else
 
+instance (GShow (f a), GShow (f (GRose f a))) => GShow (GRose f a)
+instance (GFunctor f) => GFunctor (GRose f)
+
 #endif
 
 -- Example usage
@@ -399,22 +331,22 @@ data Comp f g a = Comp (f (g a))
 
 type Rep0NGRose f a = Par0 a :*: Rec0 (f (NGRose (Comp f f) a))
-instance Representable0 (NGRose f a) (Rep0NGRose f a) where
-  from0 (NGNode a x) = K1 a :*: K1 x
-  to0 (K1 a :*: K1 x) = NGNode a x
+instance Generic (NGRose f a) (Rep0NGRose f a) where
+  from (NGNode a x) = K1 a :*: K1 x
+  to (K1 a :*: K1 x) = NGNode a x
 
 type Rep0Comp f g a = Rec0 (f (g a))
-instance Representable0 (Comp f g a) (Rep0Comp f g a) where
-  from0 (Comp x) = K1 x
-  to0 (K1 x) = Comp x
+instance Generic (Comp f g a) (Rep0Comp f g a) where
+  from (Comp x) = K1 x
+  to (K1 x) = Comp x
 
 type Rep1Comp f g = f :.: Rec1 g
-instance (GFunctor f) => Representable1 (Comp f g) (Rep1Comp f g) where
+instance (GFunctor f) => Generic1 (Comp f g) (Rep1Comp f g) where
   from1 (Comp x) = Comp1 (gmap Rec1 x)
   to1 (Comp1 x) = Comp (gmap unRec1 x)
 
 type Rep1NGRose f = Par1 :*: f :.: Rec1 (NGRose (Comp f f))
-instance (GFunctor f) => Representable1 (NGRose f) (Rep1NGRose f) where
+instance (GFunctor f) => Generic1 (NGRose f) (Rep1NGRose f) where
   from1 (NGNode a x) = Par1 a :*: (Comp1 (gmap Rec1 x))
   to1 (Par1 a :*: Comp1 x) = NGNode a (gmap unRec1 x)
 
@@ -453,42 +385,64 @@ data Weird a = Weird [[[a]]] deriving Show
 
 type Rep1Weird = [] :.: [] :.: Rec1 []
-instance Representable1 Weird Rep1Weird where
+instance Generic1 Weird where
+  type Rep1 Weird = Rep1Weird
   from1 (Weird x) = Comp1 (gmap (Comp1 . gmap Rec1) x)
   to1 (Comp1 x) = Weird (gmap (gmap unRec1 . unComp) x)
 
+#if __GLASGOW_HASKELL__ >= 701
 
+instance GFunctor Weird
+
+#else 
+
 instance GFunctor Weird where
-  gmap = t undefined where
-    t :: Rep1Weird a -> (a -> b) -> Weird a -> Weird b
-    t = gmapdefault
+  gmap = gmapdefault
 
+#endif
+
 --------------------------------------------------------------------------------
 -- Example: Nested datatype Bush (minimal)
 --------------------------------------------------------------------------------
 
 data Bush a = BushNil | BushCons a (Bush (Bush a))
 
+#if __GLASGOW_HASKELL__ >= 701
+  deriving Generic
+--deriving instance Generic (Bush a)
+#endif
 
-$(deriveAll ''Bush)
+$(deriveMeta ''Bush)
 
+#if __GLASGOW_HASKELL__ < 701
+$(deriveRepresentable0 ''Bush)
+#endif
+
+
 type Rep1Bush = U1 :+: Par1 :*: Bush :.: Rec1 Bush
-instance Representable1 Bush Rep1Bush where
+instance Generic1 Bush where
+  type Rep1 Bush = Rep1Bush
   from1 BushNil = L1 U1
   from1 (BushCons a b) = R1 (Par1 a :*: Comp1 (gmap Rec1 b))
   to1 (L1 U1) = BushNil
   to1 (R1 (Par1 a :*: Comp1 b)) = BushCons a (gmap unRec1 b)
 
+
+#if __GLASGOW_HASKELL__ < 701
+
 instance GFunctor Bush where
-  gmap = t undefined where
-    t :: Rep1Bush a -> (a -> b) -> Bush a -> Bush b
-    t = gmapdefault
+  gmap = gmapdefault
 
 instance (GShow a) => GShow (Bush a) where
-  gshowsPrec = t undefined where
-    t :: (GShow a) => Rep0Bush_ a x -> Int -> Bush a -> ShowS
-    t = gshowsPrecdefault
+  gshowsPrec = gshowsPrecdefault
 
+#else
+
+instance GFunctor Bush
+instance (GShow a) => GShow (Bush a)
+
+#endif
+
 -- Example usage
 bush1 :: Bush Int
 bush1 = BushCons 0 (BushCons (BushCons 1 BushNil) BushNil)
@@ -500,38 +454,44 @@ -- Example: Two parameters, datatype constraint, nested on other parameter
 --------------------------------------------------------------------------------
 
--- Any constraints on |b| mean we cannot generate the Representable1 instance
--- Constraints on |a| are just propagated to Representable0 and generic
+-- Any constraints on |b| mean we cannot generate the Generic1 instance
+-- Constraints on |a| are just propagated to Generic and generic
 -- function instances
 data (Show a) => Either a b = Left (Either [a] b) | Right b
 
 
--- Representable1 instances
+-- Generic1 instances
 type Rep0Either a b = Rec0 (Either [a] b) :+: Rec0 b
-instance (Show a) => Representable0 (Either a b) (Rep0Either a b) where
-  from0 (Left a)  = L1 (K1 a)
-  from0 (Right a) = R1 (K1 a)
-  to0 (L1 (K1 a)) = Left a
-  to0 (R1 (K1 a)) = Right a
+instance (Show a) => Generic (Either a b) where
+  type Rep (Either a b) = Rep0Either a b
+  from (Left a)  = L1 (K1 a)
+  from (Right a) = R1 (K1 a)
+  to (L1 (K1 a)) = Left a
+  to (R1 (K1 a)) = Right a
 
 type RepEither a = Rec1 (Either [a]) :+: Par1
-instance (Show a) => Representable1 (Either a) (RepEither a) where
+instance (Show a) => Generic1 (Either a) where
+  type Rep1 (Either a) = RepEither a
   from1 (Left a)  = L1 (Rec1 a)
   from1 (Right a) = R1 (Par1 a)
   to1 (L1 (Rec1 a)) = Left a
   to1 (R1 (Par1 a)) = Right a
 
 
+#if __GLASGOW_HASKELL__ < 701
 -- Instance for gshow (should be automatically generated)
 instance (Show a, GShow a, GShow b) => GShow (Either a b) where
-  gshowsPrec = t undefined where
-    t :: (Show a, GShow a, GShow b) => Rep0Either a b x -> Int -> Either a b -> ShowS
-    t = gshowsPrecdefault
+  gshowsPrec = gshowsPrecdefault
 
 instance (Show a) => GFunctor (Either a) where
-  gmap = t undefined where
-    t :: (Show a) => RepEither a b -> (b -> c) -> Either a b -> Either a c
-    t = gmapdefault
+  gmap = gmapdefault
+
+#else
+
+instance (Show a, GShow a, GShow b) => GShow (Either a b)
+instance (Show a) => GFunctor (Either a)
+
+#endif
 
 either1 :: Either Int Char
 either1 = Left either2

@@ -1,17 +1,21 @@ name:                   generic-deriving-version:                0.4+version:                1.0.1 synopsis:               Generic programming library for generalized deriving. description:    This package provides functionality for generalizing the deriving mechanism-  in Haskell to arbitrary classes. It is described in the paper:+  in Haskell to arbitrary classes. It was first described in the paper:   .   *  /A generic deriving mechanism for Haskell/.      Jose Pedro Magalhaes, Atze Dijkstra, Johan Jeuring, and Andres Loeh.      Haskell'10.+  .+  The current implementation integrates with the new GHC Generics. See+  <http://www.haskell.org/haskellwiki/Generics> for more information.+  Template Haskell code is provided for supporting GHC before version 7.2.  category:               Generics-copyright:              (c) 2010 Universiteit Utrecht+copyright:              (c) 2011 Universiteit Utrecht license:                BSD3 license-file:           LICENSE author:                 José Pedro Magalhães@@ -19,7 +23,7 @@ stability:              experimental build-type:             Custom cabal-version:          >= 1.2.1-tested-with:            GHC == 6.10.4, GHC == 6.12.1, GHC == 7.0.1+tested-with:            GHC == 7.0.3, GHC == 7.2.1 extra-source-files:     examples/Examples.hs  library@@ -28,16 +32,17 @@                         Generics.Deriving.Base                         Generics.Deriving.Instances -                        -- Generics.Deriving.Data                         Generics.Deriving.Enum                         Generics.Deriving.Eq                         Generics.Deriving.Functor-                        -- Generics.Deriving.GMapQ                         Generics.Deriving.Show-                        Generics.Deriving.Typeable                         Generics.Deriving.Uniplate+                         Generics.Deriving.TH                            build-depends:        base < 4.4, template-haskell >=2.4 && <2.6-  extensions:           MultiParamTypeClasses, CPP+  if impl(ghc > 7.0)+    build-depends:      ghc-prim < 0.3++  extensions:           CPP   ghc-options:          -Wall

@@ -6,7 +6,6 @@     module Generics.Deriving.Eq,
     module Generics.Deriving.Functor,
     module Generics.Deriving.Show,
-    module Generics.Deriving.Typeable,
     module Generics.Deriving.Uniplate
     
   ) where
@@ -16,5 +15,4 @@ import Generics.Deriving.Eq
 import Generics.Deriving.Functor
 import Generics.Deriving.Show
-import Generics.Deriving.Typeable
 import Generics.Deriving.Uniplate

@@ -3,10 +3,11 @@ {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE CPP #-}
 
 module Generics.Deriving.Base (
-#ifndef __UHC__
+#if __GLASGOW_HASKELL__ < 710
   -- * Generic representation types
     V1, U1(..), Par1(..), Rec1(..), K1(..), M1(..)
   , (:+:)(..), (:*:)(..), (:.:)(..)
@@ -19,82 +20,54 @@   , Datatype(..), Constructor(..), Selector(..), NoSelector
   , Fixity(..), Associativity(..), Arity(..), prec
 
-  -- * Representable type classes
-  , Representable0(..), Representable1(..)
+  -- * Generic type classes
+  , Generic(..), Generic1(..)
 
   ,
 #else
-  module UHC.Generics,
+  module GHC.Generics,
 #endif
 
   ) where
 
 
-#ifdef __UHC__
-import UHC.Generics
-#endif
+#if __GLASGOW_HASKELL__ >= 701
+import GHC.Generics
 
-#ifndef __UHC__
+#else
 --------------------------------------------------------------------------------
 -- Representation types
 --------------------------------------------------------------------------------
 
 -- | Void: used for datatypes without constructors
-#ifdef __UHC__
-V1 :: * -> *
-#endif
 data V1 p
 
 -- | Unit: used for constructors without arguments
-#ifdef __UHC__
-U1 :: * -> *
-#endif
 data U1 p = U1
 
 -- | Used for marking occurrences of the parameter
-#ifdef __UHC__
-Par1 :: * -> *
-#endif
 newtype Par1 p = Par1 { unPar1 :: p }
 
 
 -- | Recursive calls of kind * -> *
-#ifdef __UHC__
-Rec1 :: (* -> *) -> * -> *
-#endif
 newtype Rec1 f p = Rec1 { unRec1 :: f p }
 
 -- | Constants, additional parameters and recursion of kind *
-#ifdef __UHC__
-K1 :: * -> * -> * -> *
-#endif
 newtype K1 i c p = K1 { unK1 :: c }
 
 -- | Meta-information (constructor names, etc.)
-#ifdef __UHC__
-M1 :: * -> * -> (* -> *) -> * -> *
-#endif
 newtype M1 i c f p = M1 { unM1 :: f p }
 
 -- | Sums: encode choice between constructors
 infixr 5 :+:
-#ifdef __UHC__
-(:+:) :: (* -> *) -> (* -> *) -> * -> *
-#endif
 data (:+:) f g p = L1 { unL1 :: f p } | R1 { unR1 :: g p }
 
 -- | Products: encode multiple arguments to constructors
 infixr 6 :*:
-#ifdef __UHC__
-(:*:) :: (* -> *) -> (* -> *) -> * -> *
-#endif
 data (:*:) f g p = f p :*: g p
 
 -- | Composition of functors
 infixr 7 :.:
-#ifdef __UHC__
-(:.:) :: (* -> *) -> (* -> *) -> * -> *
-#endif
 newtype (:.:) f g p = Comp1 { unComp1 :: f (g p) }
 
 -- | Tag for K1: recursion (of kind *)
@@ -126,22 +99,13 @@ -- | Class for datatypes that represent datatypes
 class Datatype d where
   -- | The name of the datatype, fully qualified
-#ifdef __UHC__
-  datatypeName :: t d f a -> String
-  moduleName   :: t d f a -> String
-#else
   datatypeName :: t d (f :: * -> *) a -> String
   moduleName   :: t d (f :: * -> *) a -> String
-#endif
 
 -- | Class for datatypes that represent records
 class Selector s where
   -- | The name of the selector
-#ifdef __UHC__
-  selName :: t s f a -> String
-#else
   selName :: t s (f :: * -> *) a -> String
-#endif
 
 -- | Used for constructor fields without a name
 data NoSelector
@@ -151,38 +115,17 @@ -- | Class for datatypes that represent data constructors
 class Constructor c where
   -- | The name of the constructor
-#ifdef __UHC__
-  conName :: t c f a -> String
-#else
   conName :: t c (f :: * -> *) a -> String
-#endif
 
   -- | The fixity of the constructor
-#ifdef __UHC__
-  conFixity :: t c f a -> Fixity
-#else
   conFixity :: t c (f :: * -> *) a -> Fixity
-#endif  
   conFixity = const Prefix
 
   -- | Marks if this constructor is a record
-#ifdef __UHC__
-  conIsRecord :: t c f a -> Bool
-#else
   conIsRecord :: t c (f :: * -> *) a -> Bool
-#endif
   conIsRecord = const False
 
-  -- | Marks if this constructor is a tuple, 
-  -- returning arity >=0 if so, <0 if not
-#ifdef __UHC__
-  conIsTuple :: t c f a -> Arity
-#else
-  conIsTuple :: t c (f :: * -> *) a -> Arity
-#endif
-  conIsTuple = const NoArity
 
-
 -- | Datatype to represent the arity of a tuple.
 data Arity = NoArity | Arity Int
   deriving (Eq, Show, Ord, Read)
@@ -204,17 +147,19 @@   deriving (Eq, Show, Ord, Read)
 
 -- | Representable types of kind *
-class Representable0 a rep where
+class Generic a where
+  type Rep a :: * -> *
   -- | Convert from the datatype to its representation
-  from0  :: a -> rep x
+  from  :: a -> Rep a x
   -- | Convert from the representation to the datatype
-  to0    :: rep x -> a
+  to    :: Rep a x -> a
 
 -- | Representable types of kind * -> *
-class Representable1 f rep where
+class Generic1 f where
+  type Rep1 f :: * -> *
   -- | Convert from the datatype to its representation
-  from1  :: f a -> rep a
+  from1  :: f a -> Rep1 f a
   -- | Convert from the representation to the datatype
-  to1    :: rep a -> f a
+  to1    :: Rep1 f a -> f a
 
 #endif

@@ -1,8 +1,11 @@-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE DefaultSignatures #-}
+#endif
 
 module Generics.Deriving.Enum (
 
@@ -22,7 +25,7 @@ 
 
 import Generics.Deriving.Base
-import Generics.Deriving.Instances
+import Generics.Deriving.Instances ()
 import Generics.Deriving.Eq
 
 
@@ -85,60 +88,45 @@   enum' = diag [ [ x :*: y | y <- enum' ] | x <- enum' ]
 
 
-#ifdef __UHC__
+#if __GLASGOW_HASKELL__ < 701
 
-{-# DERIVABLE GEnum genum genumDefault #-}
-deriving instance (GEnum a) => GEnum (Maybe a)
-deriving instance (GEnum a) => GEnum [a]
+instance (GEnum a) => GEnum (Maybe a) where
+  genum = genumDefault
 
-{-# DERIVABLE Enum toEnum toEnumDefault #-}
-{-# DERIVABLE Enum fromEnum fromEnumDefault #-}
+instance (GEnum a) => GEnum [a] where
+  genum = genumDefault
 
 #else
 
-instance (GEnum a) => GEnum (Maybe a) where
-  genum = t undefined where
-    t :: (GEnum a) => Rep0Maybe a x -> [Maybe a]
-    t = genumDefault
-
-instance (GEnum a) => GEnum [a] where
-  genum = t undefined where
-    t :: (GEnum a) => Rep0List a x -> [[a]]
-    t = genumDefault
+instance (GEnum a) => GEnum (Maybe a)
+instance (GEnum a) => GEnum [a]
 
 #endif
 
-genumDefault :: (Representable0 a rep0, Enum' rep0) => rep0 x -> [a]
-genumDefault rep = map to0 (enum' `asTypeOf` [rep])
+genumDefault :: (Generic a, Enum' (Rep a)) => [a]
+genumDefault = map to enum'
 
-toEnumDefault :: (Representable0 a rep0, Enum' rep0) => rep0 x -> Int -> a
-toEnumDefault rep i = let l = enum' `asTypeOf` [rep]
-                      in if (length l > i)
-                         then to0 (l !! i)
-                         else error "toEnum: invalid index"
+toEnumDefault :: (Generic a, Enum' (Rep a)) => Int -> a
+toEnumDefault i = let l = enum'
+                  in if (length l > i)
+                      then to (l !! i)
+                       else error "toEnum: invalid index"
 
-fromEnumDefault :: (GEq a, Representable0 a rep0, Enum' rep0)
-                => rep0 x -> a -> Int
-fromEnumDefault rep x = t x (map to0 (enum' `asTypeOf` [rep])) where
-  -- This weird local function is to appease EHC's type checker
-  t :: GEq a => a -> [a] -> Int
-  t y l = case (findIndex (geq y) l) of
-            Nothing -> error "fromEnum: no corresponding index"
-            Just i  -> i
+fromEnumDefault :: (GEq a, Generic a, Enum' (Rep a))
+                => a -> Int
+fromEnumDefault x = case findIndex (geq x) (map to enum') of
+      Nothing -> error "fromEnum: no corresponding index"
+      Just i  -> i
 
-{-
--- Natural definition
-fromEnumDefault :: (GEq a, Representable0 a rep0, Enum' rep0)
-                => rep0 x -> a -> Int
-fromEnumDefault rep x = let l = map to0 (enum' `asTypeOf` [rep])
-                        in case (findIndex (geq x) l) of
-                             Nothing -> error "fromEnum: no corresponding index"
-                             Just i  -> i
--}
 
 class GEnum a where
   genum :: [a]
 
+#if __GLASGOW_HASKELL__ >= 701
+  default genum :: (Generic a, Enum' (Rep a)) => [a]
+  genum = genumDefault
+#endif
+
 instance GEnum Int where
   genum = [0..] ||| (neg 0) where
     neg n = (n-1) : neg (n-1)
@@ -156,22 +144,29 @@     -- | Returns 'True' the given subscript lies in the range defined
     -- the bounding pair.
     inRange             :: (a,a) -> a -> Bool
+#if __GLASGOW_HASKELL__ >= 701
+    default range :: (GEq a, Generic a, Enum' (Rep a)) => (a,a) -> [a]
+    range = rangeDefault
 
+    default index :: (GEq a, Generic a, Enum' (Rep a)) => (a,a) -> a -> Int
+    index = indexDefault
 
-rangeDefault :: (GEq a, Representable0 a rep0, Enum' rep0)
-             => rep0 x -> (a,a) -> [a]
-rangeDefault rep = t (map to0 (enum' `asTypeOf` [rep])) where
-  t :: GEq a => [a] -> (a,a) -> [a]
+    default inRange :: (GEq a, Generic a, Enum' (Rep a)) => (a,a) -> a -> Bool
+    inRange = inRangeDefault
+#endif
+
+rangeDefault :: (GEq a, Generic a, Enum' (Rep a))
+             => (a,a) -> [a]
+rangeDefault = t (map to enum') where
   t l (x,y) = 
     case (findIndex (geq x) l, findIndex (geq y) l) of
       (Nothing, _)     -> error "rangeDefault: no corresponding index"
       (_, Nothing)     -> error "rangeDefault: no corresponding index"
       (Just i, Just j) -> take (j-i) (drop i l)
 
-indexDefault :: (GEq a, Representable0 a rep0, Enum' rep0)
-             => rep0 x -> (a,a) -> a -> Int
-indexDefault rep = t (map to0 (enum' `asTypeOf` [rep])) where
-  t :: GEq a => [a] -> (a,a) -> a -> Int
+indexDefault :: (GEq a, Generic a, Enum' (Rep a))
+             => (a,a) -> a -> Int
+indexDefault = t (map to enum') where
   t l (x,y) z =
     case (findIndex (geq x) l, findIndex (geq y) l) of
       (Nothing, _)     -> error "indexDefault: no corresponding index"
@@ -180,10 +175,9 @@                             Nothing -> error "indexDefault: index out of range"
                             Just k  -> k
 
-inRangeDefault :: (GEq a, Representable0 a rep0, Enum' rep0)
-               => rep0 x -> (a,a) -> a -> Bool
-inRangeDefault rep = t (map to0 (enum' `asTypeOf` [rep])) where
-  t :: GEq a => [a] -> (a,a) -> a -> Bool
+inRangeDefault :: (GEq a, Generic a, Enum' (Rep a))
+               => (a,a) -> a -> Bool
+inRangeDefault = t (map to enum') where
   t l (x,y) z = 
     case (findIndex (geq x) l, findIndex (geq y) l) of
       (Nothing, _)     -> error "indexDefault: no corresponding index"
@@ -191,44 +185,22 @@       (Just i, Just j) -> maybe False (const True)
                             (findIndex (geq z) (take (j-i) (drop i l)))
 
-#ifdef __UHC__
+#if __GLASGOW_HASKELL__ < 701
 
-{-# DERIVABLE GIx range rangeDefault #-}
-{-# DERIVABLE GIx index indexDefault #-}
-{-# DERIVABLE GIx inRange inRangeDefault #-}
+instance (GEq a, GEnum a, GIx a) => GIx (Maybe a) where
+  range = rangeDefault
+  index = indexDefault
+  inRange = inRangeDefault
 
-deriving instance (GEq a, GEnum a, GIx a) => GIx (Maybe a)
-deriving instance (GEq a, GEnum a, GIx a) => GIx [a]
+instance (GEq a, GEnum a, GIx a) => GIx [a] where
+  range = rangeDefault
+  index = indexDefault
+  inRange = inRangeDefault
 
 #else
 
-instance (GEq a, GEnum a, GIx a) => GIx (Maybe a) where
-  range = t undefined where
-    t :: (GEq a, GEnum a, GIx a)
-      => Rep0Maybe a x -> (Maybe a, Maybe a) -> [Maybe a]
-    t = rangeDefault
-  index = t undefined where
-    t :: (GEq a, GEnum a, GIx a)
-      => Rep0Maybe a x -> (Maybe a, Maybe a) -> Maybe a -> Int
-    t = indexDefault
-  inRange = t undefined where
-    t :: (GEq a, GEnum a, GIx a)
-      => Rep0Maybe a x -> (Maybe a, Maybe a) -> Maybe a -> Bool
-    t = inRangeDefault
-
-instance (GEq a, GEnum a, GIx a) => GIx [a] where
-  range = t undefined where
-    t :: (GEq a, GEnum a, GIx a)
-      => Rep0List a x -> ([a], [a]) -> [[a]]
-    t = rangeDefault
-  index = t undefined where
-    t :: (GEq a, GEnum a, GIx a)
-      => Rep0List a x -> ([a], [a]) -> [a] -> Int
-    t = indexDefault
-  inRange = t undefined where
-    t :: (GEq a, GEnum a, GIx a)
-      => Rep0List a x -> ([a], [a]) -> [a] -> Bool
-    t = inRangeDefault
+instance (GEq a, GEnum a, GIx a) => GIx (Maybe a)
+instance (GEq a, GEnum a, GIx a) => GIx [a]
 
 #endif
 

@@ -1,21 +1,32 @@-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE CPP #-}
 
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE DefaultSignatures #-}
+#endif
+
+
 module Generics.Deriving.Eq (
   -- * Generic show class
     GEq(..)
 
+#if __GLASGOW_HASKELL__ >= 701
+-- Nothing
+#else
   -- * Default definition
   , geqdefault
+#endif
 
   ) where
 
 
 import Generics.Deriving.Base
-import Generics.Deriving.Instances
+import Generics.Deriving.Instances ()
+-- import GHC.Generics
 
 --------------------------------------------------------------------------------
 -- Generic show
@@ -47,17 +58,18 @@ class GEq a where 
   geq :: a -> a -> Bool
 
-#ifdef __UHC__
 
-{-# DERIVABLE GEq geq geqdefault #-}
-deriving instance (GEq a) => GEq (Maybe a)
-deriving instance (GEq a) => GEq [a]
-
+#if __GLASGOW_HASKELL__ >= 701
+  default geq :: (Generic a, GEq' (Rep a)) => a -> a -> Bool
+  geq x y = geq' (from x) (from y)
 #endif
 
-geqdefault :: (Representable0 a rep0, GEq' rep0) => rep0 x -> a -> a -> Bool
-geqdefault rep x y = geq' (from0 x `asTypeOf` rep) (from0 y `asTypeOf` rep)
-
+#if __GLASGOW_HASKELL__ >= 701
+-- Nothing; the default is in the class
+#else
+geqdefault :: (Generic a, GEq' (Rep a)) => a -> a -> Bool
+geqdefault x y = geq' (from x) (from y)
+#endif
 
 -- Base types instances
 instance GEq Char   where geq = (==)
@@ -65,16 +77,17 @@ instance GEq Float  where geq = (==)
 
 
-#ifndef __UHC__
+#if __GLASGOW_HASKELL__ < 701
 
 instance (GEq a) => GEq (Maybe a) where
-  geq = t undefined where
-    t :: (GEq a) => Rep0Maybe a x -> Maybe a -> Maybe a -> Bool
-    t = geqdefault
+  geq = geqdefault
 
 instance (GEq a) => GEq [a] where
-  geq = t undefined where
-    t :: (GEq a) => Rep0List a x -> [a] -> [a] -> Bool
-    t = geqdefault
+  geq = geqdefault
+
+#else
+
+instance (GEq a) => GEq (Maybe a)
+instance (GEq a) => GEq [a]
 
 #endif

@@ -1,6 +1,9 @@-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE DefaultSignatures #-}
+#endif
 
 module Generics.Deriving.Functor (
   -- * GFunctor class
@@ -12,7 +15,7 @@   ) where
 
 import Generics.Deriving.Base
-import Generics.Deriving.Instances
+import Generics.Deriving.Instances ()
 
 --------------------------------------------------------------------------------
 -- Generic fmap
@@ -49,29 +52,19 @@ 
 class GFunctor f where
   gmap :: (a -> b) -> f a -> f b
-
-gmapdefault :: (Representable1 f rep, GFunctor' rep)
-            => rep a -> (a -> b) -> f a -> f b
-gmapdefault ra f x = to1 (gmap' f (from1 x `asTypeOf` ra))
-
-#ifdef __UHC__
-
-{-# DERIVABLE GFunctor gmap gmapdefault #-}
-
-deriving instance GFunctor Maybe
-deriving instance GFunctor []
+#if __GLASGOW_HASKELL__ >= 701
+  default gmap :: (Generic1 f, GFunctor' (Rep1 f))
+               => (a -> b) -> f a -> f b
+  gmap = gmapdefault
+#endif
 
-#else
+gmapdefault :: (Generic1 f, GFunctor' (Rep1 f))
+            => (a -> b) -> f a -> f b
+gmapdefault f = to1 . gmap' f . from1
 
 -- Base types instances
 instance GFunctor Maybe where
-  gmap = t undefined where
-    t :: Rep1Maybe a -> (a -> b) -> Maybe a -> Maybe b
-    t = gmapdefault
+  gmap = gmapdefault
 
 instance GFunctor [] where
-  gmap = t undefined where
-    t :: Rep1List a -> (a -> b) -> [a] -> [b]
-    t = gmapdefault
-
-#endif
+  gmap = gmapdefault

@@ -2,16 +2,23 @@ {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Generics.Deriving.Instances (
+-- Only instances from Generics.Deriving.Base
+-- and the Generic1 instances
+    Rep1Maybe, Rep1List
+#if __GLASGOW_HASKELL__ < 701
   -- * Representations for base types
-    Rep0Char, Rep0Int, Rep0Float
-  , Rep0Maybe, Rep1Maybe
-  , Rep0List, Rep1List
+  , Rep0Char, Rep0Int, Rep0Float
+  , Rep0Maybe, Rep0List
+#endif
   ) where
 
 import Generics.Deriving.Base
 
+#if __GLASGOW_HASKELL__ < 701
 --------------------------------------------------------------------------------
 -- Representation for base types
 --------------------------------------------------------------------------------
@@ -19,36 +26,58 @@ -- Representation types
 {-
 type Rep1Par1 = Par1
-instance Representable1 Par1 Rep1Par1 where
+instance Generic1 Par1 Rep1Par1 where
   from1 = id
   to1 = id
 
 type Rep1Rec1 f = Rec1 f
-instance Representable1 (Rec1 f) (Rep1Rec1 f) where
+instance Generic1 (Rec1 f) (Rep1Rec1 f) where
   from1 = id
   to1 = id
 -}
 -- Kind *
 
 type Rep0Char = Rec0 Char
-instance Representable0 Char Rep0Char where
-  from0 = K1
-  to0 = unK1
+instance Generic Char where
+  type Rep Char = Rep0Char
+  from = K1
+  to = unK1
 
 type Rep0Int = Rec0 Int
-instance Representable0 Int Rep0Int where
-  from0 = K1
-  to0 = unK1
+instance Generic Int where
+  type Rep Int = Rep0Int
+  from = K1
+  to = unK1
 
 type Rep0Float = Rec0 Float
-instance Representable0 Float Rep0Float where
-  from0 = K1
-  to0 = unK1
+instance Generic Float where
+  type Rep Float = Rep0Float
+  from = K1
+  to = unK1
 
 -- etc...
 
 -- Kind * -> *
 
+type Rep0Maybe a = D1 Maybe_ (C1 Nothing_ U1 :+: C1 Just_ (Par0 a))
+instance Generic (Maybe a) where
+  type Rep (Maybe a) = Rep0Maybe a
+  from Nothing  = M1 (L1 (M1 U1))
+  from (Just x) = M1 (R1 (M1 (K1 x)))
+  to (M1 (L1 (M1 U1)))     = Nothing
+  to (M1 (R1 (M1 (K1 x)))) = Just x
+
+type Rep0List a = D1 List__ ((C1 Nil__ U1) :+: (C1 Cons__ (Par0 a :*: Rec0 [a])))
+instance Generic [a] where
+  type Rep [a] = Rep0List a
+  from []    = M1 (L1 (M1 U1))
+  from (h:t) = M1 (R1 (M1 (K1 h :*: K1 t)))
+  to (M1 (L1 (M1 U1)))              = []
+  to (M1 (R1 (M1 (K1 h :*: K1 t)))) = h : t
+#endif
+
+-- GHC 7.2 still needs these instances
+
 data Maybe_
 data Nothing_
 data Just_
@@ -63,15 +92,10 @@ instance Constructor Just_ where
   conName _ = "Just"
 
-type Rep0Maybe a = D1 Maybe_ (C1 Nothing_ U1 :+: C1 Just_ (Par0 a))
-instance Representable0 (Maybe a) (Rep0Maybe a) where
-  from0 Nothing  = M1 (L1 (M1 U1))
-  from0 (Just x) = M1 (R1 (M1 (K1 x)))
-  to0 (M1 (L1 (M1 U1)))     = Nothing
-  to0 (M1 (R1 (M1 (K1 x)))) = Just x
 
 type Rep1Maybe = D1 Maybe_ (C1 Nothing_ U1 :+: C1 Just_ Par1)
-instance Representable1 Maybe Rep1Maybe where
+instance Generic1 Maybe where
+  type Rep1 Maybe = Rep1Maybe
   from1 Nothing  = M1 (L1 (M1 U1))
   from1 (Just x) = M1 (R1 (M1 (Par1 x)))
   to1 (M1 (L1 (M1 U1)))       = Nothing
@@ -82,7 +106,7 @@ data Nil__
 data Cons__
 
-instance Datatype [a] where
+instance Datatype List__ where
   datatypeName _ = "[]"
   moduleName   _ = "Data.List"
 
@@ -91,15 +115,10 @@   conName   _ = ":"
   conFixity _ = Infix RightAssociative 5
 
-type Rep0List a = D1 List__ ((C1 Nil__ U1) :+: (C1 Cons__ (Par0 a :*: Rec0 [a])))
-instance Representable0 [a] (Rep0List a) where
-  from0 []    = M1 (L1 (M1 U1))
-  from0 (h:t) = M1 (R1 (M1 (K1 h :*: K1 t)))
-  to0 (M1 (L1 (M1 U1)))              = []
-  to0 (M1 (R1 (M1 (K1 h :*: K1 t)))) = h : t
 
 type Rep1List = D1 List__ ((C1 Nil__ U1) :+: (C1 Cons__ (Par1 :*: Rec1 [])))
-instance Representable1 [] Rep1List where
+instance Generic1 [] where
+  type Rep1 [] = Rep1List
   from1 []    = M1 (L1 (M1 U1))
   from1 (h:t) = M1 (R1 (M1 (Par1 h :*: Rec1 t)))
   to1 (M1 (L1 (M1 U1)))                  = []

@@ -1,9 +1,12 @@-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE OverlappingInstances #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE IncoherentInstances #-} -- :-/
 {-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE DefaultSignatures #-}
+#endif
 
 module Generics.Deriving.Show (
   -- * Generic show class
@@ -16,12 +19,15 @@ 
 
 import Generics.Deriving.Base
-import Generics.Deriving.Instances
+import Generics.Deriving.Instances ()
 
 --------------------------------------------------------------------------------
 -- Generic show
 --------------------------------------------------------------------------------
 
+appPrec :: Int
+appPrec = 2
+
 data Type = Rec | Tup | Pref | Inf String
 
 class GShow' f where
@@ -42,28 +48,29 @@ instance (GShow' a, Constructor c) => GShow' (M1 C c a) where
   gshowsPrec' _ n c@(M1 x) = 
     case fixity of
-      Prefix    -> showParen (n > 10 && not (isNullary x)) 
+      Prefix    -> showParen (n > appPrec && not (isNullary x)) 
                     ( showString (conName c) 
                     . if (isNullary x) then id else showChar ' '
-                    . showBraces t (gshowsPrec' t 10 x))
+                    . showBraces t (gshowsPrec' t appPrec x))
       Infix _ m -> showParen (n > m) (showBraces t (gshowsPrec' t m x))
       where fixity = conFixity c
             t = if (conIsRecord c) then Rec else
                   case (conIsTuple c) of
-                    Arity _ -> Tup
-                    NoArity -> case fixity of
-                                 Prefix    -> Pref
-                                 Infix _ _ -> Inf (show (conName c))
+                    True -> Tup
+                    False -> case fixity of
+                                Prefix    -> Pref
+                                Infix _ _ -> Inf (show (conName c))
             showBraces :: Type -> ShowS -> ShowS
             showBraces Rec     p = showChar '{' . p . showChar '}'
             showBraces Tup     p = showChar '(' . p . showChar ')'
             showBraces Pref    p = p
             showBraces (Inf _) p = p
-  
-  isNullary (M1 x) = isNullary x
+            conIsTuple y = tupleName (conName y) where
+              tupleName ('(':',':_) = True
+              tupleName _           = False
 
 instance (Selector s, GShow' a) => GShow' (M1 S s a) where
-  gshowsPrec' t n s@(M1 x) | selName s == "" = showParen (n > 10)
+  gshowsPrec' t n s@(M1 x) | selName s == "" = --showParen (n > appPrec)
                                                  (gshowsPrec' t n x)
                            | otherwise       =   showString (selName s)
                                                . showString " = "
@@ -97,25 +104,23 @@   gshows = gshowsPrec 0
   gshow :: a -> String
   gshow x = gshows x ""
-  
-
-#ifdef __UHC__
+#if __GLASGOW_HASKELL__ >= 701
+  default gshowsPrec :: (Generic a, GShow' (Rep a))
+                     => Int -> a -> ShowS
+  gshowsPrec = gshowsPrecdefault
 
-{-# DERIVABLE GShow gshowsPrec gshowsPrecdefault #-}
-deriving instance (GShow a) => GShow (Maybe a)
+instance (GShow a) => GShow (Maybe a)
 
 #else
 
 instance (GShow a) => GShow (Maybe a) where
-  gshowsPrec = t undefined where
-    t :: (GShow a) => Rep0Maybe a x -> Int -> Maybe a -> ShowS
-    t = gshowsPrecdefault
+  gshowsPrec = gshowsPrecdefault
 
 #endif
 
-gshowsPrecdefault :: (Representable0 a rep0, GShow' rep0)
-                  => rep0 x -> Int -> a -> ShowS
-gshowsPrecdefault rep n x = gshowsPrec' Pref n (from0 x `asTypeOf` rep)
+gshowsPrecdefault :: (Generic a, GShow' (Rep a))
+                  => Int -> a -> ShowS
+gshowsPrecdefault n = gshowsPrec' Pref n . from
 
 
 -- Base types instances

@@ -13,19 +13,24 @@ -- -- This module contains Template Haskell code that can be used to -- automatically generate the boilerplate code for the generic deriving--- library. For now, it generates only the 'Representable0' instance.+-- library. For now, it generates only the 'Generic' instance. -- Empty datatypes are not yet supported. -----------------------------------------------------------------------------  -- Adapted from Generics.Regular.TH module Generics.Deriving.TH (-      deriveAll+      +      deriveMeta     , deriveData     , deriveConstructors     , deriveSelectors++#if __GLASGOW_HASKELL__ < 701+    , deriveAll     , deriveRepresentable0     , deriveRep0     , simplInstance+#endif   ) where  import Generics.Deriving.Base@@ -56,11 +61,19 @@ -- instances, and the 'Representable0' instance. deriveAll :: Name -> Q [Dec] deriveAll n =+  do a <- deriveMeta n+     b <- deriveRepresentable0 n+     return (a ++ b)++-- | Given the type and the name (as string) for the type to derive,+-- generate the 'Data' instance, the 'Constructor' instances, and the 'Selector'+-- instances.+deriveMeta :: Name -> Q [Dec]+deriveMeta n =   do a <- deriveData n      b <- deriveConstructors n      c <- deriveSelectors n-     d <- deriveRepresentable0 n-     return (a ++ b ++ c ++ d)+     return (a ++ b ++ c)  -- | Given a datatype name, derive a datatype and instance of class 'Datatype'. deriveData :: Name -> Q [Dec]@@ -95,12 +108,13 @@   i <- reify t   let typ q = foldl (\a -> AppT a . VarT . tyVarBndrToName) (ConT q)                  (typeVariables i)+  let tyIns = TySynInstD ''Rep [typ t] (typ (genRepName 0 t))   fcs <- mkFrom t 1 0 t   tcs <- mkTo   t 1 0 t   liftM (:[]) $-    instanceD (cxt [])-     (conT ''Representable0 `appT` return (typ t) `appT`-       return (typ (genRepName 0 t))) [funD 'from0 fcs, funD 'to0 tcs]+    instanceD (cxt []) (conT ''Generic `appT` return (typ t))+                         [return tyIns, funD 'from fcs, funD 'to tcs]+  dataInstance :: Name -> Q [Dec] dataInstance n = do

@@ -1,93 +0,0 @@-{-# LANGUAGE EmptyDataDecls #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-
-module Generics.Deriving.Typeable (
-
-    typeOf0default, typeOf1default,
-
-#ifndef __UHC__
-    module Data.Typeable
-#endif
-
-  ) where
-
-
-import Generics.Deriving.Base
-
-#ifndef __UHC__
-import Data.Typeable
-#endif
-
---------------------------------------------------------------------------------
--- Typeable0
---------------------------------------------------------------------------------
-
-#ifdef __UHC__
-data TypeRep
-instance Eq TypeRep where (==) = undefined
-
-data TyCon
-instance Eq TyCon where (==) = undefined
-
-mkTyConApp  :: TyCon -> [TypeRep] -> TypeRep
-mkTyConApp = undefined
-
-
-mkFunTy  :: TypeRep -> TypeRep -> TypeRep
-mkFunTy = undefined
-
-splitTyConApp :: TypeRep -> (TyCon,[TypeRep])
-splitTyConApp = undefined
-
-funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep
-funResultTy = undefined
-
-mkAppTy :: TypeRep -> TypeRep -> TypeRep
-mkAppTy = undefined
-
-mkTyCon :: String -> TyCon
-mkTyCon = undefined
-
-typeRepTyCon :: TypeRep -> TyCon
-typeRepTyCon = undefined
-
-typeRepArgs :: TypeRep -> [TypeRep]
-typeRepArgs = undefined
-
-
-class Typeable a where
-  typeOf :: a -> TypeRep
-
-class Typeable1 f where
-  typeOf1 :: f a -> TypeRep
-
-#endif
-
-
-class Typeable0' f where
-  typeOf0' :: f a -> TypeRep
-
-instance (Datatype d) => Typeable0' (M1 D d a) where
-  typeOf0' x = mkTyConApp (mkTyCon (datatypeName x)) []
-
-
-typeOf0default :: (Representable0 a rep, Typeable0' rep)
-              => rep x -> a -> TypeRep
-typeOf0default rep x = typeOf0' (from0 x `asTypeOf` rep)
-
-
-class Typeable1' f a where
-  typeOf1' :: f a -> TypeRep
-
-instance (Typeable a, Datatype d) => Typeable1' (M1 D d f) a where
-  typeOf1' x = mkTyConApp (mkTyCon (datatypeName x)) [typeOf (y x)]
-    where y :: M1 D d f b -> b
-          y _ = undefined
-
-
-typeOf1default :: (Representable1 f rep, Typeable1' rep a)
-              => rep a -> f a -> TypeRep
-typeOf1default rep x = typeOf1' (from1 x `asTypeOf` rep)

@@ -1,9 +1,13 @@ {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE OverlappingInstances #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE IncoherentInstances #-} -- :-/
 {-# LANGUAGE CPP #-}
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE DefaultSignatures #-}
+#endif
 
 module Generics.Deriving.Uniplate (
     Uniplate(..)
@@ -15,7 +19,7 @@ 
 
 import Generics.Deriving.Base
-import Generics.Deriving.Instances
+import Generics.Deriving.Instances ()
 
 --------------------------------------------------------------------------------
 -- Generic Uniplate
@@ -46,31 +50,27 @@ 
 class Uniplate a where 
   children :: a -> [a]
-  children _ = []
-
-#ifdef __UHC__
-
-{-# DERIVABLE Uniplate children childrendefault #-}
-deriving instance (Uniplate a) => Uniplate (Maybe a)
-
+#if __GLASGOW_HASKELL__ >= 701
+  default children :: (Generic a, Uniplate' (Rep a) a) => a -> [a]
+  children = childrendefault
 #endif
 
-childrendefault :: (Representable0 a rep0, Uniplate' rep0 a) => rep0 x -> a -> [a]
-childrendefault rep x = children' (from0 x `asTypeOf` rep)
+childrendefault :: (Generic a, Uniplate' (Rep a) a) => a -> [a]
+childrendefault = children' . from
 
 
 -- Base types instances
-instance Uniplate Char
-instance Uniplate Int
-instance Uniplate Float
+instance Uniplate Char  where children _ = []
+instance Uniplate Int   where children _ = []
+instance Uniplate Float where children _ = []
 
 instance Uniplate [a] where
   children []    = []
   children (_:t) = [t]
 
-#ifndef __UHC__
+#if __GLASGOW_HASKELL__ < 701
 instance (Uniplate a) => Uniplate (Maybe a) where
-  children = t undefined where
-    t :: Rep0Maybe a x -> Maybe a -> [Maybe a]
-    t = childrendefault
+  children = childrendefault
+#else
+instance (Uniplate a) => Uniplate (Maybe a)
 #endif