concrete-typerep 0.1 → 0.1.0.1

raw patch · 3 files changed

+90/−12 lines, 3 filesdep +QuickCheckdep +concrete-typerepdep +ghcdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, concrete-typerep, ghc, test-framework, test-framework-quickcheck2

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Data/ConcreteTypeRep.hs +27/−9
• concrete-typerep.cabal +28/−3
• tests/Main.hs +35/−0

@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, CPP #-}  {- | This module defines 'Binary' and 'Hashable' instances for 'TypeRep'. These are defined on a newtype of 'TypeRep', namely 'ConcreteTypeRep', for two purposes:@@ -23,6 +23,11 @@  ) where  import Data.Typeable+#ifdef NEW_TYPEREP+import Data.Typeable.Internal+import GHC.Fingerprint.Type+#endif+ import Data.Hashable import Data.Binary @@ -52,25 +57,38 @@ instance Show ConcreteTypeRep where   showsPrec i = showsPrec i . unCTR --- | The 'Hashable' instance is defined by running 'unsafePerformIO' on @'typeRepKey' :: 'TypeRep' -> IO Int@. ------ This instance actually provides a stronger guarantee than required: it is guaranteed that @t1 == t2@ if and only if @'hash' t1 == 'hash' t2@.------ As the documentation for 'typeRepKey' notes, \"... the actual value of the key may vary from run to run of the program. You should only rely on the equality property, not any actual key value. The relative ordering of keys has no meaning either.\"+    +-- | This instance is guaranteed to be consistent for a single run of the program, but not for multiple runs. instance Hashable ConcreteTypeRep where+#ifdef NEW_TYPEREP+  hash (CTR (TypeRep (Fingerprint w1 w2) _ _)) = hash (w1, w2)+#else   hash = unsafePerformIO . typeRepKey . toTypeRep+#endif  ------------- serialization: this uses Gökhan San's construction, from ---- http://www.mail-archive.com/haskell-cafe@haskell.org/msg41134.html-newtype SerialRep = SR (String, [SerialRep]) deriving(Binary)+toTyConRep :: TyCon -> TyConRep+fromTyConRep :: TyConRep -> TyCon+#ifdef NEW_TYPEREP+type TyConRep = (String, String, String)+toTyConRep (TyCon _ pack mod name) = (pack, mod, name)+fromTyConRep (pack, mod, name) = mkTyCon3 pack mod name+#else+type TyConRep = String+toTyConRep = tyConString+fromTyConRep = mkTyCon+#endif +newtype SerialRep = SR (TyConRep, [SerialRep]) deriving(Binary)+ toSerial :: ConcreteTypeRep -> SerialRep toSerial (CTR t) =    case splitTyConApp t of-    (con, args) -> SR (tyConString con, map (toSerial . CTR) args)+    (con, args) -> SR (toTyConRep con, map (toSerial . CTR) args)  fromSerial :: SerialRep -> ConcreteTypeRep-fromSerial (SR (con, args)) = CTR $ mkTyConApp (mkTyCon con) (map (unCTR . fromSerial) args)+fromSerial (SR (con, args)) = CTR $ mkTyConApp (fromTyConRep con) (map (unCTR . fromSerial) args)  instance Binary ConcreteTypeRep where   put = put . toSerial

@@ -1,5 +1,5 @@ Name:                concrete-typerep-Version:             0.1+Version:             0.1.0.1 Synopsis:            Binary and Hashable instances for TypeRep Description:         Binary and Hashable instances for TypeRep License:             BSD3@@ -8,9 +8,34 @@ Maintainer:          reiner.pope@gmail.com Category:            Data Build-type:          Simple-Cabal-version:       >=1.2+Cabal-version:       >=1.9.2 +flag new-typerep+  Description: Build with base >= 4.4.0+  Default: False+ Library   Exposed-modules:     Data.ConcreteTypeRep -  Build-depends:       base < 5, binary, hashable+  Build-depends:       binary, hashable++  if flag(new-typerep)+     Build-depends: base >= 4.4 && < 5, ghc >= 7.2+     cpp-options:   -DNEW_TYPEREP+  else+     Build-depends: base < 4.4++Test-Suite tests+  type: exitcode-stdio-1.0+  Main-is: Main.hs+  hs-source-dirs: tests+  build-depends: +      base,+      binary,+      concrete-typerep,+      hashable,+      test-framework,+      test-framework-quickcheck2,+      QuickCheck >= 2.4+      +      

@@ -0,0 +1,35 @@+import Test.Framework(defaultMain, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck+import Data.Binary(encode, decode)+import Data.Hashable(hash)+import Control.Applicative++import Data.Typeable+import Data.ConcreteTypeRep+import Data.Word++main = defaultMain tests++tests = [+  testGroup "Serialisation" [+     testProperty "roundtrip" prop_roundtrip+   ]+ ]++prop_roundtrip ty = (toTypeRep . decode . encode . fromTypeRep $ ty) == ty++-- instances of arbitrary+genTyCon :: Int -- ^ Number of arguments; must be in [0,1,2]+         -> Gen TyCon+genTyCon 0 = elements [tyConOf (__::Int), tyConOf (__::Word), tyConOf (__::Double), tyConOf (__::Bool)]+genTyCon 1 = elements [tyConOf (__::Maybe Int), tyConOf (__::IO Int), tyConOf (__::[Int])]+genTyCon 2 = elements [tyConOf (__::Either Int Int), tyConOf (__::Int -> Int)]++tyConOf ty = fst $ splitTyConApp (typeOf ty)+__ = undefined++instance Arbitrary TypeRep where+  arbitrary = do+    nargs <- elements [0,1,2]+    mkTyConApp <$> (genTyCon nargs) <*> (vectorOf nargs arbitrary)