deepseq-generics-0.1.1.2: GHC.Generics-based Control.DeepSeq.rnf implementation

Copyright(c) 2012, Herbert Valerio Riedel
LicenseBSD-style (see the LICENSE file)
MaintainerHerbert Valerio Riedel <hvr@gnu.org>
Stabilitystable
PortabilityGHC
Safe HaskellSafe
LanguageHaskell2010

Control.DeepSeq.Generics

Contents

Description

Beyond the primary scope of providing the genericRnf helper, this module also re-exports the definitions from Control.DeepSeq for convenience. If this poses any problems, just use qualified or explicit import statements (see code usage example in the genericRnf description)

NOTE: Starting with deepseq-1.4.0.0, NFData gained support for generic derivation via DefaultSignatures. The new default rnf method implementation is then equivalent to

instance NFData MyType where
  rnf = genericRnfV1

See documentation of rnf for more details on how to use the new built-in Generic support.

Synopsis

Documentation

genericRnf :: (Generic a, GNFData (Rep a)) => a -> () Source

GHC.Generics-based rnf implementation

This provides a generic rnf implementation for one type at a time. If the type of the value genericRnf is asked to reduce to NF contains values of other types, those types have to provide NFData instances. This also means that recursive types can only be used with genericRnf if a NFData instance has been defined as well (see examples below).

The typical usage for genericRnf is for reducing boilerplate code when defining NFData instances for ordinary algebraic datatypes. See the code below for some simple usage examples:

