如何在 Haskell 中进行类型反射

Posted 2023-03-23

【中文标题】如何在 Haskell 中进行类型反射

【英文标题】：How to have type reflection in Haskell

【发布时间】：2018-05-27 15:09:52

【问题描述】：

我编写了一个简单的 Yesod Rest 服务器，它将实体保存在 JSON 文件中。 实体存储在磁盘上名为 data/type.id.json 的文件中。 例如，retrieveCustomer "1234" 应该从文件 data/Customer.1234.json 加载数据。

我正在使用一个多态函数retrieveEntity，它可以检索任何数据类型的实例，这些数据类型实例化了FromJSON 类型类。 （这部分效果很好）

但目前我必须在类型特定的函数（如retrieveCustomer）中填写硬编码的类型名称。

如何在通用的retrieveEntity 中动态计算类型名称？ 我想我基本上是在寻找迄今为止我没有遇到过的 Haskell 类型的反射机制？

-- | retrieve a Customer by id
retrieveCustomer :: Text -> IO Customer
retrieveCustomer id = do
    retrieveEntity "Customer" id :: IO Customer

-- | load a persistent entity of type t and identified by id from the backend
retrieveEntity :: (FromJSON a) => String -> Text -> IO a
retrieveEntity t id = do
    let jsonFileName = getPath t id ".json"
    parseFromJsonFile jsonFileName :: FromJSON a => IO a

-- | compute path of data file
getPath :: String -> Text -> String -> String
getPath t id ex = "data/" ++ t ++ "." ++ unpack id ++ ex

-- | read from file fileName and then parse the contents as a FromJSON instance.
parseFromJsonFile :: FromJSON a => FilePath -> IO a
parseFromJsonFile fileName = do
    contentBytes <- B.readFile fileName
    case eitherDecode contentBytes of
        Left msg -> fail msg
        Right x  -> return x

【参考方案1】：

我猜标准技巧是使用Typeable，特别是typeOf :: Typeable a => a -> TypeRep。不幸的是，在我们读取文件之前，我们没有a 来调用它，在我们有正确的文件名之前我们不能这样做，直到我们调用@987654325 才能这样做@，在我们读取文件之前我们不能这样做......

...或者我们可以吗？

-# LANGUAGE RecursiveDo #-
import Data.Aeson
import Data.Text
import Data.Typeable
import qualified Data.ByteString.Lazy as B

retrieveEntity :: (FromJSON a, Typeable a) => Text -> IO a
retrieveEntity id = mdo
    let jsonFileName = getPath (typeOf result) id ".json"
    result <- parseFromJsonFile jsonFileName
    return result

getPath :: TypeRep -> Text -> String -> String
getPath tr id ex = "data/" ++ show tr ++ "." ++ unpack id ++ ex

parseFromJsonFile :: FromJSON a => FilePath -> IO a
parseFromJsonFile fileName = do
    contentBytes <- B.readFile fileName
    case eitherDecode contentBytes of
        Left msg -> fail msg
        Right x  -> return x

或者有更少令人费解的选项，例如使用typeRep :: Typeable a => proxy a -> TypeRep。然后我们可以使用ScopedTypeVariables 将适当的类型带入作用域。

-# LANGUAGE ScopedTypeVariables #-
import Data.Aeson
import Data.Text
import Data.Typeable
import qualified Data.ByteString.Lazy as B

-- don't forget the forall, it's a STV requirement
retrieveEntity :: forall a. (FromJSON a, Typeable a) => Text -> IO a
retrieveEntity id = do
    let jsonFileName = getPath (typeRep ([] :: [a])) id ".json"
    result <- parseFromJsonFile jsonFileName
    return result

getPath :: TypeRep -> Text -> String -> String
getPath tr id ex = "data/" ++ show tr ++ "." ++ unpack id ++ ex

parseFromJsonFile :: FromJSON a => FilePath -> IO a
parseFromJsonFile fileName = do
    contentBytes <- B.readFile fileName
    case eitherDecode contentBytes of
        Left msg -> fail msg
        Right x  -> return x

【讨论】：

我不认为把递归解决方案放在首位是个好主意。关键是typeOf 和typeRep 甚至都不关心他们的论点。我认为这个答案应该按顺序提到最现代的方式，即typeRep (Proxy @a)（或[]），稍微不那么现代的方式，即typeRep (Proxy :: Proxy a)，以及唯一使用的情况-兼容性一，即递归定义。在任何情况下，对为什么的解释是最重要的。另外，这似乎是 OP 第一次接触Typeable。解释一下它是如何工作的会很好。

两种解决方案都运行良好。 RecursiveDo 绝对是一些令人费解的思考食物！我在这里创建了一个基于 ScopedTypeVariables 方法的完整示例实现：github.com/thma/EntityRestService