将 TypeRep 转化为具体的类型表示

Question

我想写如下函数：

data TypeEnum = IntType | FloatType | BoolType | DateType | StringType
data Schema = Object [Schema] |
              Field TypeEnum |
              Array Schema

schema :: Typeable a => a -> Schema

现在我可以获得给定构造函数的TypeReps 列表，但我似乎找不到将TypeRep 转换为Schema 以获得更复杂类型的方法：

field :: TypeRep t => t -> Schema
field t | t == typeOf (undefined :: String) = Field StringType
        | t == typeOf (undefined :: Int) = Field IntType
        | t == typeOf (undefined :: ???) = Array ???
        | t == typeOf (undefined :: ???) = Object ???

它适用于Int 和String 等简单类型，但Typeable 或[Typeable] 呢？

Answer 1

您可以使用typeOf1 获取单参数类型构造函数的类型：

> typeOf (undefined :: Array Int Int)
Array Int Int
> typeOf1 (undefined :: Array Int Int)
Array Int
> typeOf2 (undefined :: Array Int Int)
Array
> typeOf2 (undefined :: Array a b)
Array

编辑：对不起，我误解了这个问题。这里有一些更有用的建议...您可以使用splitTyConApp 和朋友将TypeRep 拆分为其组成部分：

> splitTyConApp (typeOf (undefined :: Array Int Int))
(Array,[Int,Int])
> let arr = typeRepTyCon (typeOf (undefined :: Array Int Int))
> mkTyConApp arr [] == typeOf2 (undefined :: Array a b)
True

Answer 2

如果您有一组封闭的类型是您的程序唯一需要推理的类型，您可以考虑回避Data.Typeable，只需使用 GADT 滚动您自己的类型表示，如下所示。这与标准Typeable 的区别如下：

• 来自Data.Typeable 的TypeReps 没有代表它们所代表的类型的类型变量，而在下面的替代方案中，您会得到TypeRep a，其中a 是您的TypeRep 所代表的类型（例如, typeOf "foo" :: TypeRep [Char])。
• 但是，下面显示的 GADT 方法仅适用于在编译时固定的一组类型，因为您的 homebrewTypeRep 定义需要列出所有可表示的类型和类型构造函数。

我为什么建议走这条复杂的路线？因为您可以使用这种技术来消除field 定义中的模式保护序列：

data Schema a = ...
              | Field (TypeRep a) -- my TypeRep from below, not the standard one!
              | ...

field :: TypeRep a -> Schema a
field t = Field typeRep

这里的缺点是 GADT TypeReps 有一个类型参数，它需要一些其他方法来处理 Object :: [Schema] -> Schema 构造函数的情况，因为这会将 [Schema] 替换为 [Schema a]。也许你可以尝试这样的事情：

{-# LANGUAGE GADTs #-}
data Schema a where 
    Field   :: TypeRep a -> Schema a
    Array   :: Schema a -> Schema (Array a)
    Object2 :: Schema a -> Schema b -> Schema (a, b)
    Object3 :: Schema a -> Schema b -> Schema c -> Schema (a, b, c)
    ...

但我认为，如果您研究下面的代码，您可能会发现一些想法，您可以将这些想法融入到您正在做的事情中——您的 TypeEnum 类型类似于我下面的 TypeRep 类型，除了我的能够表示除原子类型之外的类型构造函数。

下面是代码（应该很容易根据您选择的类型进行修改）：

{-# LANGUAGE GADTs #-}

import Control.Applicative

----------------------------------------------------------------
----------------------------------------------------------------
--
-- | Type representations.  If @x :: TypeRep a@, then @x@ is a singleton
-- value that stands in for type @a@.
data TypeRep a where 
    Integer :: TypeRep Integer
    Char    :: TypeRep Char
    Maybe   :: TypeRep a -> TypeRep (Maybe a)
    List    :: TypeRep a -> TypeRep [a]
    Pair    :: TypeRep a -> TypeRep b -> TypeRep (a, b)

-- | Typeclass for types that have a TypeRep
class Representable a where
    typeRep :: TypeRep a

instance Representable Integer where typeRep = Integer
instance Representable Char where typeRep = Char

instance Representable a => Representable (Maybe a) where 
    typeRep = Maybe typeRep

instance Representable a => Representable [a] where 
    typeRep = List typeRep

instance (Representable a, Representable b) => Representable (a,b) where 
    typeRep = Pair typeRep typeRep


typeOf :: Representable a => a -> TypeRep a
typeOf = const typeRep


----------------------------------------------------------------
----------------------------------------------------------------
--
-- | Type equality proofs.
data Equal a b where
    Reflexivity :: Equal a a


-- | Induction rules for type equality proofs for parametric types
induction :: Equal a b -> Equal (f a) (f b)
induction Reflexivity = Reflexivity

induction2 :: Equal a a' -> Equal b b' -> Equal (f a b) (f a' b')
induction2 Reflexivity Reflexivity = Reflexivity

-- | Given two TypeReps, prove or disprove their equality.
matchTypes :: TypeRep a -> TypeRep b -> Maybe (Equal a b)
matchTypes Integer Integer = Just Reflexivity
matchTypes Char Char = Just Reflexivity
matchTypes (List a) (List b) = induction <$> (matchTypes a b)
matchTypes (Maybe a) (Maybe b) = induction <$> (matchTypes a b)
matchTypes (Pair a b) (Pair a' b') = 
    induction2 <$> matchTypes a a' <*> matchTypes b b'
matchTypes _ _ = Nothing


----------------------------------------------------------------
----------------------------------------------------------------
--
-- Example use: type-safe coercions and casts
--

-- | Given a proof that a and b are the same type, you can
-- actually have an a -> b function.
coerce :: Equal a b -> a -> b
coerce Reflexivity x = x

cast :: TypeRep a -> TypeRep b -> a -> Maybe b
cast a b x = coerce <$> (matchTypes a b) <*> pure x


----------------------------------------------------------------
----------------------------------------------------------------
--
-- Example use: dynamic data
--

data Dynamic where
    Dyn :: TypeRep a -> a -> Dynamic

-- | Inject a value of a @Representable@ type into @Dynamic@.
toDynamic :: Representable a => a -> Dynamic
toDynamic = Dyn typeRep

-- | Cast a @Dynamic@ into a @Representable@ type.
fromDynamic :: Representable a => Dynamic -> Maybe a
fromDynamic = fromDynamic' typeRep

fromDynamic' :: TypeRep a -> Dynamic -> Maybe a
fromDynamic' :: TypeRep a -> Dynamic -> Maybe a
fromDynamic' target (Dyn source value) = cast source target value

---

编辑：我忍不住多玩了一些：

{-# LANGUAGE StandaloneDeriving #-}
import Data.List (intercalate)

--
-- And now, I believe this is very close to what you want...
--
data Schema where
    Field :: TypeRep a -> Schema
    Object :: [Schema] -> Schema
    Array :: Schema -> Schema

deriving instance Show (TypeRep a)
deriving instance Show (Schema)

example :: Schema
example = Object [Field (List Char), Field Integer]

describeSchema :: Schema -> String
describeSchema (Field t) = "Field of type " ++ show t
describeSchema (Array s) = "Array of type " ++ show s
describeSchema (Object schemata) = 
    "an Object with these schemas: " 
        ++ intercalate ", " (map describeSchema schemata)

这样，describeSchema example 产生 "an Object with these schemas: Field of type List Char, Field of type Integer"。