如何将Dynamic转换为Forall的东西

Question

我有一个动态值缓存.他们中的一些人有这种类型Delayed a.

通常当我访问缓存时,我知道类型a,所以这不是问题,我可以使用fromDynamic转换为Maybe a.

我想调用一个函数,它不需要知道a列表中的类型Dynamic.(方法是cancel :: Delay a -> IO ()).有办法吗？

基本上,我需要一种方法来执行从获取Dynamic到Forall a . Delayed a？

编辑

有关信息,Delayed保持挂起的异步值和MVar以启动或取消它.它相当于

 data Delayed m a = Delayed { blocker :: MVar Bool, async :: Async m a }

这些值存储在缓存中(使用Dynamic并存储其他内容).显示缓存状态时,我需要能够获取Delayed值的状态(涉及访问阻止程序但与实际值无关).

Answer 1

类型的值forall a . X a是可以被实例化到任何的价值X Int,X Bool,X String,等推测,您的高速缓存存储许多不同类型的值,但没有一个值在每一个可能的类型参数有效.你真正需要的是一个类型的值exists a . Delayed a.但是,Haskell没有一流的存在量词,因此您必须以某种方式编码该类型.一种特殊的编码是:

castToDelayed :: (forall a . Typeable a => Delayed a -> r) -> Dynamic -> r

假设你有这个功能; 然后你可以简单地写castToDelayed cancel :: Dynamic -> IO ().注意,函数参数castToDelayed提供了Typeable约束,但是你可以自由地忽略那个约束(这cancel就是做什么).还要注意这个函数必须是部分的,因为它的类型本身(显然不是每个Dynamic都是Delayed a一些a),所以在实际代码中,你应该生成例如Maybe r.在这里,我将忽略这个细节,只是抛出一个错误.

您实际编写此函数的方式取决于您使用的GHC版本(最新版本,8.2版本或某些旧版本).在8.2,这是一个非常好的,简单的功能:

{-# LANGUAGE ViewPatterns #-}
-- NB: probably requires some other extensions

import Data.Dynamic
import Type.Reflection

castToDelayed :: (forall a . Typeable a => Delayed a -> r) -> Dynamic -> r
castToDelayed k (Dynamic (App (eqTypeRep (typeRep :: TypeRep Delayed) -> Just HRefl) a) x)
  = withTypeable a (k x) 
castToDelayed _ _ = error "Not a Delayed"

(旁白:起初我认为Con模式同义词在这里很有用,但是在更深入的检查中它似乎完全无用.你必须使用它eqTypeRep.)

简而言之,此功能的工作原理如下:

• 它对Dynamic值进行模式匹配以获得a存储在其中的实际值(某些存在量化类型),以及其类型(类型TypeRep a)的表示.

• 它模式匹配,TypeRep a以确定它是否是一个应用程序(使用App).显然,Delayed a是一个类型构造函数的应用程序,所以这是我们必须检查的第一件事.

• 它将类型构造函数(第一个参数App)与TypeRep相应的构造函数进行比较Delayed(注意你必须有一个instance Typeable Delayed).如果该比较成功,则它在证明(即Just HRefl)第一个参数App和Delayed实际上是相同类型的模式匹配.

• 此时,编译器知道a ~ Delayed x某些情况x.所以,你可以forall a . Typeable a => Delayed a -> r在值上调用函数x :: a.它还必须提供的证明x是Typeable,这是类型的值精确给出TypeRep x- withTypeable具体化这个值水平证明作为一个类型级约束(或者,你可以有输入功能需要作为参数TypeRep a,或只是省略了约束共,因为您的特定用例不需要它;但这种类型是最普遍的可能).

在旧版本中,原理基本相同.但是,TypeRep没有采用类型参数; 你可以对它进行模式匹配,以发现它是否TypeRep对应Delayed,但是你无法向编译器证明存储在某些Dynamic类型中的值.因此,在将函数应用于值的步骤中,它将需要.此外,在GHC 8.2之前没有,所以你必须用类型来编写函数(幸运的是,这对你的用例来说已经足够了); 或者自己实现这样的功能(参见函数的来源以了解如何;在较旧版本的GHC上的实现将是类似的,但将具有类型).Delayed xxunsafeCoercekxwithTypeable(forall a . Delayed a -> r) -> Dynamic -> rTypeRep -> (forall a . Typeable a => Proxy a -> r) -> r

以下是在GHC <8.2(在8.0.2上测试)中实现这一点的方法.这是一个可怕的黑客,我没有声称它会在任何情况下都正确.

{-# LANGUAGE DeriveDataTypeable, MagicHash, ScopedTypeVariables, PolyKinds, ViewPatterns #-}

import Data.Dynamic
import Data.Typeable
import Unsafe.Coerce
import GHC.Prim (Proxy#)
import Data.Proxy

-- This part reifies a `Typeable' dictionary from a `TypeRep'.
-- This works because `Typeable' is a class with a single field, so 
-- operationally `Typeable a => r' is the same as `(Proxy# a -> TypeRep) -> r'
newtype MagicTypeable r (kp :: KProxy k) =
  MagicTypeable (forall (a :: k) . Typeable a => Proxy a -> r)

withTypeRep :: MagicTypeable r (kp :: KProxy k)
            -> forall a . TypeRep -> Proxy a -> r
withTypeRep d t = unsafeCoerce d ((\_ -> t) :: Proxy# a -> TypeRep)

withTypeable :: forall r . TypeRep -> (forall (a :: k) . Typeable a => Proxy a -> r) -> r
withTypeable t k = withTypeRep (MagicTypeable k) t Proxy

-- The type constructor for Delayed
delayed_tycon = fst $ splitTyConApp $ typeRep (Proxy :: Proxy Delayed)

-- This is needed because Dynamic doesn't export its constructor, and
-- we need to pattern match on it.
data DYNAMIC = Dynamic TypeRep Any

unsafeViewDynamic :: Dynamic -> DYNAMIC
unsafeViewDynamic = unsafeCoerce

-- The actual implementation, much the same as the one on GHC 8.2, but more 
-- 'unsafe' things
castToDelayed :: (forall a . Typeable a => Delayed a -> r) -> Dynamic -> r
castToDelayed k (unsafeViewDynamic -> Dynamic t x) =
  case splitTyConApp t of
    (((== delayed_tycon) -> True), [a]) ->
      withTypeable a $ \(_ :: Proxy (a :: *)) -> k (unsafeCoerce x :: Delayed a)
    _ -> error "Not a Delayed"

我不知道究竟Delayed是什么,但我们假设它的定义如下,用于测试目的:

data Delayed a = Some a | None deriving (Typeable, Show)

然后考虑这个简单的测试用例:

test0 :: Typeable a => Delayed a -> String
test0 (Some x) = maybe "not a String" id $ cast x
test0 None     = "None"

test0' =
  let c = castToDelayed test0 in
   [ c (toDyn (None :: Delayed Int))
   , c (toDyn (Some 'a'))
   , c (toDyn (Some "a")) ]