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 - psim...@suse.com + +- 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: gener...@haskell.org 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