Hello community,
here is the log from the commit of package ghc-generic-deriving for
openSUSE:Factory checked in at 2018-05-30 12:07:59
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-generic-deriving (Old)
and /work/SRC/openSUSE:Factory/.ghc-generic-deriving.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-generic-deriving"
Wed May 30 12:07:59 2018 rev:8 rq:607802 version:1.12.1
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-generic-deriving/ghc-generic-deriving.changes
2017-09-15 21:40:59.772805209 +0200
+++
/work/SRC/openSUSE:Factory/.ghc-generic-deriving.new/ghc-generic-deriving.changes
2018-05-30 12:25:45.745425898 +0200
@@ -1,0 +2,21 @@
+Mon May 14 17:02:11 UTC 2018 - [email protected]
+
+- Update generic-deriving to version 1.12.1 revision 1.
+ * Adapt to the `EmptyDataDeriving` proposal (introduced in GHC 8.4):
+ * `Generics.Deriving.TH` now derives `to(1)` and `from(1)` implementations
+ for empty data types that are strict in the argument.
+ * Introduce an `EmptyCaseOptions` field to `Options` in
+ `Generics.Deriving.TH`, which controls whether generated
`from(1)`/`to(1)`
+ implementations for empty data types should use the `EmptyCase` extension
+ or not (as is the case in GHC 8.4).
+ * Add `mkFrom0Options`, `mkFrom1Options`, `mkTo0Options`, and
`mkTo1Options`
+ functions to `Generics.Deriving.TH`, which take `EmptyCaseOptions` as
+ arguments.
+ * The backported instances for `V1` are now maximally lazy, as per
+ `EmptyDataDeriving`. (Previously, some instances would unnecessarily
force
+ their argument, such as the `Eq` and `Ord` instances.)
+ * Add instances for `V1` in `Generics.Deriving.Copoint`, `.Eq`,
`.Foldable`,
+ `.Functor`, `.Show`, and `.Traversable`.
+ * Remove the bitrotting `simplInstance` function from `Generics.Deriving.TH`.
+
+-------------------------------------------------------------------
Old:
----
generic-deriving-1.11.2.tar.gz
New:
----
generic-deriving-1.12.1.tar.gz
generic-deriving.cabal
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-generic-deriving.spec ++++++
--- /var/tmp/diff_new_pack.3vzE31/_old 2018-05-30 12:25:46.489401188 +0200
+++ /var/tmp/diff_new_pack.3vzE31/_new 2018-05-30 12:25:46.493401055 +0200
@@ -1,7 +1,7 @@
#
# spec file for package ghc-generic-deriving
#
-# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2018 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -19,13 +19,14 @@
%global pkg_name generic-deriving
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 1.11.2
+Version: 1.12.1
Release: 0
Summary: Generic programming library for generalised deriving
License: BSD-3-Clause
Group: Development/Libraries/Haskell
URL: https://hackage.haskell.org/package/%{pkg_name}
Source0:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
+Source1:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal
BuildRequires: ghc-Cabal-devel
BuildRequires: ghc-containers-devel
BuildRequires: ghc-rpm-macros
@@ -59,6 +60,7 @@
%prep
%setup -q -n %{pkg_name}-%{version}
+cp -p %{SOURCE1} %{pkg_name}.cabal
%build
%ghc_lib_build
@@ -76,7 +78,7 @@
%ghc_pkg_recache
%files -f %{name}.files
-%doc LICENSE
+%license LICENSE
%files devel -f %{name}-devel.files
%doc CHANGELOG.md README.md
++++++ generic-deriving-1.11.2.tar.gz -> generic-deriving-1.12.1.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/generic-deriving-1.11.2/CHANGELOG.md
new/generic-deriving-1.12.1/CHANGELOG.md
--- old/generic-deriving-1.11.2/CHANGELOG.md 2017-04-10 15:13:29.000000000
+0200
+++ new/generic-deriving-1.12.1/CHANGELOG.md 2018-01-11 22:49:37.000000000
+0100
@@ -1,3 +1,24 @@
+# 1.12.1 [2018.01.11]
+* Remove a test that won't work on GHC 8.4.
+
+# 1.12 [2017.12.07]
+* Adapt to the `EmptyDataDeriving` proposal (introduced in GHC 8.4):
+ * `Generics.Deriving.TH` now derives `to(1)` and `from(1)` implementations
+ for empty data types that are strict in the argument.
+ * Introduce an `EmptyCaseOptions` field to `Options` in
+ `Generics.Deriving.TH`, which controls whether generated `from(1)`/`to(1)`
+ implementations for empty data types should use the `EmptyCase` extension
+ or not (as is the case in GHC 8.4).
+ * Add `mkFrom0Options`, `mkFrom1Options`, `mkTo0Options`, and `mkTo1Options`
+ functions to `Generics.Deriving.TH`, which take `EmptyCaseOptions` as
+ arguments.
+ * The backported instances for `V1` are now maximally lazy, as per
+ `EmptyDataDeriving`. (Previously, some instances would unnecessarily force
+ their argument, such as the `Eq` and `Ord` instances.)
+ * Add instances for `V1` in `Generics.Deriving.Copoint`, `.Eq`, `.Foldable`,
+ `.Functor`, `.Show`, and `.Traversable`.
+* Remove the bitrotting `simplInstance` function from `Generics.Deriving.TH`.
+
# 1.11.2 [2017.04.10]
* Add `GEq`, `GShow`, `GEnum`, and `GIx` instances for the new data types
in `Foreign.C.Types` (`CBool`) and `System.Posix.Types` (`CBlkSize`,
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/generic-deriving-1.11.2/generic-deriving.cabal
new/generic-deriving-1.12.1/generic-deriving.cabal
--- old/generic-deriving-1.11.2/generic-deriving.cabal 2017-04-10
15:13:29.000000000 +0200
+++ new/generic-deriving-1.12.1/generic-deriving.cabal 2018-01-11
22:49:37.000000000 +0100
@@ -1,5 +1,5 @@
name: generic-deriving
-version: 1.11.2
+version: 1.12.1
synopsis: Generic programming library for generalised deriving.
description:
@@ -32,7 +32,8 @@
, GHC == 7.8.4
, GHC == 7.10.3
, GHC == 8.0.2
- , GHC == 8.2.1
+ , GHC == 8.2.2
+ , GHC == 8.4.1
extra-source-files: CHANGELOG.md
, README.md
@@ -84,12 +85,14 @@
test-suite spec
type: exitcode-stdio-1.0
main-is: Spec.hs
- other-modules: ExampleSpec
+ other-modules: EmptyCaseSpec
+ ExampleSpec
TypeInTypeSpec
build-depends: base >= 4.3 && < 5
, generic-deriving
, hspec >= 2 && < 3
, template-haskell >= 2.4 && < 2.13
+ build-tool-depends: hspec-discover:hspec-discover
hs-source-dirs: tests
default-language: Haskell2010
ghc-options: -Wall -threaded -rtsopts
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/generic-deriving-1.11.2/src/Generics/Deriving/Base/Internal.hs
new/generic-deriving-1.12.1/src/Generics/Deriving/Base/Internal.hs
--- old/generic-deriving-1.11.2/src/Generics/Deriving/Base/Internal.hs
2017-04-10 15:13:29.000000000 +0200
+++ new/generic-deriving-1.12.1/src/Generics/Deriving/Base/Internal.hs
2018-01-11 22:49:37.000000000 +0100
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
@@ -627,7 +628,7 @@
import Control.Applicative ( Alternative(..) )
import Control.Monad ( MonadPlus(..) )
import Control.Monad.Fix ( MonadFix(..), fix )
-import Data.Data ( Data )
+import Data.Data ( Data(..), DataType, constrIndex, mkDataType )
import Data.Ix ( Ix )
import Text.ParserCombinators.ReadPrec (pfail)
import Text.Read ( Read(..), parens, readListDefault, readListPrecDefault )
@@ -653,13 +654,39 @@
--------------------------------------------------------------------------------
-- | Void: used for datatypes without constructors
-data V1 p
- deriving (Functor, Foldable, Traversable, Typeable)
+data V1 p deriving Typeable
+
+-- Implement these instances by hand to get the desired, maximally lazy
behavior.
+instance Functor V1 where
+ fmap _ !_ = error "Void fmap"
+
+instance Foldable V1 where
+ foldr _ z _ = z
+ foldMap _ _ = mempty
+
+instance Traversable V1 where
+ traverse _ x = pure (case x of !_ -> error "Void traverse")
+
+instance Eq (V1 p) where
+ _ == _ = True
+
+instance Data p => Data (V1 p) where
+ gfoldl _ _ !_ = error "Void gfoldl"
+ gunfold _ _ c = case constrIndex c of
+ _ -> error "Void gunfold"
+ toConstr !_ = error "Void toConstr"
+ dataTypeOf _ = v1DataType
+ dataCast1 f = gcast1 f
+
+v1DataType :: DataType
+v1DataType = mkDataType "V1" []
+
+instance Ord (V1 p) where
+ compare _ _ = EQ
+
+instance Show (V1 p) where
+ showsPrec _ !_ = error "Void showsPrec"
-deriving instance Eq (V1 p)
-deriving instance Data p => Data (V1 p)
-deriving instance Ord (V1 p)
-deriving instance Show (V1 p)
-- Implement Read instance manually to get around an old GHC bug
-- (Trac #7931)
instance Read (V1 p) where
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/generic-deriving-1.11.2/src/Generics/Deriving/Copoint.hs
new/generic-deriving-1.12.1/src/Generics/Deriving/Copoint.hs
--- old/generic-deriving-1.11.2/src/Generics/Deriving/Copoint.hs
2017-04-10 15:13:29.000000000 +0200
+++ new/generic-deriving-1.12.1/src/Generics/Deriving/Copoint.hs
2018-01-11 22:49:37.000000000 +0100
@@ -50,6 +50,9 @@
class GCopoint' t where
gcopoint' :: t a -> Maybe a
+instance GCopoint' V1 where
+ gcopoint' _ = Nothing
+
instance GCopoint' U1 where
gcopoint' U1 = Nothing
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/generic-deriving-1.11.2/src/Generics/Deriving/Eq.hs
new/generic-deriving-1.12.1/src/Generics/Deriving/Eq.hs
--- old/generic-deriving-1.11.2/src/Generics/Deriving/Eq.hs 2017-04-10
15:13:29.000000000 +0200
+++ new/generic-deriving-1.12.1/src/Generics/Deriving/Eq.hs 2018-01-11
22:49:37.000000000 +0100
@@ -82,6 +82,9 @@
class GEq' f where
geq' :: f a -> f a -> Bool
+instance GEq' V1 where
+ geq' _ _ = True
+
instance GEq' U1 where
geq' _ _ = True
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/generic-deriving-1.11.2/src/Generics/Deriving/Foldable.hs
new/generic-deriving-1.12.1/src/Generics/Deriving/Foldable.hs
--- old/generic-deriving-1.11.2/src/Generics/Deriving/Foldable.hs
2017-04-10 15:13:29.000000000 +0200
+++ new/generic-deriving-1.12.1/src/Generics/Deriving/Foldable.hs
2018-01-11 22:49:37.000000000 +0100
@@ -80,6 +80,9 @@
class GFoldable' t where
gfoldMap' :: Monoid m => (a -> m) -> t a -> m
+instance GFoldable' V1 where
+ gfoldMap' _ _ = mempty
+
instance GFoldable' U1 where
gfoldMap' _ U1 = mempty
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/generic-deriving-1.11.2/src/Generics/Deriving/Functor.hs
new/generic-deriving-1.12.1/src/Generics/Deriving/Functor.hs
--- old/generic-deriving-1.11.2/src/Generics/Deriving/Functor.hs
2017-04-10 15:13:29.000000000 +0200
+++ new/generic-deriving-1.12.1/src/Generics/Deriving/Functor.hs
2018-01-11 22:49:37.000000000 +0100
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
@@ -13,6 +14,10 @@
{-# LANGUAGE PolyKinds #-}
#endif
+#if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE EmptyCase #-}
+#endif
+
module Generics.Deriving.Functor (
-- * Generic Functor class
GFunctor(..)
@@ -60,6 +65,14 @@
class GFunctor' f where
gmap' :: (a -> b) -> f a -> f b
+instance GFunctor' V1 where
+ gmap' _ x = case x of
+#if __GLASGOW_HASKELL__ >= 708
+ {}
+#else
+ !_ -> error "Void gmap"
+#endif
+
instance GFunctor' U1 where
gmap' _ U1 = U1
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/generic-deriving-1.11.2/src/Generics/Deriving/Instances.hs
new/generic-deriving-1.12.1/src/Generics/Deriving/Instances.hs
--- old/generic-deriving-1.11.2/src/Generics/Deriving/Instances.hs
2017-04-10 15:13:29.000000000 +0200
+++ new/generic-deriving-1.12.1/src/Generics/Deriving/Instances.hs
2018-01-11 22:49:37.000000000 +0100
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
@@ -422,13 +423,13 @@
instance Generic (V1 p) where
type Rep (V1 p) = Rep0V1 p
- from _ = M1 (error "No generic representation for empty datatype V1")
- to (M1 _) = error "No values for empty datatype V1"
+ from x = M1 (case x of !_ -> error "No generic representation for empty
datatype V1")
+ to (M1 !_) = error "No values for empty datatype V1"
instance Generic1 V1 where
type Rep1 V1 = Rep1V1
- from1 _ = M1 (error "No generic representation for empty datatype V1")
- to1 (M1 _) = error "No values for empty datatype V1"
+ from1 x = M1 (case x of !_ -> error "No generic representation for empty
datatype V1")
+ to1 (M1 !_) = error "No values for empty datatype V1"
data D1V1
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/generic-deriving-1.11.2/src/Generics/Deriving/Show.hs
new/generic-deriving-1.12.1/src/Generics/Deriving/Show.hs
--- old/generic-deriving-1.11.2/src/Generics/Deriving/Show.hs 2017-04-10
15:13:29.000000000 +0200
+++ new/generic-deriving-1.12.1/src/Generics/Deriving/Show.hs 2018-01-11
22:49:37.000000000 +0100
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
@@ -11,6 +12,10 @@
{-# LANGUAGE Trustworthy #-}
#endif
+#if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE EmptyCase #-}
+#endif
+
#if __GLASGOW_HASKELL__ < 709
{-# LANGUAGE OverlappingInstances #-}
#endif
@@ -89,6 +94,14 @@
isNullary :: f a -> Bool
isNullary = error "generic show (isNullary): unnecessary case"
+instance GShow' V1 where
+ gshowsPrec' _ _ x = case x of
+#if __GLASGOW_HASKELL__ >= 708
+ {}
+#else
+ !_ -> error "Void gshowsPrec"
+#endif
+
instance GShow' U1 where
gshowsPrec' _ _ U1 = id
isNullary _ = True
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/generic-deriving-1.11.2/src/Generics/Deriving/TH/Internal.hs
new/generic-deriving-1.12.1/src/Generics/Deriving/TH/Internal.hs
--- old/generic-deriving-1.11.2/src/Generics/Deriving/TH/Internal.hs
2017-04-10 15:13:29.000000000 +0200
+++ new/generic-deriving-1.12.1/src/Generics/Deriving/TH/Internal.hs
2018-01-11 22:49:37.000000000 +0100
@@ -769,6 +769,9 @@
mkGHCPrimName_tc :: String -> String -> Name
mkGHCPrimName_tc = mkNameG_tc "ghc-prim"
+mkGHCPrimName_v :: String -> String -> Name
+mkGHCPrimName_v = mkNameG_v "ghc-prim"
+
comp1DataName :: Name
comp1DataName = mkGD4'4_d "Comp1"
@@ -931,6 +934,9 @@
selNameValName :: Name
selNameValName = mkGD4'4_v "selName"
+seqValName :: Name
+seqValName = mkGHCPrimName_v "GHC.Prim" "seq"
+
toValName :: Name
toValName = mkGD4'4_v "to"
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/generic-deriving-1.11.2/src/Generics/Deriving/TH.hs
new/generic-deriving-1.12.1/src/Generics/Deriving/TH.hs
--- old/generic-deriving-1.11.2/src/Generics/Deriving/TH.hs 2017-04-10
15:13:29.000000000 +0200
+++ new/generic-deriving-1.12.1/src/Generics/Deriving/TH.hs 2018-01-11
22:49:37.000000000 +0100
@@ -57,7 +57,6 @@
, deriveRepresentable1
, deriveRep0
, deriveRep1
- , simplInstance
-- * @make@- functions
-- $make
@@ -83,6 +82,8 @@
, defaultRepOptions
, KindSigOptions
, defaultKindSigOptions
+ , EmptyCaseOptions
+ , defaultEmptyCaseOptions
-- ** Functions with optional arguments
, deriveAll0Options
@@ -92,6 +93,11 @@
, deriveRepresentable1Options
, deriveRep0Options
, deriveRep1Options
+
+ , makeFrom0Options
+ , makeTo0Options
+ , makeFrom1Options
+ , makeTo1Options
) where
import Control.Monad ((>=>), unless, when)
@@ -133,32 +139,56 @@
newtype Compose (f :: k2 -> *) (g :: k1 -> k2) (a :: k1) = Compose (f (g a))
$('deriveAll1Options' False ''Compose)
@
--}
--- | Given the names of a generic class, a type to instantiate, a function in
--- the class and the default implementation, generates the code for a basic
--- generic instance.
-simplInstance :: Name -> Name -> Name -> Name -> Q [Dec]
-simplInstance cl ty fn df = do
- x <- newName "x"
- let typ = ForallT [PlainTV x] []
- ((foldl (\a -> AppT a . VarT . tyVarBndrName) (ConT (genRepName
Generic DataPlain ty)) []) `AppT` (VarT x))
- fmap (: []) $ instanceD (cxt []) (conT cl `appT` conT ty)
- [funD fn [clause [] (normalB (varE df `appE`
- (sigE (varE undefinedValName) (return typ)))) []]]
+* 'EmptyCaseOptions': By default, all derived instances for empty data types
+ (i.e., data types with no constructors) use 'error' in @from(1)@/@to(1)@.
+ For instance, @data Empty@ would have this derived 'Generic' instance:
+
+ @
+ instance Generic Empty where
+ type Rep Empty = D1 ('MetaData ...) V1
+ from _ = M1 (error "No generic representation for empty datatype Empty")
+ to (M1 _) = error "No generic representation for empty datatype Empty"
+ @
+
+ This matches the behavior of GHC up until 8.4, when derived @Generic(1)@
+ instances began to use the @EmptyCase@ extension. In GHC 8.4, the derived
+ 'Generic' instance for @Empty@ would instead be:
+
+ @
+ instance Generic Empty where
+ type Rep Empty = D1 ('MetaData ...) V1
+ from x = M1 (case x of {})
+ to (M1 x) = case x of {}
+ @
+
+ This is a slightly better encoding since, for example, any divergent
+ computations passed to 'from' will actually diverge (as opposed to before,
+ where the result would always be a call to 'error'). On the other hand, using
+ this encoding in @generic-deriving@ has one large drawback: it requires
+ enabling @EmptyCase@, an extension which was only introduced in GHC 7.8
+ (and only received reliable pattern-match coverage checking in 8.2).
+
+ The 'EmptyCaseOptions' field controls whether code should be emitted that
+ uses @EmptyCase@ (i.e., 'EmptyCaseOptions' set to 'True') or not ('False').
+ The default value is 'False'. Note that even if set to 'True', this option
+ has no effect on GHCs before 7.8, as @EmptyCase@ did not exist then.
+-}
-- | Additional options for configuring derived 'Generic'/'Generic1' instances
-- using Template Haskell.
data Options = Options
- { repOptions :: RepOptions
- , kindSigOptions :: KindSigOptions
+ { repOptions :: RepOptions
+ , kindSigOptions :: KindSigOptions
+ , emptyCaseOptions :: EmptyCaseOptions
} deriving (Eq, Ord, Read, Show)
--- | Sensible default 'Options' ('defaultRepOptions' and
'defaultKindSigOptions').
+-- | Sensible default 'Options'.
defaultOptions :: Options
defaultOptions = Options
- { repOptions = defaultRepOptions
- , kindSigOptions = defaultKindSigOptions
+ { repOptions = defaultRepOptions
+ , kindSigOptions = defaultKindSigOptions
+ , emptyCaseOptions = defaultEmptyCaseOptions
}
-- | Configures whether 'Rep'/'Rep1' type instances should be defined inline
in a
@@ -180,6 +210,15 @@
defaultKindSigOptions :: KindSigOptions
defaultKindSigOptions = True
+-- | 'True' if generated code for empty data types should use the @EmptyCase@
+-- extension, 'False' otherwise. This has no effect on GHCs before 7.8, since
+-- @EmptyCase@ is only available in 7.8 or later.
+type EmptyCaseOptions = Bool
+
+-- | Sensible default 'EmptyCaseOptions'.
+defaultEmptyCaseOptions :: EmptyCaseOptions
+defaultEmptyCaseOptions = False
+
-- | A backwards-compatible synonym for 'deriveAll0'.
deriveAll :: Name -> Q [Dec]
deriveAll = deriveAll0
@@ -316,7 +355,8 @@
#else
[origSigTy] tyInsRHS
#endif
- mkBody maker = [clause [] (normalB $ mkCaseExp gClass name cons maker)
[]]
+ ecOptions = emptyCaseOptions opts
+ mkBody maker = [clause [] (normalB $ mkCaseExp gClass ecOptions name
cons maker) []]
fcs = mkBody mkFrom
tcs = mkBody mkTo
@@ -563,7 +603,11 @@
-- | Generates a lambda expression which behaves like 'from'.
makeFrom0 :: Name -> Q Exp
-makeFrom0 = makeFunCommon mkFrom Generic
+makeFrom0 = makeFrom0Options defaultEmptyCaseOptions
+
+-- | Like 'makeFrom0Options', but takes an 'EmptyCaseOptions' argument.
+makeFrom0Options :: EmptyCaseOptions -> Name -> Q Exp
+makeFrom0Options = makeFunCommon mkFrom Generic
-- | A backwards-compatible synonym for 'makeTo0'.
makeTo :: Name -> Q Exp
@@ -571,24 +615,36 @@
-- | Generates a lambda expression which behaves like 'to'.
makeTo0 :: Name -> Q Exp
-makeTo0 = makeFunCommon mkTo Generic
+makeTo0 = makeTo0Options defaultEmptyCaseOptions
+
+-- | Like 'makeTo0Options', but takes an 'EmptyCaseOptions' argument.
+makeTo0Options :: EmptyCaseOptions -> Name -> Q Exp
+makeTo0Options = makeFunCommon mkTo Generic
-- | Generates a lambda expression which behaves like 'from1'.
makeFrom1 :: Name -> Q Exp
-makeFrom1 = makeFunCommon mkFrom Generic1
+makeFrom1 = makeFrom1Options defaultEmptyCaseOptions
+
+-- | Like 'makeFrom1Options', but takes an 'EmptyCaseOptions' argument.
+makeFrom1Options :: EmptyCaseOptions -> Name -> Q Exp
+makeFrom1Options = makeFunCommon mkFrom Generic1
-- | Generates a lambda expression which behaves like 'to1'.
makeTo1 :: Name -> Q Exp
-makeTo1 = makeFunCommon mkTo Generic1
+makeTo1 = makeTo1Options defaultEmptyCaseOptions
-makeFunCommon :: (GenericClass -> Int -> Int -> Name -> [Con] -> Q Match)
- -> GenericClass -> Name -> Q Exp
-makeFunCommon maker gClass n = do
+-- | Like 'makeTo1Options', but takes an 'EmptyCaseOptions' argument.
+makeTo1Options :: EmptyCaseOptions -> Name -> Q Exp
+makeTo1Options = makeFunCommon mkTo Generic1
+
+makeFunCommon :: (GenericClass -> EmptyCaseOptions -> Int -> Int -> Name ->
[Con] -> Q Match)
+ -> GenericClass -> EmptyCaseOptions -> Name -> Q Exp
+makeFunCommon maker gClass ecOptions n = do
i <- reifyDataInfo n
let (name, _, allTvbs, cons, dv) = either error id i
-- See Note [Forcing buildTypeInstance]
buildTypeInstance gClass False name allTvbs dv
- `seq` mkCaseExp gClass name cons maker
+ `seq` mkCaseExp gClass ecOptions name cons maker
genRepName :: GenericClass -> DataVariety -> Name -> Name
genRepName gClass dv n = mkName
@@ -734,53 +790,73 @@
Just (boxTyName, _, _) -> conT boxTyName
Nothing -> conT rec0TypeName `appT` return ty
-mkCaseExp :: GenericClass -> Name -> [Con]
- -> (GenericClass -> Int -> Int -> Name -> [Con] -> Q Match)
+mkCaseExp :: GenericClass -> EmptyCaseOptions -> Name -> [Con]
+ -> (GenericClass -> EmptyCaseOptions -> Int -> Int -> Name -> [Con]
-> Q Match)
-> Q Exp
-mkCaseExp gClass dt cs matchmaker = do
+mkCaseExp gClass ecOptions 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 ecOptions 1 0 dt cs]
-mkFrom :: GenericClass -> Int -> Int -> Name -> [Con] -> Q Match
-mkFrom gClass m i dt cs = do
+mkFrom :: GenericClass -> EmptyCaseOptions -> Int -> Int -> Name -> [Con] -> Q
Match
+mkFrom gClass ecOptions 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]
+ [] -> errorFrom ecOptions dt
_ -> zipWith (fromCon gClass wrapE (length cs)) [0..] cs
wrapE e = lrE m i e
-errorFrom :: Name -> Q Match
-errorFrom dt =
- match
- wildP
- (normalB $ varE errorValName `appE` stringE
- ("No generic representation for empty datatype " ++ nameBase dt))
- []
-
-errorTo :: Name -> Q Match
-errorTo dt =
- match
- wildP
- (normalB $ varE errorValName `appE` stringE
- ("No values for empty datatype " ++ nameBase dt))
- []
+errorFrom :: EmptyCaseOptions -> Name -> [Q Match]
+errorFrom useEmptyCase dt
+ | useEmptyCase && ghc7'8OrLater
+ = []
+ | otherwise
+ = [do z <- newName "z"
+ match
+ (varP z)
+ (normalB $
+ appE (varE seqValName) (varE z) `appE`
+ appE (varE errorValName)
+ (stringE $ "No generic representation for empty datatype "
+ ++ nameBase dt))
+ []]
-mkTo :: GenericClass -> Int -> Int -> Name -> [Con] -> Q Match
-mkTo gClass m i dt cs = do
+mkTo :: GenericClass -> EmptyCaseOptions -> Int -> Int -> Name -> [Con] -> Q
Match
+mkTo gClass ecOptions 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]
+ [] -> errorTo ecOptions dt
_ -> zipWith (toCon gClass wrapP (length cs)) [0..] cs
wrapP p = lrP m i p
+errorTo :: EmptyCaseOptions -> Name -> [Q Match]
+errorTo useEmptyCase dt
+ | useEmptyCase && ghc7'8OrLater
+ = []
+ | otherwise
+ = [do z <- newName "z"
+ match
+ (varP z)
+ (normalB $
+ appE (varE seqValName) (varE z) `appE`
+ appE (varE errorValName)
+ (stringE $ "No values for empty datatype " ++ nameBase dt))
+ []]
+
+ghc7'8OrLater :: Bool
+#if __GLASGOW_HASKELL__ >= 708
+ghc7'8OrLater = True
+#else
+ghc7'8OrLater = False
+#endif
+
fromCon :: GenericClass -> (Q Exp -> Q Exp) -> Int -> Int -> Con -> Q Match
fromCon _ wrap m i (NormalC cn []) =
match
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/generic-deriving-1.11.2/src/Generics/Deriving/Traversable.hs
new/generic-deriving-1.12.1/src/Generics/Deriving/Traversable.hs
--- old/generic-deriving-1.11.2/src/Generics/Deriving/Traversable.hs
2017-04-10 15:13:29.000000000 +0200
+++ new/generic-deriving-1.12.1/src/Generics/Deriving/Traversable.hs
2018-01-11 22:49:37.000000000 +0100
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
@@ -13,6 +14,10 @@
{-# LANGUAGE PolyKinds #-}
#endif
+#if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE EmptyCase #-}
+#endif
+
module Generics.Deriving.Traversable (
-- * Generic Traversable class
GTraversable(..)
@@ -64,6 +69,14 @@
class GTraversable' t where
gtraverse' :: Applicative f => (a -> f b) -> t a -> f (t b)
+instance GTraversable' V1 where
+ gtraverse' _ x = pure $ case x of
+#if __GLASGOW_HASKELL__ >= 708
+ {}
+#else
+ !_ -> error "Void gtraverse"
+#endif
+
instance GTraversable' U1 where
gtraverse' _ U1 = pure U1
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/generic-deriving-1.11.2/tests/EmptyCaseSpec.hs
new/generic-deriving-1.12.1/tests/EmptyCaseSpec.hs
--- old/generic-deriving-1.11.2/tests/EmptyCaseSpec.hs 1970-01-01
01:00:00.000000000 +0100
+++ new/generic-deriving-1.12.1/tests/EmptyCaseSpec.hs 2018-01-11
22:49:37.000000000 +0100
@@ -0,0 +1,27 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+
+#if __GLASGOW_HASKELL__ >= 706
+{-# LANGUAGE DataKinds #-}
+#endif
+
+#if __GLASGOW_HASKELL__ >= 708
+{-# LANGUAGE EmptyCase #-}
+#endif
+
+module EmptyCaseSpec (main, spec) where
+
+import Generics.Deriving.TH
+import Test.Hspec
+
+data Empty a
+$(deriveAll0And1Options defaultOptions{emptyCaseOptions = True}
+ ''Empty)
+
+main :: IO ()
+main = hspec spec
+
+spec :: Spec
+spec = return ()
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/generic-deriving-1.11.2/tests/ExampleSpec.hs
new/generic-deriving-1.12.1/tests/ExampleSpec.hs
--- old/generic-deriving-1.11.2/tests/ExampleSpec.hs 2017-04-10
15:13:29.000000000 +0200
+++ new/generic-deriving-1.12.1/tests/ExampleSpec.hs 2018-01-11
22:49:37.000000000 +0100
@@ -342,11 +342,6 @@
| MyType1Cons2 (f :/: a) Int a (f a)
| (f :/: a) :/: MyType2
-infixr 5 :!@!:
-data GADTSyntax a b where
- GADTPrefix :: d -> c -> GADTSyntax c d
- (:!@!:) :: e -> f -> GADTSyntax e f
-
data MyType2 = MyType2 Float ([] :/: Int)
data PlainHash a = Hash a Addr# Char# Double# Float# Int# Word#
@@ -393,7 +388,6 @@
$(deriveAll0And1 ''Empty)
$(deriveAll0And1 ''(:/:))
-$(deriveAll0And1 ''GADTSyntax)
$(deriveAll0 ''MyType2)
$(deriveAll0And1 ''PlainHash)
$(deriveAll0 ''ExampleSpec.Lexeme)
++++++ generic-deriving.cabal ++++++
name: generic-deriving
version: 1.12.1
x-revision: 1
synopsis: Generic programming library for generalised deriving.
description:
This package provides functionality for generalising the deriving mechanism
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/GHC.Generics> for more information.
Template Haskell code is provided for supporting older GHCs.
homepage: https://github.com/dreixel/generic-deriving
bug-reports: https://github.com/dreixel/generic-deriving/issues
category: Generics
copyright: 2011-2013 Universiteit Utrecht, University of Oxford
license: BSD3
license-file: LICENSE
author: José Pedro Magalhães
maintainer: [email protected]
stability: experimental
build-type: Simple
cabal-version: >= 1.10
tested-with: GHC == 7.0.4
, GHC == 7.2.2
, GHC == 7.4.2
, GHC == 7.6.3
, GHC == 7.8.4
, GHC == 7.10.3
, GHC == 8.0.2
, GHC == 8.2.2
, GHC == 8.4.1
extra-source-files: CHANGELOG.md
, README.md
source-repository head
type: git
location: https://github.com/dreixel/generic-deriving
flag base-4-9
description: Use base-4.9 or later. This version of base uses a
DataKinds-based encoding of GHC generics metadata.
default: True
library
hs-source-dirs: src
exposed-modules: Generics.Deriving
Generics.Deriving.Base
Generics.Deriving.Instances
Generics.Deriving.Copoint
Generics.Deriving.ConNames
Generics.Deriving.Enum
Generics.Deriving.Eq
Generics.Deriving.Foldable
Generics.Deriving.Functor
Generics.Deriving.Monoid
Generics.Deriving.Semigroup
Generics.Deriving.Show
Generics.Deriving.Traversable
Generics.Deriving.Uniplate
Generics.Deriving.TH
other-modules: Generics.Deriving.Base.Internal
Generics.Deriving.TH.Internal
Paths_generic_deriving
if flag(base-4-9)
build-depends: base >= 4.9 && < 5
other-modules: Generics.Deriving.TH.Post4_9
else
build-depends: base >= 4.3 && < 4.9
other-modules: Generics.Deriving.TH.Pre4_9
build-depends: containers >= 0.1 && < 0.6
, ghc-prim < 1
, template-haskell >= 2.4 && < 2.14
default-language: Haskell2010
ghc-options: -Wall
test-suite spec
type: exitcode-stdio-1.0
main-is: Spec.hs
other-modules: EmptyCaseSpec
ExampleSpec
TypeInTypeSpec
build-depends: base >= 4.3 && < 5
, generic-deriving
, hspec >= 2 && < 3
, template-haskell >= 2.4 && < 2.14
build-tool-depends: hspec-discover:hspec-discover
hs-source-dirs: tests
default-language: Haskell2010
ghc-options: -Wall -threaded -rtsopts
