使用泛型编程获取一个值中的所有 TypeRep

Get all the TypeRep's in a value using generic programming

有没有一种方法可以使用泛型编程获取值内所有 TypeRep 的列表?

例如,是否可以定义一个函数:

typeReps :: (Data a, Typeable a) => a -> [TypeRep]

以这样的方式:

>>> typeReps (1 :: Int, 'a')
[(Int, Char), Int, Char]

>>> typeReps (Foo ['a', 'b'])
[Foo, [Char], Char, Char]

我试过了

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RankNTypes #-}

module Example where

import Data.Data
import Data.Typeable

typeReps :: (Data a, Typeable a) => a -> TypeReps a
typeReps a = gfoldl step fcstr a
  where
    step :: forall d b. (Typeable d, Data d) =>  TypeReps (d -> b) -> d -> TypeReps b
    step tot d = tot <++> typeReps d

    fcstr :: forall g . g -> TypeReps g
    fcstr g  = TypeReps [typeOf a]

然而,这似乎重复了结果中的 TypeReps 类型:

>>> typeReps ['a']
TypeReps {getTypes = [[Char],Char,[Char]]}

此外,我在上面的 fsctr 函数中没有使用 g 而是 a 看起来有点倒退(我不能,因为我不能约束 gTypeable).

不知道这样能不能解决,如果不能,请问有没有其他办法解决。

正如评论中所建议的那样,您似乎没有考虑到 [1,2,3] 实际上是 1 : 2 : 3 : [](其中 each 尾子项具有类型[Int])。您可以只为列表添加一个特例:

{-# LANGUAGE ViewPatterns #-}

import Data.Data

-- | Returns 'Just' only for lists
--
-- This can surely be done more efficiently, but it does the job.
listTypeReps :: Data a => a -> Maybe [TypeRep]
listTypeReps x

  | typeRepTyCon (typeOf x) == listTyCon
  , toConstr x == toConstr ([] :: [()])   -- empty list
  = Just []

  | typeRepTyCon (typeOf x) == listTyCon
  , toConstr x == toConstr [()]           -- cons
  , [headTs, _] <- gmapQ typeReps x
  , [_, Just tailTs] <- gmapQ listTypeReps x
  = Just (headTs ++ tailTs)

  | otherwise
  = Nothing

listTyCon :: TyCon
listTyCon = typeRepTyCon (typeOf ([] :: [()]))

-- | Get the types of subterms
typeReps :: Data a => a -> [TypeRep]
typeReps x = typeOf x : case listTypeReps x of
                          Just ts -> ts
                          Nothing -> concat (gmapQ typeReps x) 

试试看:

ghci> :set -XDeriveDataTypeable
ghci> data Foo = Foo [Int] (Char,Char) deriving (Data,Typeable)
ghci> typeReps $ Foo [1, 2] ('a', 'b')
[Foo,[Int],Int,Int,(Char,Char),Char,Char]

非常感谢您的帮助!以防万一有人有兴趣使用 Generics 解决此问题,这是我使用此机制找到的解决方案:

class Typeable a => HasTypeReps a where
  typeReps :: a -> [TypeRep]

  default typeReps :: (Generic a, GHasTypeReps (Rep a)) => a -> [TypeRep]
  typeReps a = typeOf a: gTypeReps (from a)

class GHasTypeReps f where
  gTypeReps :: f a -> [TypeRep]

instance GHasTypeReps U1 where
  gTypeReps U1 = []

instance (GHasTypeReps a, GHasTypeReps b) => GHasTypeReps (a :*: b) where
  gTypeReps (a :*: b) = gTypeReps a ++ gTypeReps b

instance (GHasTypeReps a, GHasTypeReps b) => GHasTypeReps (a :+: b) where
  gTypeReps (L1 a) = gTypeReps a
  gTypeReps (R1 b) = gTypeReps b

-- | We do need to do anything for the metadata.
instance (GHasTypeReps a) => GHasTypeReps (M1 i c a) where
    gTypeReps (M1 x) = gTypeReps x

-- | And the only interesting case, get the type of a type constructor
instance (HasTypeReps a) => GHasTypeReps (K1 i a) where
    gTypeReps (K1 x) = typeReps x

instance HasTypeReps a => HasTypeReps [a] where
  typeReps xs = typeOf xs: concatMap typeReps xs

instance (HasTypeReps a, HasTypeReps b) => HasTypeReps (a, b) where
  typeReps t@(a, b) = typeOf t: (typeReps a ++ typeReps b)

instance HasTypeReps Char where
  typeReps x = [typeOf x]

instance HasTypeReps Int where
  typeReps x = [typeOf x]

正如 , and by 中指出的那样,这还需要以特殊方式处理列表,并定义几个其他实例,这会添加一些样板文件。

示例:

>>> typeReps ['a']
[[Char],Char]

>>> :set -XDeriveGeneric
>>> data Foo = Foo [Int] (Char, Char) deriving (Generic)
>>> instance HasTypeReps Foo
>>> typeReps $ Foo [1, 2] ('a', 'b')
[Foo,[Int],Int,Int,(Char,Char),Char,Char]