Hello community,
here is the log from the commit of package ghc-generic-deriving for
openSUSE:Factory checked in at 2016-06-25 02:20:55
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-generic-deriving (Old)
and /work/SRC/openSUSE:Factory/.ghc-generic-deriving.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-generic-deriving"
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-generic-deriving/ghc-generic-deriving.changes
2016-06-07 23:46:30.000000000 +0200
+++
/work/SRC/openSUSE:Factory/.ghc-generic-deriving.new/ghc-generic-deriving.changes
2016-06-25 02:21:49.000000000 +0200
@@ -1,0 +2,9 @@
+Sun Jun 19 14:47:57 UTC 2016 - [email protected]
+
+- update to 1.10.5
+* Apply an optimization to generated to(1)/from(1) instances that factors
+ out common occurrences of M1
+* Export internal typeclass names
+* Fix Haddock issues with GHC 7.8
+
+-------------------------------------------------------------------
Old:
----
generic-deriving-1.10.4.1.tar.gz
New:
----
generic-deriving-1.10.5.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-generic-deriving.spec ++++++
--- /var/tmp/diff_new_pack.XkSjQp/_old 2016-06-25 02:21:50.000000000 +0200
+++ /var/tmp/diff_new_pack.XkSjQp/_new 2016-06-25 02:21:50.000000000 +0200
@@ -18,7 +18,7 @@
%global pkg_name generic-deriving
Name: ghc-%{pkg_name}
-Version: 1.10.4.1
+Version: 1.10.5
Release: 0
Summary: Generic programming library for generalised deriving
Group: System/Libraries
++++++ generic-deriving-1.10.4.1.tar.gz -> generic-deriving-1.10.5.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/generic-deriving-1.10.4.1/CHANGELOG.md
new/generic-deriving-1.10.5/CHANGELOG.md
--- old/generic-deriving-1.10.4.1/CHANGELOG.md 2016-04-13 15:20:14.000000000
+0200
+++ new/generic-deriving-1.10.5/CHANGELOG.md 2016-06-19 01:54:56.000000000
+0200
@@ -1,3 +1,10 @@
+# 1.10.5
+* Apply an optimization to generated `to(1)`/`from(1)` instances that factors
out
+ common occurrences of `M1`. See
+
http://git.haskell.org/ghc.git/commit/9649fc0ae45e006c2ed54cc5ea2414158949fadb
+* Export internal typeclass names
+* Fix Haddock issues with GHC 7.8
+
# 1.10.4.1
* Fix Haddock parsing issue on GHC 8.0
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/generic-deriving-1.10.4.1/generic-deriving.cabal
new/generic-deriving-1.10.5/generic-deriving.cabal
--- old/generic-deriving-1.10.4.1/generic-deriving.cabal 2016-04-13
15:20:14.000000000 +0200
+++ new/generic-deriving-1.10.5/generic-deriving.cabal 2016-06-19
01:54:56.000000000 +0200
@@ -1,5 +1,5 @@
name: generic-deriving
-version: 1.10.4.1
+version: 1.10.5
synopsis: Generic programming library for generalised deriving.
description:
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/generic-deriving-1.10.4.1/src/Generics/Deriving/Copoint.hs
new/generic-deriving-1.10.5/src/Generics/Deriving/Copoint.hs
--- old/generic-deriving-1.10.4.1/src/Generics/Deriving/Copoint.hs
2016-04-13 15:20:14.000000000 +0200
+++ new/generic-deriving-1.10.5/src/Generics/Deriving/Copoint.hs
2016-06-19 01:54:56.000000000 +0200
@@ -14,10 +14,13 @@
module Generics.Deriving.Copoint (
-- * GCopoint class
- GCopoint(..),
+ GCopoint(..)
-- * Default method
- gcopointdefault
+ , gcopointdefault
+
+ -- * Internal class
+ , GCopoint'(..)
) where
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/generic-deriving-1.10.4.1/src/Generics/Deriving/Enum.hs
new/generic-deriving-1.10.5/src/Generics/Deriving/Enum.hs
--- old/generic-deriving-1.10.4.1/src/Generics/Deriving/Enum.hs 2016-04-13
15:20:14.000000000 +0200
+++ new/generic-deriving-1.10.5/src/Generics/Deriving/Enum.hs 2016-06-19
01:54:56.000000000 +0200
@@ -24,6 +24,9 @@
-- * Default definitions for GEnum
, genumDefault, toEnumDefault, fromEnumDefault
+ -- * Internal enum class
+ , Enum'(..)
+
-- * Generic Ix class
, GIx(..)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/generic-deriving-1.10.4.1/src/Generics/Deriving/Eq.hs
new/generic-deriving-1.10.5/src/Generics/Deriving/Eq.hs
--- old/generic-deriving-1.10.4.1/src/Generics/Deriving/Eq.hs 2016-04-13
15:20:14.000000000 +0200
+++ new/generic-deriving-1.10.5/src/Generics/Deriving/Eq.hs 2016-06-19
01:54:56.000000000 +0200
@@ -19,12 +19,15 @@
#include "HsBaseConfig.h"
module Generics.Deriving.Eq (
- -- * Generic show class
+ -- * Generic Eq class
GEq(..)
-- * Default definition
, geqdefault
+ -- * Internal Eq class
+ , GEq'(..)
+
) where
import Control.Applicative (Const, ZipList)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/generic-deriving-1.10.4.1/src/Generics/Deriving/Foldable.hs
new/generic-deriving-1.10.5/src/Generics/Deriving/Foldable.hs
--- old/generic-deriving-1.10.4.1/src/Generics/Deriving/Foldable.hs
2016-04-13 15:20:14.000000000 +0200
+++ new/generic-deriving-1.10.5/src/Generics/Deriving/Foldable.hs
2016-06-19 01:54:56.000000000 +0200
@@ -14,7 +14,7 @@
#endif
module Generics.Deriving.Foldable (
- -- * Foldable class
+ -- * Generic Foldable class
GFoldable(..)
-- * Default method
@@ -37,6 +37,9 @@
, gelem
, gnotElem
, gfind
+
+ -- * Internal Foldable class
+ , GFoldable'(..)
) where
import Control.Applicative (Const, ZipList)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/generic-deriving-1.10.4.1/src/Generics/Deriving/Functor.hs
new/generic-deriving-1.10.5/src/Generics/Deriving/Functor.hs
--- old/generic-deriving-1.10.4.1/src/Generics/Deriving/Functor.hs
2016-04-13 15:20:14.000000000 +0200
+++ new/generic-deriving-1.10.5/src/Generics/Deriving/Functor.hs
2016-06-19 01:54:56.000000000 +0200
@@ -14,12 +14,15 @@
#endif
module Generics.Deriving.Functor (
- -- * GFunctor class
+ -- * Generic Functor class
GFunctor(..)
-- * Default method
, gmapdefault
+ -- * Internal Functor class
+ , GFunctor'(..)
+
) where
import Control.Applicative (Const, ZipList)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/generic-deriving-1.10.4.1/src/Generics/Deriving/Instances.hs
new/generic-deriving-1.10.5/src/Generics/Deriving/Instances.hs
--- old/generic-deriving-1.10.4.1/src/Generics/Deriving/Instances.hs
2016-04-13 15:20:14.000000000 +0200
+++ new/generic-deriving-1.10.5/src/Generics/Deriving/Instances.hs
2016-06-19 01:54:56.000000000 +0200
@@ -145,10 +145,12 @@
instance Generic ExitCode where
type Rep ExitCode = Rep0ExitCode
- from ExitSuccess = M1 (L1 (M1 U1))
- from (ExitFailure g) = M1 (R1 (M1 (M1 (K1 g))))
- to (M1 (L1 (M1 U1))) = ExitSuccess
- to (M1 (R1 (M1 (M1 (K1 g))))) = ExitFailure g
+ from x = M1 (case x of
+ ExitSuccess -> L1 (M1 U1)
+ ExitFailure g -> R1 (M1 (M1 (K1 g))))
+ to (M1 x) = case x of
+ L1 (M1 U1) -> ExitSuccess
+ R1 (M1 (M1 (K1 g))) -> ExitFailure g
data D1ExitCode
data C1_0ExitCode
@@ -200,10 +202,12 @@
instance Generic1 (f :+: g) where
type Rep1 (f :+: g) = Rep1ConSum f g
- from1 (L1 l) = M1 (L1 (M1 (M1 (Rec1 l))))
- from1 (R1 r) = M1 (R1 (M1 (M1 (Rec1 r))))
- to1 (M1 (L1 (M1 (M1 l)))) = L1 (unRec1 l)
- to1 (M1 (R1 (M1 (M1 r)))) = R1 (unRec1 r)
+ from1 x = M1 (case x of
+ L1 l -> L1 (M1 (M1 (Rec1 l)))
+ R1 r -> R1 (M1 (M1 (Rec1 r))))
+ to1 (M1 x) = case x of
+ L1 (M1 (M1 l)) -> L1 (unRec1 l)
+ R1 (M1 (M1 r)) -> R1 (unRec1 r)
data D1ConSum
data C1_0ConSum
@@ -730,11 +734,13 @@
instance Generic Arity where
type Rep Arity = Rep0Arity
- from NoArity = M1 (L1 (M1 U1))
- from (Arity a) = M1 (R1 (M1 (M1 (K1 a))))
-
- to (M1 (L1 (M1 U1))) = NoArity
- to (M1 (R1 (M1 (M1 (K1 a))))) = Arity a
+ from x = M1 (case x of
+ NoArity -> L1 (M1 U1)
+ Arity a -> R1 (M1 (M1 (K1 a))))
+
+ to (M1 x) = case x of
+ L1 (M1 U1) -> NoArity
+ R1 (M1 (M1 (K1 a))) -> Arity a
data D1Arity
data C1_0Arity
@@ -763,13 +769,15 @@
instance Generic Associativity where
type Rep Associativity = Rep0Associativity
- from LeftAssociative = M1 (L1 (M1 U1))
- from RightAssociative = M1 (R1 (L1 (M1 U1)))
- from NotAssociative = M1 (R1 (R1 (M1 U1)))
-
- to (M1 (L1 (M1 U1))) = LeftAssociative
- to (M1 (R1 (L1 (M1 U1)))) = RightAssociative
- to (M1 (R1 (R1 (M1 U1)))) = NotAssociative
+ from x = M1 (case x of
+ LeftAssociative -> L1 (M1 U1)
+ RightAssociative -> R1 (L1 (M1 U1))
+ NotAssociative -> R1 (R1 (M1 U1)))
+
+ to (M1 x) = case x of
+ L1 (M1 U1) -> LeftAssociative
+ R1 (L1 (M1 U1)) -> RightAssociative
+ R1 (R1 (M1 U1)) -> NotAssociative
data D1Associativity
data C1_0Associativity
@@ -916,11 +924,13 @@
instance Generic Fixity where
type Rep Fixity = Rep0Fixity
- from Prefix = M1 (L1 (M1 U1))
- from (Infix a i) = M1 (R1 (M1 (M1 (K1 a) :*: M1 (K1 i))))
-
- to (M1 (L1 (M1 U1))) = Prefix
- to (M1 (R1 (M1 (M1 (K1 a) :*: M1 (K1 i))))) = Infix a i
+ from x = M1 (case x of
+ Prefix -> L1 (M1 U1)
+ Infix a i -> R1 (M1 (M1 (K1 a) :*: M1 (K1 i))))
+
+ to (M1 x) = case x of
+ L1 (M1 U1) -> Prefix
+ R1 (M1 (M1 (K1 a) :*: M1 (K1 i))) -> Infix a i
data D1Fixity
data C1_0Fixity
@@ -1177,11 +1187,13 @@
instance Generic ((f :+: g) p) where
type Rep ((f :+: g) p) = Rep0ConSum f g p
- from (L1 l) = M1 (L1 (M1 (M1 (K1 l))))
- from (R1 r) = M1 (R1 (M1 (M1 (K1 r))))
-
- to (M1 (L1 (M1 (M1 (K1 l))))) = L1 l
- to (M1 (R1 (M1 (M1 (K1 r))))) = R1 r
+ from x = M1 (case x of
+ L1 l -> L1 (M1 (M1 (K1 l)))
+ R1 r -> R1 (M1 (M1 (K1 r))))
+
+ to (M1 x) = case x of
+ L1 (M1 (M1 (K1 l))) -> L1 l
+ R1 (M1 (M1 (K1 r))) -> R1 r
-----
@@ -1215,11 +1227,13 @@
instance Generic1 [] where
type Rep1 [] = Rep1List
- from1 [] = M1 (L1 (M1 U1))
- from1 (h:t) = M1 (R1 (M1 (M1 (Par1 h) :*: M1 (Rec1 t))))
-
- to1 (M1 (L1 (M1 U1))) = []
- to1 (M1 (R1 (M1 (M1 (Par1 h) :*: M1 (Rec1 t))))) = h : t
+ from1 x = M1 (case x of
+ [] -> L1 (M1 U1)
+ h:t -> R1 (M1 (M1 (Par1 h) :*: M1 (Rec1 t))))
+
+ to1 (M1 x) = case x of
+ L1 (M1 U1) -> []
+ R1 (M1 (M1 (Par1 h) :*: M1 (Rec1 t))) -> h : t
data D1List
data C1_0List
@@ -1244,11 +1258,13 @@
instance Generic1 (Either a) where
type Rep1 (Either a) = Rep1Either a
- from1 (Left l) = M1 (L1 (M1 (M1 (K1 l))))
- from1 (Right r) = M1 (R1 (M1 (M1 (Par1 r))))
-
- to1 (M1 (L1 (M1 (M1 (K1 l))))) = Left l
- to1 (M1 (R1 (M1 (M1 (Par1 r))))) = Right r
+ from1 x = M1 (case x of
+ Left l -> L1 (M1 (M1 (K1 l)))
+ Right r -> R1 (M1 (M1 (Par1 r))))
+
+ to1 (M1 x) = case x of
+ L1 (M1 (M1 (K1 l))) -> Left l
+ R1 (M1 (M1 (Par1 r))) -> Right r
data D1Either
data C1_0Either
@@ -1272,11 +1288,13 @@
instance Generic1 Maybe where
type Rep1 Maybe = Rep1Maybe
- from1 Nothing = M1 (L1 (M1 U1))
- from1 (Just j) = M1 (R1 (M1 (M1 (Par1 j))))
-
- to1 (M1 (L1 (M1 U1))) = Nothing
- to1 (M1 (R1 (M1 (M1 (Par1 j))))) = Just j
+ from1 x = M1 (case x of
+ Nothing -> L1 (M1 U1)
+ Just j -> R1 (M1 (M1 (Par1 j))))
+
+ to1 (M1 x) = case x of
+ L1 (M1 U1) -> Nothing
+ R1 (M1 (M1 (Par1 j))) -> Just j
data D1Maybe
data C1_0Maybe
@@ -1461,11 +1479,13 @@
instance Generic Bool where
type Rep Bool = Rep0Bool
- from False = M1 (L1 (M1 U1))
- from True = M1 (R1 (M1 U1))
-
- to (M1 (L1 (M1 U1))) = False
- to (M1 (R1 (M1 U1))) = True
+ from x = M1 (case x of
+ False -> L1 (M1 U1)
+ True -> R1 (M1 U1))
+
+ to (M1 x) = case x of
+ L1 (M1 U1) -> False
+ R1 (M1 U1) -> True
data D1Bool
data C1_0Bool
@@ -1527,11 +1547,13 @@
instance Generic (Either a b) where
type Rep (Either a b) = Rep0Either a b
- from (Left l) = M1 (L1 (M1 (M1 (K1 l))))
- from (Right r) = M1 (R1 (M1 (M1 (K1 r))))
-
- to (M1 (L1 (M1 (M1 (K1 l))))) = Left l
- to (M1 (R1 (M1 (M1 (K1 r))))) = Right r
+ from x = M1 (case x of
+ Left l -> L1 (M1 (M1 (K1 l)))
+ Right r -> R1 (M1 (M1 (K1 r))))
+
+ to (M1 x) = case x of
+ L1 (M1 (M1 (K1 l))) -> Left l
+ R1 (M1 (M1 (K1 r))) -> Right r
-----
@@ -1580,11 +1602,13 @@
instance Generic [a] where
type Rep [a] = Rep0List a
- from [] = M1 (L1 (M1 U1))
- from (h:t) = M1 (R1 (M1 (M1 (K1 h) :*: M1 (K1 t))))
-
- to (M1 (L1 (M1 U1))) = []
- to (M1 (R1 (M1 (M1 (K1 h) :*: M1 (K1 t))))) = h : t
+ from x = M1 (case x of
+ [] -> L1 (M1 U1)
+ h:t -> R1 (M1 (M1 (K1 h) :*: M1 (K1 t))))
+
+ to (M1 x) = case x of
+ L1 (M1 U1) -> []
+ R1 (M1 (M1 (K1 h) :*: M1 (K1 t))) -> h : t
-----
@@ -1594,11 +1618,13 @@
instance Generic (Maybe a) where
type Rep (Maybe a) = Rep0Maybe a
- from Nothing = M1 (L1 (M1 U1))
- from (Just j) = M1 (R1 (M1 (M1 (K1 j))))
-
- to (M1 (L1 (M1 U1))) = Nothing
- to (M1 (R1 (M1 (M1 (K1 j))))) = Just j
+ from x = M1 (case x of
+ Nothing -> L1 (M1 U1)
+ Just j -> R1 (M1 (M1 (K1 j))))
+
+ to (M1 x) = case x of
+ L1 (M1 U1) -> Nothing
+ R1 (M1 (M1 (K1 j))) -> Just j
-----
@@ -1608,13 +1634,15 @@
instance Generic Ordering where
type Rep Ordering = Rep0Ordering
- from LT = M1 (L1 (M1 U1))
- from EQ = M1 (R1 (L1 (M1 U1)))
- from GT = M1 (R1 (R1 (M1 U1)))
-
- to (M1 (L1 (M1 U1))) = LT
- to (M1 (R1 (L1 (M1 U1)))) = EQ
- to (M1 (R1 (R1 (M1 U1)))) = GT
+ from x = M1 (case x of
+ LT -> L1 (M1 U1)
+ EQ -> R1 (L1 (M1 U1))
+ GT -> R1 (R1 (M1 U1)))
+
+ to (M1 x) = case x of
+ L1 (M1 U1) -> LT
+ R1 (L1 (M1 U1)) -> EQ
+ R1 (R1 (M1 U1)) -> GT
data D1Ordering
data C1_0Ordering
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/generic-deriving-1.10.4.1/src/Generics/Deriving/Monoid.hs
new/generic-deriving-1.10.5/src/Generics/Deriving/Monoid.hs
--- old/generic-deriving-1.10.4.1/src/Generics/Deriving/Monoid.hs
2016-04-13 15:20:14.000000000 +0200
+++ new/generic-deriving-1.10.5/src/Generics/Deriving/Monoid.hs 2016-06-19
01:54:56.000000000 +0200
@@ -34,6 +34,9 @@
gmemptydefault,
gmappenddefault,
+ -- * Internal auxiliary class for GMonoid
+ GMonoid'(..),
+
-- ** Monoid
{- | These functions can be used in a 'Monoid' instance. For example:
@@ -53,6 +56,9 @@
memptydefault,
mappenddefault,
+ -- * Internal auxiliary class for Monoid
+ Monoid'(..),
+
-- * The Monoid module
-- | This is exported for convenient access to the various wrapper types.
module Data.Monoid,
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/generic-deriving-1.10.4.1/src/Generics/Deriving/Semigroup.hs
new/generic-deriving-1.10.5/src/Generics/Deriving/Semigroup.hs
--- old/generic-deriving-1.10.4.1/src/Generics/Deriving/Semigroup.hs
2016-04-13 15:20:14.000000000 +0200
+++ new/generic-deriving-1.10.5/src/Generics/Deriving/Semigroup.hs
2016-06-19 01:54:56.000000000 +0200
@@ -19,6 +19,9 @@
-- * Default definition
, gsappenddefault
+ -- * Internal semigroup class
+ , GSemigroup'(..)
+
) where
import Control.Applicative
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/generic-deriving-1.10.4.1/src/Generics/Deriving/Show.hs
new/generic-deriving-1.10.5/src/Generics/Deriving/Show.hs
--- old/generic-deriving-1.10.4.1/src/Generics/Deriving/Show.hs 2016-04-13
15:20:14.000000000 +0200
+++ new/generic-deriving-1.10.5/src/Generics/Deriving/Show.hs 2016-06-19
01:54:56.000000000 +0200
@@ -22,6 +22,9 @@
-- * Default definition
, gshowsPrecdefault
+ -- * Internal show class
+ , GShow'(..)
+
) where
import Control.Applicative (Const, ZipList)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/generic-deriving-1.10.4.1/src/Generics/Deriving/TH.hs
new/generic-deriving-1.10.5/src/Generics/Deriving/TH.hs
--- old/generic-deriving-1.10.4.1/src/Generics/Deriving/TH.hs 2016-04-13
15:20:14.000000000 +0200
+++ new/generic-deriving-1.10.5/src/Generics/Deriving/TH.hs 2016-06-19
01:54:56.000000000 +0200
@@ -449,7 +449,7 @@
makeTo1 :: Name -> Q Exp
makeTo1 = makeFunCommon mkTo Generic1
-makeFunCommon :: (GenericClass -> Int -> Int -> Name -> [Con] -> [Q Match])
+makeFunCommon :: (GenericClass -> Int -> Int -> Name -> [Con] -> Q Match)
-> GenericClass -> Name -> Q Exp
makeFunCommon maker gClass n = do
i <- reifyDataInfo n
@@ -597,64 +597,74 @@
Nothing -> conT rec0TypeName `appT` return ty
mkCaseExp :: GenericClass -> Name -> [Con]
- -> (GenericClass -> Int -> Int -> Name -> [Con] -> [Q Match])
+ -> (GenericClass -> Int -> Int -> Name -> [Con] -> Q Match)
-> Q Exp
mkCaseExp gClass dt cs matchmaker = do
val <- newName "val"
- lam1E (varP val) $ caseE (varE val) $ matchmaker gClass 1 0 dt cs
+ lam1E (varP val) $ caseE (varE val) [matchmaker gClass 1 0 dt cs]
-mkFrom :: GenericClass -> Int -> Int -> Name -> [Con] -> [Q Match]
-mkFrom _ _ _ dt [] = [errorFrom dt]
-mkFrom gClass m i _ cs = zipWith (fromCon gClass wrapE (length cs)) [0..] cs
+mkFrom :: GenericClass -> Int -> Int -> Name -> [Con] -> Q Match
+mkFrom gClass m i dt cs = do
+ y <- newName "y"
+ match (varP y)
+ (normalB $ conE m1DataName `appE` caseE (varE y) cases)
+ []
where
+ cases = case cs of
+ [] -> [errorFrom dt]
+ _ -> zipWith (fromCon gClass wrapE (length cs)) [0..] cs
wrapE e = lrE m i e
errorFrom :: Name -> Q Match
errorFrom dt =
match
wildP
- (normalB $ appE (conE m1DataName) $ varE errorValName `appE` stringE
+ (normalB $ varE errorValName `appE` stringE
("No generic representation for empty datatype " ++ nameBase dt))
[]
errorTo :: Name -> Q Match
errorTo dt =
match
- (conP m1DataName [wildP])
+ wildP
(normalB $ varE errorValName `appE` stringE
("No values for empty datatype " ++ nameBase dt))
[]
-mkTo :: GenericClass -> Int -> Int -> Name -> [Con] -> [Q Match]
-mkTo _ _ _ dt [] = [errorTo dt]
-mkTo gClass m i _ cs = zipWith (toCon gClass wrapP (length cs)) [0..] cs
+mkTo :: GenericClass -> Int -> Int -> Name -> [Con] -> Q Match
+mkTo gClass m i dt cs = do
+ y <- newName "y"
+ match (conP m1DataName [varP y])
+ (normalB $ caseE (varE y) cases)
+ []
where
+ cases = case cs of
+ [] -> [errorTo dt]
+ _ -> zipWith (toCon gClass wrapP (length cs)) [0..] cs
wrapP p = lrP m i p
fromCon :: GenericClass -> (Q Exp -> Q Exp) -> Int -> Int -> Con -> Q Match
fromCon _ wrap m i (NormalC cn []) =
match
(conP cn [])
- (normalB $ appE (conE m1DataName)
- $ wrap $ lrE m i $ conE m1DataName `appE` (conE u1DataName)) []
+ (normalB $ wrap $ lrE m i $ conE m1DataName `appE` (conE u1DataName)) []
fromCon gClass wrap m i (NormalC cn _) = do
(ts, gk) <- fmap shrink $ reifyConTys gClass cn
fNames <- newNameList "f" $ length ts
match
(conP cn (map varP fNames))
- (normalB $ appE (conE m1DataName) $ wrap $ lrE m i $ conE m1DataName `appE`
+ (normalB $ wrap $ lrE m i $ conE m1DataName `appE`
foldr1 prodE (zipWith (fromField gk) fNames ts)) []
fromCon _ wrap m i (RecC cn []) =
match
(conP cn [])
- (normalB $ appE (conE m1DataName)
- $ wrap $ lrE m i $ conE m1DataName `appE` (conE u1DataName)) []
+ (normalB $ wrap $ lrE m i $ conE m1DataName `appE` (conE u1DataName)) []
fromCon gClass wrap m i (RecC cn _) = do
(ts, gk) <- fmap shrink $ reifyConTys gClass cn
fNames <- newNameList "f" $ length ts
match
(conP cn (map varP fNames))
- (normalB $ appE (conE m1DataName) $ wrap $ lrE m i $ conE m1DataName `appE`
+ (normalB $ wrap $ lrE m i $ conE m1DataName `appE`
foldr1 prodE (zipWith (fromField gk) fNames ts)) []
fromCon gClass wrap m i (InfixC t1 cn t2) =
fromCon gClass wrap m i (NormalC cn [t1,t2])
@@ -705,27 +715,27 @@
toCon :: GenericClass -> (Q Pat -> Q Pat) -> Int -> Int -> Con -> Q Match
toCon _ wrap m i (NormalC cn []) =
match
- (wrap $ conP m1DataName [lrP m i $ conP m1DataName [conP u1DataName []]])
+ (wrap $ lrP m i $ conP m1DataName [conP u1DataName []])
(normalB $ conE cn) []
toCon gClass wrap m i (NormalC cn _) = do
(ts, gk) <- fmap shrink $ reifyConTys gClass cn
fNames <- newNameList "f" $ length ts
match
- (wrap $ conP m1DataName [lrP m i $ conP m1DataName
- [foldr1 prod (zipWith (toField gk) fNames ts)]])
+ (wrap $ lrP m i $ conP m1DataName
+ [foldr1 prod (zipWith (toField gk) fNames ts)])
(normalB $ foldl appE (conE cn) (zipWith (\nr -> expandSyn >=> toConUnwC
gk nr)
fNames ts)) []
where prod x y = conP productDataName [x,y]
toCon _ wrap m i (RecC cn []) =
match
- (wrap $ conP m1DataName [lrP m i $ conP m1DataName [conP u1DataName []]])
+ (wrap $ lrP m i $ conP m1DataName [conP u1DataName []])
(normalB $ conE cn) []
toCon gClass wrap m i (RecC cn _) = do
(ts, gk) <- fmap shrink $ reifyConTys gClass cn
fNames <- newNameList "f" $ length ts
match
- (wrap $ conP m1DataName [lrP m i $ conP m1DataName
- [foldr1 prod (zipWith (toField gk) fNames ts)]])
+ (wrap $ lrP m i $ conP m1DataName
+ [foldr1 prod (zipWith (toField gk) fNames ts)])
(normalB $ foldl appE (conE cn) (zipWith (\nr -> expandSyn >=> toConUnwC
gk nr)
fNames ts)) []
where prod x y = conP productDataName [x,y]
@@ -865,13 +875,13 @@
-- types without kind annotations.
instTys :: [Type]
instTys = map (substNamesWithKinds (zip kindVarNames givenKinds'))
- -- ^ Note that due to a GHC 7.8-specific bug
- -- (see Note [Polykinded data families in Template
Haskell]),
- -- there may be more kind variable names than there are
kinds
- -- to substitute. But this is OK! If a kind is
eta-reduced, it
- -- means that is was not instantiated to something more
specific,
- -- so we need not substitute it. Using stealKindForType
will
- -- grab the correct kind.
+ -- Note that due to a GHC 7.8-specific bug
+ -- (see Note [Polykinded data families in Template Haskell]),
+ -- there may be more kind variable names than there are kinds
+ -- to substitute. But this is OK! If a kind is eta-reduced,
it
+ -- means that is was not instantiated to something more
specific,
+ -- so we need not substitute it. Using stealKindForType will
+ -- grab the correct kind.
$ zipWith stealKindForType tvbs (givenTys ++ xTys)
#endif
buildTypeInstanceFromTys gClass parentName instTys True
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/generic-deriving-1.10.4.1/src/Generics/Deriving/Traversable.hs
new/generic-deriving-1.10.5/src/Generics/Deriving/Traversable.hs
--- old/generic-deriving-1.10.4.1/src/Generics/Deriving/Traversable.hs
2016-04-13 15:20:14.000000000 +0200
+++ new/generic-deriving-1.10.5/src/Generics/Deriving/Traversable.hs
2016-06-19 01:54:56.000000000 +0200
@@ -14,12 +14,15 @@
#endif
module Generics.Deriving.Traversable (
- -- * GTraversable class
+ -- * Generic Traversable class
GTraversable(..)
-- * Default method
, gtraversedefault
+ -- * Internal Traversable class
+ , GTraversable'(..)
+
) where
import Control.Applicative (Const, WrappedMonad(..), ZipList)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/generic-deriving-1.10.4.1/src/Generics/Deriving/Uniplate.hs
new/generic-deriving-1.10.5/src/Generics/Deriving/Uniplate.hs
--- old/generic-deriving-1.10.4.1/src/Generics/Deriving/Uniplate.hs
2016-04-13 15:20:14.000000000 +0200
+++ new/generic-deriving-1.10.5/src/Generics/Deriving/Uniplate.hs
2016-06-19 01:54:56.000000000 +0200
@@ -32,6 +32,7 @@
-}
module Generics.Deriving.Uniplate (
+ -- * Generic Uniplate class
Uniplate(..)
-- * Derived functions
@@ -51,6 +52,8 @@
, transformdefault
, transformMdefault
+ -- * Internal Uniplate class
+ , Uniplate'(..)
) where