{-# LANGUAGE DeriveGeneric #-}

import Control.DeepSeq
import Control.DeepSeq.Generics (genericRnf)
import GHC.Generics

-- simple record
data Foo = Foo AccountId Name Address
         deriving Generic

type Address      = [String]
type Name         = String
newtype AccountId = AccountId Int

instance NFData AccountId
instance NFData Foo where rnf = genericRnf

-- recursive list-like type
data N = Z | S N deriving Generic

instance NFData N where rnf = genericRnf

-- parametric & recursive type
data Bar a = Bar0 | Bar1 a | Bar2 (Bar a)
           deriving Generic

instance NFData a => NFData (Bar a) where rnf = genericRnf

NOTE: The GNFData type-class showing up in the type-signature is used internally and not exported on purpose currently.

genericRnfV1 :: (Generic a, GNFDataV1 (Rep a)) => a -> () Source

Variant of genericRnf which supports derivation for uninhabited types.

For instance, the type

data TagFoo deriving Generic

would cause a compile-time error with genericRnf, but with genericRnfV1 the error is deferred to run-time:

Prelude> genericRnf (undefined :: TagFoo)

<interactive>:1:1:
    No instance for (GNFData V1) arising from a use of `genericRnf'
    Possible fix: add an instance declaration for (GNFData V1)
    In the expression: genericRnf (undefined :: TagFoo)
    In an equation for `it': it = genericRnf (undefined :: TagFoo)

Prelude> genericRnfV1 (undefined :: TagFoo)
*** Exception: Control.DeepSeq.Generics.genericRnfV1: NF not defined for uninhabited types

Since: 0.1.1.0

Control.DeepSeq re-exports

deepseq :: NFData a => a -> b -> b

deepseq: fully evaluates the first argument, before returning the second.

The name deepseq is used to illustrate the relationship to seq: where seq is shallow in the sense that it only evaluates the top level of its argument, deepseq traverses the entire data structure evaluating it completely.

deepseq can be useful for forcing pending exceptions, eradicating space leaks, or forcing lazy I/O to happen. It is also useful in conjunction with parallel Strategies (see the parallel package).

There is no guarantee about the ordering of evaluation. The implementation may evaluate the components of the structure in any order or in parallel. To impose an actual order on evaluation, use pseq from Control.Parallel in the parallel package.

Since: 1.1.0.0

force :: NFData a => a -> a

a variant of deepseq that is useful in some circumstances:

force x = x `deepseq` x

force x fully evaluates x, and then returns it. Note that force x only performs evaluation when the value of force x itself is demanded, so essentially it turns shallow evaluation into deep evaluation.

Since: 1.2.0.0

class NFData a where

A class of types that can be fully evaluated.

Since: 1.1.0.0

Minimal complete definition

Nothing

Methods

rnf :: a -> ()

rnf should reduce its argument to normal form (that is, fully evaluate all sub-components), and then return '()'.

Generic NFData deriving

Starting with GHC 7.2, you can automatically derive instances for types possessing a Generic instance.

{-# LANGUAGE DeriveGeneric #-}

import GHC.Generics (Generic)
import Control.DeepSeq

data Foo a = Foo a String
             deriving (Eq, Generic)

instance NFData a => NFData (Foo a)

data Colour = Red | Green | Blue
              deriving Generic

instance NFData Colour

Starting with GHC 7.10, the example above can be written more concisely by enabling the new DeriveAnyClass extension:

{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}

import GHC.Generics (Generic)
import Control.DeepSeq

data Foo a = Foo a String
             deriving (Eq, Generic, NFData)

data Colour = Red | Green | Blue
              deriving (Generic, NFData)

Compatibility with previous deepseq versions

Prior to version 1.4.0, the default implementation of the rnf method was defined as

rnf a = seq a ()

However, starting with deepseq-1.4.0.0, the default implementation is based on DefaultSignatures allowing for more accurate auto-derived NFData instances. If you need the previously used exact default rnf method implementation semantics, use

instance NFData Colour where rnf x = seq x ()

or alternatively

{-# LANGUAGE BangPatterns #-}
instance NFData Colour where rnf !_ = ()

Instances

NFData Bool 
NFData Char 
NFData Double 
NFData Float 
NFData Int 
NFData Int8 
NFData Int16 
NFData Int32 
NFData Int64 
NFData Integer 
NFData Word 
NFData Word8 
NFData Word16 
NFData Word32 
NFData Word64 
NFData () 
NFData Natural

Since: 1.4.0.0

NFData Version

Since: 1.3.0.0

NFData CChar

Since: 1.4.0.0

NFData CSChar

Since: 1.4.0.0

NFData CUChar

Since: 1.4.0.0

NFData CShort

Since: 1.4.0.0

NFData CUShort

Since: 1.4.0.0

NFData CInt

Since: 1.4.0.0

NFData CUInt

Since: 1.4.0.0

NFData CLong

Since: 1.4.0.0

NFData CULong

Since: 1.4.0.0

NFData CLLong

Since: 1.4.0.0

NFData CULLong

Since: 1.4.0.0

NFData CFloat

Since: 1.4.0.0

NFData CDouble

Since: 1.4.0.0

NFData CPtrdiff

Since: 1.4.0.0

NFData CSize

Since: 1.4.0.0

NFData CWchar

Since: 1.4.0.0

NFData CSigAtomic

Since: 1.4.0.0

NFData CClock

Since: 1.4.0.0

NFData CTime

Since: 1.4.0.0

NFData CUSeconds

Since: 1.4.0.0

NFData CSUSeconds

Since: 1.4.0.0

NFData CFile

Since: 1.4.0.0

NFData CFpos

Since: 1.4.0.0

NFData CJmpBuf

Since: 1.4.0.0

NFData CIntPtr

Since: 1.4.0.0

NFData CUIntPtr

Since: 1.4.0.0

NFData CIntMax

Since: 1.4.0.0

NFData CUIntMax

Since: 1.4.0.0

NFData All

Since: 1.4.0.0

NFData Any

Since: 1.4.0.0

NFData TypeRep

NOTE: Only defined for base-4.8.0.0 and later

Since: 1.4.0.0

NFData TyCon

NOTE: Only defined for base-4.8.0.0 and later

Since: 1.4.0.0

NFData Fingerprint

Since: 1.4.0.0

NFData a => NFData [a] 
(Integral a, NFData a) => NFData (Ratio a) 
NFData (StableName a)

Since: 1.4.0.0

NFData a => NFData (Identity a)

Since: 1.4.0.0

NFData (Fixed a)

Since: 1.3.0.0

(RealFloat a, NFData a) => NFData (Complex a) 
NFData a => NFData (ZipList a)

Since: 1.4.0.0

NFData a => NFData (Dual a)

Since: 1.4.0.0

NFData a => NFData (Sum a)

Since: 1.4.0.0

NFData a => NFData (Product a)

Since: 1.4.0.0

NFData a => NFData (First a)

Since: 1.4.0.0

NFData a => NFData (Last a)

Since: 1.4.0.0

NFData a => NFData (Maybe a) 
NFData (a -> b)

This instance is for convenience and consistency with seq. This assumes that WHNF is equivalent to NF for functions.

Since: 1.3.0.0

(NFData a, NFData b) => NFData (Either a b) 
(NFData a, NFData b) => NFData (a, b) 
(Ix a, NFData a, NFData b) => NFData (Array a b) 
NFData a => NFData (Const a b)

Since: 1.4.0.0

NFData (Proxy * a)

Since: 1.4.0.0

(NFData a, NFData b, NFData c) => NFData (a, b, c) 
(NFData a, NFData b, NFData c, NFData d) => NFData (a, b, c, d) 
(NFData a1, NFData a2, NFData a3, NFData a4, NFData a5) => NFData (a1, a2, a3, a4, a5) 
(NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6) => NFData (a1, a2, a3, a4, a5, a6) 
(NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6, NFData a7) => NFData (a1, a2, a3, a4, a5, a6, a7) 
(NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6, NFData a7, NFData a8) => NFData (a1, a2, a3, a4, a5, a6, a7, a8) 
(NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6, NFData a7, NFData a8, NFData a9) => NFData (a1, a2, a3, a4, a5, a6, a7, a8, a9) 

($!!) :: NFData a => (a -> b) -> a -> b infixr 0

the deep analogue of $!. In the expression f $!! x, x is fully evaluated before the function f is applied to it.

Since: 1.2.0.0