Proposal: Adding generics-based rnf-helper to `deepseq`

Hello Simon (et al.), Some time ago, the `generic-deepseq` package was announced to the haskell-cafe list, and some discussion took place[1], and the suggestion came up that it might useful to be included to `deepseq` somehow. IMHO, a least introduing way (which I've been using myself) would be to add something along the code below to the `Control.DeepSeq` module (only `genericsRnf` shall be exported, thus avoiding a PVP-major-bump): -- | Generics-based 'rnf' implementation genericsRnf :: (Generic a, GNFData (Rep a)) => a -> () genericsRnf = grnf_ . from {-# INLINE genericRnf #-} -- | Hidden type-class, /not/ exported class GNFData f where grnf_ :: f a -> () instance GNFData U1 where grnf_ !U1 = () {-# INLINE grnf_ #-} instance NFData a => GNFData (K1 i a) where grnf_ = rnf . unK1 {-# INLINE grnf_ #-} instance GNFData a => GNFData (M1 i c a) where grnf_ = grnf_ . unM1 {-# INLINE grnf_ #-} instance (GNFData a, GNFData b) => GNFData (a :*: b) where grnf_ (x :*: y) = grnf_ x `seq` grnf_ y {-# INLINE grnf_ #-} instance (GNFData a, GNFData b) => GNFData (a :+: b) where grnf_ (L1 x) = grnf_ x grnf_ (R1 x) = grnf_ x {-# INLINE grnf_ #-} this way, the client code can then chose to use a Generics-derived `rnf` implementation expliclity by simply declaring: instance NFData FooBar where rnf = genericsRnf ...does this sound sensible? cheers, hvr [1]: http://www.haskell.org/pipermail/haskell-cafe/2012-February/099551.html --

+1
I would just suggest calling the exported function `genericRnf`.
Cheers,
Pedro
On Fri, Sep 21, 2012 at 10:21 AM, Herbert Valerio Riedel
Hello Simon (et al.),
Some time ago, the `generic-deepseq` package was announced to the haskell-cafe list, and some discussion took place[1], and the suggestion came up that it might useful to be included to `deepseq` somehow.
IMHO, a least introduing way (which I've been using myself) would be to add something along the code below to the `Control.DeepSeq` module (only `genericsRnf` shall be exported, thus avoiding a PVP-major-bump):
-- | Generics-based 'rnf' implementation genericsRnf :: (Generic a, GNFData (Rep a)) => a -> () genericsRnf = grnf_ . from {-# INLINE genericRnf #-}
-- | Hidden type-class, /not/ exported class GNFData f where grnf_ :: f a -> ()
instance GNFData U1 where grnf_ !U1 = () {-# INLINE grnf_ #-}
instance NFData a => GNFData (K1 i a) where grnf_ = rnf . unK1 {-# INLINE grnf_ #-}
instance GNFData a => GNFData (M1 i c a) where grnf_ = grnf_ . unM1 {-# INLINE grnf_ #-}
instance (GNFData a, GNFData b) => GNFData (a :*: b) where grnf_ (x :*: y) = grnf_ x `seq` grnf_ y {-# INLINE grnf_ #-}
instance (GNFData a, GNFData b) => GNFData (a :+: b) where grnf_ (L1 x) = grnf_ x grnf_ (R1 x) = grnf_ x {-# INLINE grnf_ #-}
this way, the client code can then chose to use a Generics-derived `rnf` implementation expliclity by simply declaring:
instance NFData FooBar where rnf = genericsRnf
...does this sound sensible?
cheers, hvr
[1]: http://www.haskell.org/pipermail/haskell-cafe/2012-February/099551.html
--
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries

On Fri, 21 Sep 2012, Herbert Valerio Riedel wrote:
Hello Simon (et al.),
Some time ago, the `generic-deepseq` package was announced to the haskell-cafe list, and some discussion took place[1], and the suggestion came up that it might useful to be included to `deepseq` somehow.
IMHO, a least introduing way (which I've been using myself) would be to add something along the code below to the `Control.DeepSeq` module (only `genericsRnf` shall be exported, thus avoiding a PVP-major-bump):
As far as I know, deepseq is currently plain Haskell 98. This would no longer be true with a dependency on generics. Thus I would prefer to keep deepseq and generic-deepseq separated.

Henning Thielemann
As far as I know, deepseq is currently plain Haskell 98. This would no longer be true with a dependency on generics. Thus I would prefer to keep deepseq and generic-deepseq separated.
that's right (although one could make that an optional feature of the `deepseq` package, depending on the availability of the generics-feature, so that `deepseq` could still build with a pure H98 compiler) moreover, there's one important difference though between the implementation I included in the email and the original `generic-deepseq` package: The `generic-deepseq` package uses a completely separate `DeepSeq` type-class (the `generic-deepseq` package doesn't even depend on the `deepseq` package), whereas the code I posted is able to make use of existing `NFData` class instances.

On Fri, 21 Sep 2012, Herbert Valerio Riedel wrote:
Henning Thielemann
writes: As far as I know, deepseq is currently plain Haskell 98. This would no longer be true with a dependency on generics. Thus I would prefer to keep deepseq and generic-deepseq separated.
that's right (although one could make that an optional feature of the `deepseq` package, depending on the availability of the generics-feature, so that `deepseq` could still build with a pure H98 compiler)
And how would one write packages that depend on deepseq, that can be compiled easily on both, say, GHC and JHC?

Henning Thielemann
On Fri, 21 Sep 2012, Herbert Valerio Riedel wrote:
Henning Thielemann
writes: As far as I know, deepseq is currently plain Haskell 98. This would no longer be true with a dependency on generics. Thus I would prefer to keep deepseq and generic-deepseq separated.
that's right (although one could make that an optional feature of the `deepseq` package, depending on the availability of the generics-feature, so that `deepseq` could still build with a pure H98 compiler)
And how would one write packages that depend on deepseq, that can be compiled easily on both, say, GHC and JHC?
afaics, if you choose (which is an explicit decision) to make use of `genericRnf`, you already have to provide `Generic` instances in your client code, thus your code already is beyond Haskell98 as it uses the Generics GHC extension. If you don't make use of the `genericRnf` then there's no harm, as your code would work with a `deepseq` package compiled in "H98 compatibility mode"... or am I overlooking something?

José Pedro Magalhães
On Fri, Sep 21, 2012 at 10:58 AM, Herbert Valerio Riedel
wrote: Henning Thielemann
writes: On Fri, 21 Sep 2012, Herbert Valerio Riedel wrote: ... a `deepseq` package compiled in "H98 compatibility mode"... or am I overlooking something?
Are you suggesting CPP?
Either that (this is how the `cereal` package does it for instance) or by a pure CABAL solution, which switches between two internal .hs files based on `impl(ghc >= 7.2)`, or maybe a CABAL-flag-based approach... so this is just an implementation detail[1] which can be decided once it is clear, whether adding `genericRnf` is a good idea at all [1]: another impleemtation detail would be, whether to make `genericRnf` visible directly in `Control.DeepSeq` or in a separate module such as `Control.DeepSeq.Generics`

On 9/21/12 6:11 AM, Herbert Valerio Riedel wrote:
[1]: another impleemtation detail would be, whether to make `genericRnf` visible directly in `Control.DeepSeq` or in a separate module such as `Control.DeepSeq.Generics`
I'm agnostic on the issue of including genericRnf rather than keeping the packages separate; but if it is included, I definitely think it ought to be put in a separate module. Having the API of a module depend on CPP/flags/... is a terrible maintenance issue--- for client code, I mean. But just having a module be absent/present makes the divide clear, and makes it a lot easier to work with. -- Live well, ~wren

On Sun, Sep 23, 2012 at 7:13 AM, wren ng thornton
I'm agnostic on the issue of including genericRnf rather than keeping the packages separate; but if it is included, I definitely think it ought to be put in a separate module. Having the API of a module depend on CPP/flags/... is a terrible maintenance issue--- for client code, I mean. But just having a module be absent/present makes the divide clear, and makes it a lot easier to work with.
I believe that Cabal is expressly designed so that exposed-modules cannot change based on configuration of things. Can anyone suggest a clear disadvantage for having the generics stuff remain in a separate package? It seems like the least problematic solution to me so far.

On 9/23/12 11:31 AM, Ben Millwood wrote:
On Sun, Sep 23, 2012 at 7:13 AM, wren ng thornton
wrote: I'm agnostic on the issue of including genericRnf rather than keeping the packages separate; but if it is included, I definitely think it ought to be put in a separate module. Having the API of a module depend on CPP/flags/... is a terrible maintenance issue--- for client code, I mean. But just having a module be absent/present makes the divide clear, and makes it a lot easier to work with.
I believe that Cabal is expressly designed so that exposed-modules cannot change based on configuration of things.
That's true, however you can have the entire contents of the module be hidden by CPP. This is how many of the STM data structures are handled. (Thus, the client-side error isn't trying to import the module, but rather is trying to import any definitions from the module. But that's still preferable since it isolates the issues into a single module rather than having it mixed up with the shared definitions.) -- Live well, ~wren

Ben Millwood
On Sun, Sep 23, 2012 at 7:13 AM, wren ng thornton
wrote: I'm agnostic on the issue of including genericRnf rather than keeping the packages separate; but if it is included, I definitely think it ought to be put in a separate module. Having the API of a module depend on CPP/flags/... is a terrible maintenance issue--- for client code, I mean. But just having a module be absent/present makes the divide clear, and makes it a lot easier to work with.
I believe that Cabal is expressly designed so that exposed-modules cannot change based on configuration of things. Can anyone suggest a clear disadvantage for having the generics stuff remain in a separate package? It seems like the least problematic solution to me so far.
Fair enough, I've just uploaded a companion package providing the "Control.DeepSeq.Generics" module, see http://hackage.haskell.org/package/deepseq-generics-0.1.0.0 for documentation & usage examples So, regardless of whether `genericRnf` will be merged into `deepseq` at some point or not, `deepseq-generics` now provides Generics-based `rnf` support for older GHCs starting with version 7.4.1. I hope this will be useful to someone. Btw, I hacked up a test-suite for testing whether `genericRnf` works as expected. Suggestions/ideas on how to improve the current test-suite would be welcomed.

On 24/09/2012 14:22, Herbert Valerio Riedel wrote:
Ben Millwood
writes: On Sun, Sep 23, 2012 at 7:13 AM, wren ng thornton
wrote: I'm agnostic on the issue of including genericRnf rather than keeping the packages separate; but if it is included, I definitely think it ought to be put in a separate module. Having the API of a module depend on CPP/flags/... is a terrible maintenance issue--- for client code, I mean. But just having a module be absent/present makes the divide clear, and makes it a lot easier to work with.
I believe that Cabal is expressly designed so that exposed-modules cannot change based on configuration of things. Can anyone suggest a clear disadvantage for having the generics stuff remain in a separate package? It seems like the least problematic solution to me so far.
Fair enough, I've just uploaded a companion package providing the "Control.DeepSeq.Generics" module, see
http://hackage.haskell.org/package/deepseq-generics-0.1.0.0
for documentation & usage examples
So, regardless of whether `genericRnf` will be merged into `deepseq` at some point or not, `deepseq-generics` now provides Generics-based `rnf` support for older GHCs starting with version 7.4.1. I hope this will be useful to someone.
Btw, I hacked up a test-suite for testing whether `genericRnf` works as expected. Suggestions/ideas on how to improve the current test-suite would be welcomed.
So, just to make sure I've followed, the conclusion is that we don't want to modify the deepseq package because that would take it outside Haskell 98, and we don't want to have a conditional API (quite rightly). There's no disadvantage to having the generic functionality in a separate package, right? Cheers, Simon

Simon Marlow
So, just to make sure I've followed, the conclusion is that we don't want to modify the deepseq package because that would take it outside Haskell 98, and we don't want to have a conditional API (quite rightly). There's no disadvantage to having the generic functionality in a separate package, right?
Yeah, that sums it up about right (the way I perceived the discussion) Originally, it seemed a bit overkill to me to create a separate package containing just a few lines of codes also, I thought that the current default (pure H98/H2010) implementation for rnf provided by the NFData type-class, which is | class NFData a where | rnf :: a -> () | rnf a = a `seq` () could be changed to make use of the DefaultSignature extension at some point in the future (which'd defintely leave the H98/H2010 featureset and/or lead to a conditional API), for which having the `genericsRnf` helper accessible to the `deepseq` package would be a requirement However, the convenience of being able to write | instance NFData Foo instead of the more verbose | instance NFData Foo where rnf = genericsRnf isn't such a big deal either... it would have just been a nice use-case for the DefaultSignature extension IMHO :-) cheers, hvr
participants (6)
-
Ben Millwood
-
Henning Thielemann
-
Herbert Valerio Riedel
-
José Pedro Magalhães
-
Simon Marlow
-
wren ng thornton