rank1dynamic 0.3.3.0 → 0.4.3
raw patch · 5 files changed
Files
- ChangeLog +19/−0
- Setup.hs +0/−2
- rank1dynamic.cabal +31/−19
- src/Data/Rank1Typeable.hs +59/−49
- tests/test.hs +18/−18
ChangeLog view
@@ -1,3 +1,22 @@+2025-02-04 Laurent P. René de Cotret <laurent.decotret@outlook.com> 0.4.3++* Ported test suite to use `tasty` rather than `test-framework`.+* Removed unused test dependencies (#467)++2024-09-03 Laurent P. René de Cotret <laurent.decotret@outlook.com> 0.4.2++* Bumped dependency bounds to support GHC 8.10.7 - GHC 9.10.1+* Updated links to point to Distributed Haskell monorepo++2020-10-24 Facundo Domínguez <facundo.dominguez@tweag.io> 0.4.1++* Support ghc-8.6.5 and ghc-8.8.4++2017-08-22 Facundo Domínguez <facundo.dominguez@tweag.io> 0.4.0++* Add compatibility with ghc-8.2.1.+* Drop support for ghc-7.6 and ghc-7.8.+ 2016-05-31 Facundo Domínguez <facundo.dominguez@tweag.io> 0.3.3.0 * Add compatibility with ghc-8.
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
rank1dynamic.cabal view
@@ -1,44 +1,56 @@+cabal-version: 3.0 Name: rank1dynamic-Version: 0.3.3.0+Version: 0.4.3 Synopsis: Like Data.Dynamic/Data.Typeable but with support for rank-1 polymorphic types Description: "Data.Typeable" and "Data.Dynamic" only support monomorphic types. In this package we provide similar functionality but with support for rank-1 polymorphic types. Homepage: http://haskell-distributed.github.com-License: BSD3+License: BSD-3-Clause License-File: LICENSE Author: Edsko de Vries-Maintainer: Facundo Domínguez <facundo.dominguez@tweag.io>-Bug-Reports: https://github.com/haskell-distributed/rank1dynamic/issues+maintainer: The Distributed Haskell team+Bug-Reports: https://github.com/haskell-distributed/distributed-process/issues Copyright: Well-Typed LLP, Tweag I/O Limited Category: Data Build-Type: Simple-Cabal-Version: >=1.8-extra-source-files: ChangeLog+extra-doc-files: ChangeLog -Source-Repository head+source-repository head Type: git- Location: https://github.com/haskell-distributed/rank1dynamic+ Location: https://github.com/haskell-distributed/distributed-process+ SubDir: packages/rank1dynamic +common warnings+ ghc-options: -Wall+ -Wcompat+ -Widentities+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ -Wredundant-constraints+ -fhide-source-paths+ -Wpartial-fields+ -Wunused-packages+ Library+ import: warnings Exposed-Modules: Data.Rank1Dynamic, Data.Rank1Typeable- Build-Depends: base >= 4.4 && < 5,- binary >= 0.5 && < 0.9+ Build-Depends: base >= 4.14 && < 5,+ binary >= 0.8 && < 0.9 HS-Source-Dirs: src- GHC-Options: -Wall- Extensions: EmptyDataDecls,+ default-language: Haskell2010+ Default-Extensions: EmptyDataDecls, DeriveDataTypeable,- ViewPatterns,- CPP+ ViewPatterns Test-Suite TestRank1Dynamic+ import: warnings Type: exitcode-stdio-1.0 Main-Is: test.hs- Build-Depends: base >= 4.4 && < 5,- HUnit >= 1.2 && < 1.4,+ Build-Depends: base >= 4.14 && < 5, rank1dynamic,- test-framework >= 0.6 && < 0.9,- test-framework-hunit >= 0.2.0 && < 0.4- ghc-options: -Wall+ tasty >= 1.5 && <1.6,+ tasty-hunit >=0.10 && <0.11,+ default-language: Haskell2010 HS-Source-Dirs: tests
src/Data/Rank1Typeable.hs view
@@ -56,13 +56,13 @@ -- > -- Cannot apply function of type (forall a. (a -> a) -> a -> a) to arg of type (Int -> Bool) -- > > funResultTy (typeOf (undefined :: (ANY -> ANY) -> (ANY -> ANY))) (typeOf (undefined :: Int -> Bool)) -- > Left "Cannot unify Int and Bool"+{-# LANGUAGE BangPatterns #-} module Data.Rank1Typeable ( -- * Basic types TypeRep , typeOf , splitTyConApp , mkTyConApp- , underlyingTypeRep -- * Operations on type representations , isInstanceOf , funResultTy@@ -98,62 +98,47 @@ import Prelude hiding (succ) import Control.Arrow ((***), second) import Control.Monad (void)-import Control.Applicative ((<$>))+import Data.Binary+import Data.Function (on) import Data.List (intersperse, isPrefixOf) import Data.Maybe (fromMaybe)-import Data.Typeable- ( Typeable- , TyCon- , mkTyCon3- , tyConPackage- , tyConModule- , tyConName- )-#if MIN_VERSION_base(4,7,0)-import Data.Proxy (Proxy(Proxy))-#endif-import qualified Data.Typeable.Internal as T-import Data.Binary (Binary(get, put))-import qualified Data.Typeable as Typeable- ( TypeRep- , typeOf- , splitTyConApp- , mkTyConApp- )+import Data.Typeable ( Typeable )+import qualified Data.Typeable as T+import GHC.Fingerprint tcList, tcFun :: TyCon-#if MIN_VERSION_base(4,7,0)-tcList = T.typeRepTyCon (T.typeOf [()])-tcFun = T.typeRepTyCon (T.typeRep (Proxy :: Proxy (->)))-#else-tcList = T.listTc-tcFun = T.funTc-#endif+tcList = fst $ splitTyConApp $ typeOf [()]+tcFun = fst $ splitTyConApp $ typeOf (\() -> ()) -------------------------------------------------------------------------------- -- The basic type -- -------------------------------------------------------------------------------- -- | Dynamic type representation with support for rank-1 types-newtype TypeRep = TypeRep {- -- | Return the underlying standard ("Data.Typeable") type representation- underlyingTypeRep :: Typeable.TypeRep- }+data TypeRep+ = TRCon TyCon+ | TRApp {-# UNPACK #-} !Fingerprint TypeRep TypeRep +data TyCon = TyCon+ { tyConFingerprint :: {-# UNPACK #-} !Fingerprint+ , tyConPackage :: String+ , tyConModule :: String+ , tyConName :: String+ }++-- | The fingerprint of a TypeRep+typeRepFingerprint :: TypeRep -> Fingerprint+typeRepFingerprint (TRCon c) = tyConFingerprint c+typeRepFingerprint (TRApp fp _ _) = fp+ -- | Compare two type representations------ For base >= 4.6 this compares fingerprints, but older versions of base--- have a bug in the fingerprint construction--- (<http://hackage.haskell.org/trac/ghc/ticket/5962>)+instance Eq TyCon where+ (==) = (==) `on` tyConFingerprint+ instance Eq TypeRep where-#if ! MIN_VERSION_base(4,6,0)- (splitTyConApp -> (c1, ts1)) == (splitTyConApp -> (c2, ts2)) =- c1 == c2 && all (uncurry (==)) (zip ts1 ts2)-#else- t1 == t2 = underlyingTypeRep t1 == underlyingTypeRep t2-#endif+ (==) = (==) `on` typeRepFingerprint --- Binary instance for 'TypeRep', avoiding orphan instances+--- Binary instance for 'TypeRep', avoiding orphan instances instance Binary TypeRep where put (splitTyConApp -> (tc, ts)) = do put $ tyConPackage tc@@ -169,8 +154,30 @@ -- | The type representation of any 'Typeable' term typeOf :: Typeable a => a -> TypeRep-typeOf = TypeRep . Typeable.typeOf+typeOf = trTypeOf . T.typeOf +-- | Conversion from Data.Typeable.TypeRep to Data.Rank1Typeable.TypeRep+trTypeOf :: T.TypeRep -> TypeRep+trTypeOf t = let (c, ts) = T.splitTyConApp t+ in foldl mkTRApp (TRCon $ fromTypeableTyCon c) $ map trTypeOf ts+ where+ fromTypeableTyCon c =+ TyCon (T.tyConFingerprint c)+ (T.tyConPackage c)+ (T.tyConModule c)+ (T.tyConName c)++-- | Applies a TypeRep to another.+mkTRApp :: TypeRep -> TypeRep -> TypeRep+mkTRApp t0 t1 = TRApp fp t0 t1+ where+ fp = fingerprintFingerprints [typeRepFingerprint t0, typeRepFingerprint t1]++mkTyCon3 :: String -> String -> String -> TyCon+mkTyCon3 pkg m name = TyCon fp pkg m name+ where+ fp = fingerprintFingerprints [ fingerprintString s | s <- [pkg, m, name] ]+ -------------------------------------------------------------------------------- -- Constructors/destructors (views) -- --------------------------------------------------------------------------------@@ -178,14 +185,14 @@ -- | Split a type representation into the application of -- a type constructor and its argument splitTyConApp :: TypeRep -> (TyCon, [TypeRep])-splitTyConApp t =- let (c, ts) = Typeable.splitTyConApp (underlyingTypeRep t)- in (c, map TypeRep ts)+splitTyConApp = go []+ where+ go xs (TRCon c) = (c, xs)+ go xs (TRApp _ t0 t1) = go (t1 : xs) t0 -- | Inverse of 'splitTyConApp' mkTyConApp :: TyCon -> [TypeRep] -> TypeRep-mkTyConApp c ts- = TypeRep (Typeable.mkTyConApp c (map underlyingTypeRep ts))+mkTyConApp c = foldl mkTRApp (TRCon c) isTypVar :: TypeRep -> Maybe Var isTypVar (splitTyConApp -> (c, [t])) | c == typVar = Just t@@ -332,6 +339,9 @@ -------------------------------------------------------------------------------- -- Pretty-printing -- --------------------------------------------------------------------------------++instance Show TyCon where+ showsPrec _ c = showString (tyConName c) instance Show TypeRep where showsPrec p (splitTyConApp -> (tycon, tys)) =
tests/test.hs view
@@ -1,17 +1,25 @@ {-# LANGUAGE CPP #-}-import Data.Rank1Typeable-import Data.Rank1Dynamic+import Data.Rank1Dynamic+import Data.Rank1Typeable -import Test.HUnit hiding (Test)-import Test.Framework-import Test.Framework.Providers.HUnit-import Unsafe.Coerce+import Test.Tasty+import Test.Tasty.HUnit+import Unsafe.Coerce +funKindStr :: String+#if defined(MIN_VERSION_GLASGOW_HASKELL) && MIN_VERSION_GLASGOW_HASKELL(9,0,0,0)+funKindStr = "FUN"+#elif __GLASGOW_HASKELL__ >= 804+funKindStr = "->"+#else+funKindStr = "(->)"+#endif + main :: IO ()-main = defaultMain tests+main = defaultMain (testGroup "rank1dynamic" tests) -tests :: [Test]+tests :: [TestTree] tests = [ testGroup "Examples of isInstanceOf" [ testCase "CANNOT use a term of type 'Int -> Bool' as 'Int -> Int'" $@@ -36,11 +44,7 @@ , testCase "CANNOT use a term of type 'forall a. a -> a' as 'forall a. a'" $ typeOf (undefined :: ANY) `isInstanceOf` typeOf (undefined :: ANY -> ANY)-#if MIN_VERSION_base(4,7,0)- @?= Left "Cannot unify Skolem and (->)"-#else- @?= Left "Cannot unify Skolem and ->"-#endif + @?= Left ("Cannot unify Skolem and " ++ funKindStr) ] , testGroup "Examples of funResultTy"@@ -95,11 +99,7 @@ , testCase "CANNOT use a term of type 'forall a. a -> a' as 'forall a. a'" $ do f <- fromDynamic (toDynamic (id :: ANY -> ANY)) ; return $ (f :: Int)-#if MIN_VERSION_base(4,7,0)- @?= Left "Cannot unify Int and (->)"-#else- @?= Left "Cannot unify Int and ->"-#endif+ @?= Left ("Cannot unify Int and " ++ funKindStr) ] , testGroup "Examples of dynApply"