deepseq-generics-0.1.1.2/0000755000000000000000000000000012444272057013271 5ustar0000000000000000deepseq-generics-0.1.1.2/Setup.hs0000644000000000000000000000005612444272057014726 0ustar0000000000000000import Distribution.Simple main = defaultMain deepseq-generics-0.1.1.2/changelog0000644000000000000000000000065312444272057015147 0ustar0000000000000000-*-change-log-*- 0.1.1.2 Herbert Valerio Riedel November 2013 * Add support for GHC 7.10 and `deepseq-1.4.0.0` 0.1.1.1 Herbert Valerio Riedel November 2013 * Add support for GHC 7.8 0.1.1.0 Herbert Valerio Riedel September 2013 * Control/DeepSeq/Generics.hs (genericRnfV1): New Function 0.1.0.0 Herbert Valerio Riedel September 2012 * Initial Release deepseq-generics-0.1.1.2/deepseq-generics.cabal0000644000000000000000000000475012444272057017506 0ustar0000000000000000name: deepseq-generics version: 0.1.1.2 synopsis: GHC.Generics-based Control.DeepSeq.rnf implementation homepage: https://github.com/hvr/deepseq-generics bug-reports: https://github.com/hvr/deepseq-generics/issues license: BSD3 license-file: LICENSE author: Herbert Valerio Riedel maintainer: hvr@gnu.org copyright: 2012, Herbert Valerio Riedel category: Control build-type: Simple cabal-version: >=1.10 tested-with: GHC==7.6.3, GHC==7.6.2, GHC==7.6.1, GHC==7.4.2, GHC==7.4.1 description: This package provides a "GHC.Generics"-based 'Control.DeepSeq.Generics.genericRnf' function which can be used for providing a 'rnf' implementation. See the documentation for the 'genericRnf' function in the "Control.DeepSeq.Generics" module to get started. . The original idea was pioneered in the @generic-deepseq@ package (see for more information). . This package differs from the @generic-deepseq@ package by working in combination with the existing @deepseq@ package as opposed to defining a conflicting drop-in replacement for @deepseq@'s @Control.Deepseq@ module. . Note: The ability to auto-derive via "GHC.Generics" has been merged into @deepseq-1.4.0.0@. This package is now still useful for writing code that's also compatible with older @deepseq@ versions not yet providing "GHC.Generics"-support. extra-source-files: changelog source-repository head type: git location: https://github.com/hvr/deepseq-generics.git library default-language: Haskell2010 exposed-modules: Control.DeepSeq.Generics build-depends: base >= 4.5 && < 4.9, ghc-prim >= 0.2 && < 0.4, deepseq >= 1.2.0.1 && < 1.5 other-extensions: BangPatterns, FlexibleContexts, TypeOperators ghc-options: -Wall test-suite deepseq-generics-tests default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Suite.hs other-extensions: CPP, DeriveDataTypeable, DeriveGeneric, TupleSections ghc-options: -Wall build-depends: base, deepseq, deepseq-generics, ghc-prim, -- end of packages with inherited version constraints test-framework, test-framework-hunit, HUnit deepseq-generics-0.1.1.2/LICENSE0000644000000000000000000000300612444272057014275 0ustar0000000000000000Copyright (c) 2012, Herbert Valerio Riedel All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Herbert Valerio Riedel nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. deepseq-generics-0.1.1.2/test/0000755000000000000000000000000012444272057014250 5ustar0000000000000000deepseq-generics-0.1.1.2/test/Suite.hs0000644000000000000000000001010512444272057015672 0ustar0000000000000000{-# LANGUAGE CPP, TupleSections, DeriveDataTypeable, DeriveGeneric #-} module Main (main) where import Control.Concurrent.MVar import Control.DeepSeq import Control.Exception import Control.Monad import Data.Bits import Data.IORef import Data.Typeable import Data.Word import GHC.Generics import System.IO.Unsafe (unsafePerformIO) -- import Test.Framework (defaultMain, testGroup, testCase) import Test.Framework import Test.Framework.Providers.HUnit import Test.HUnit -- IUT import Control.DeepSeq.Generics -- needed for GHC-7.4 compatibility #if !MIN_VERSION_base(4,6,0) atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b atomicModifyIORef' ref f = do b <- atomicModifyIORef ref (\x -> let (a, b) = f x in (a, a `seq` b)) b `seq` return b #endif ---------------------------------------------------------------------------- -- simple hacky abstraction for testing forced evaluation via `rnf`-like functions seqStateLock :: MVar () seqStateLock = unsafePerformIO $ newMVar () {-# NOINLINE seqStateLock #-} withSeqState :: Word64 -> IO () -> IO () withSeqState expectedState act = withMVar seqStateLock $ \() -> do 0 <- resetSeqState () <- act st <- resetSeqState unless (st == expectedState) $ assertFailure ("withSeqState: actual seq-state ("++show st++") doesn't match expected value ("++ show expectedState++")") seqState :: IORef Word64 seqState = unsafePerformIO $ newIORef 0 {-# NOINLINE seqState #-} resetSeqState :: IO Word64 resetSeqState = atomicModifyIORef' seqState (0,) -- |Set flag and raise exception is flag already set setSeqState :: Int -> IO () setSeqState i | 0 <= i && i < 64 = atomicModifyIORef' seqState go | otherwise = error "seqSeqState: flag index must be in [0..63]" where go x | testBit x i = error ("setSeqState: flag #"++show i++" already set") | otherwise = (setBit x i, ()) -- weird type whose NFData instacne calls 'setSeqState' when rnf-ed data SeqSet = SeqSet !Int | SeqIgnore deriving Show instance NFData SeqSet where rnf (SeqSet i) = unsafePerformIO $ setSeqState i rnf (SeqIgnore) = () {-# NOINLINE rnf #-} -- |Exception to be thrown for testing 'seq'/'rnf' data RnfEx = RnfEx deriving (Eq, Show, Typeable) instance Exception RnfEx instance NFData RnfEx where rnf e = throw e assertRnfEx :: () -> IO () assertRnfEx v = handleJust isWanted (const $ return ()) $ do () <- evaluate v assertFailure "failed to trigger expected RnfEx exception" where isWanted = guard . (== RnfEx) ---------------------------------------------------------------------------- case_1, case_2, case_3, case_4_1, case_4_2, case_4_3, case_4_4 :: Test.Framework.Test newtype Case1 = Case1 Int deriving Generic case_1 = testCase "Case1" $ do assertRnfEx $ genericRnf $ (Case1 (throw RnfEx)) ---- data Case2 = Case2 Int deriving Generic case_2 = testCase "Case2" $ do assertRnfEx $ genericRnf $ (Case2 (throw RnfEx)) ---- data Case3 = Case3 RnfEx deriving Generic case_3 = testCase "Case3" $ do assertRnfEx $ genericRnf $ Case3 RnfEx ---- data Case4 a = Case4a | Case4b a a | Case4c a (Case4 a) deriving Generic instance NFData a => NFData (Case4 a) where rnf = genericRnf case_4_1 = testCase "Case4.1" $ withSeqState 0x0 $ do evaluate $ rnf $ (Case4a :: Case4 SeqSet) case_4_2 = testCase "Case4.2" $ withSeqState 0x3 $ do evaluate $ rnf $ (Case4b (SeqSet 0) (SeqSet 1) :: Case4 SeqSet) case_4_3 = testCase "Case4.3" $ withSeqState (bit 55) $ do evaluate $ rnf $ (Case4b SeqIgnore (SeqSet 55) :: Case4 SeqSet) case_4_4 = testCase "Case4.4" $ withSeqState 0xffffffffffffffff $ do evaluate $ rnf $ (genCase 63) where genCase n | n > 1 = Case4c (SeqSet n) (genCase (n-1)) | otherwise = Case4b (SeqSet 0) (SeqSet 1) ---------------------------------------------------------------------------- main :: IO () main = defaultMain [tests] where tests = testGroup "" [case_1, case_2, case_3, case_4_1, case_4_2, case_4_3, case_4_4] deepseq-generics-0.1.1.2/Control/0000755000000000000000000000000012444272057014711 5ustar0000000000000000deepseq-generics-0.1.1.2/Control/DeepSeq/0000755000000000000000000000000012444272057016237 5ustar0000000000000000deepseq-generics-0.1.1.2/Control/DeepSeq/Generics.hs0000644000000000000000000001227012444272057020334 0ustar0000000000000000{-# LANGUAGE BangPatterns, TypeOperators, FlexibleContexts #-} -- | -- Module: Control.DeepSeq.Generics -- Copyright: (c) 2012, Herbert Valerio Riedel -- License: BSD-style (see the LICENSE file) -- -- Maintainer: Herbert Valerio Riedel -- Stability: stable -- Portability: GHC -- -- 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. module Control.DeepSeq.Generics ( genericRnf , genericRnfV1 -- * "Control.DeepSeq" re-exports , deepseq , force , NFData(rnf) , ($!!) ) where import Control.DeepSeq import GHC.Generics -- | "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. genericRnf :: (Generic a, GNFData (Rep a)) => a -> () genericRnf = grnf_ . from {-# INLINE genericRnf #-} -- | Hidden internal type-class -- -- __NOTE__: the 'V1' instance is not provided for 'GNFData' in order to -- trigger a compile-time error; see 'GNFDataV1' which defers this to -- a runtime error. 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_ #-} -- | 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) -- > -- > :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/ genericRnfV1 :: (Generic a, GNFDataV1 (Rep a)) => a -> () genericRnfV1 = grnfV1_ . from {-# INLINE genericRnfV1 #-} -- | Variant of 'GNFData' supporting 'V1' class GNFDataV1 f where grnfV1_ :: f a -> () instance GNFDataV1 V1 where grnfV1_ = error "Control.DeepSeq.Generics.genericRnfV1: NF not defined for uninhabited types" instance GNFDataV1 U1 where grnfV1_ !U1 = () {-# INLINE grnfV1_ #-} instance NFData a => GNFDataV1 (K1 i a) where grnfV1_ = rnf . unK1 {-# INLINE grnfV1_ #-} instance GNFDataV1 a => GNFDataV1 (M1 i c a) where grnfV1_ = grnfV1_ . unM1 {-# INLINE grnfV1_ #-} instance (GNFDataV1 a, GNFDataV1 b) => GNFDataV1 (a :*: b) where grnfV1_ (x :*: y) = grnfV1_ x `seq` grnfV1_ y {-# INLINE grnfV1_ #-} instance (GNFDataV1 a, GNFDataV1 b) => GNFDataV1 (a :+: b) where grnfV1_ (L1 x) = grnfV1_ x grnfV1_ (R1 x) = grnfV1_ x {-# INLINE grnfV1_ #-}