如何在Template Haskell中获取GADT的术语名称？

Question

如果我有 GADT，例如：

data Pkt (m::Msg) (d::Dir) where                                                                                        
  GetResourcesPkt :: Pkt 'ResourcesM 'Ask
  MyResourcesPkt :: MyResources -> Pkt 'ResourcesM 'Ans
....

如何进入模板Haskell名称

GetResolurcesPkt

，

MyResourcesPkt

？我计划在编译时生成 case-s 等，所以我需要

MyResourcesPkt

来生成如下代码：

case x of
  MyResourcesPkt rs -> ...

我想到一些类似

getCons 'ResourcesM 'Ask => GetResourcesPkt (as Name?)

或类似的功能。有可能吗？ 也许我也需要知道它们的数量，如果在 TH 中无法做到

{}

或

{..}

。

Answer 1

您可以使用

reify

或像

th-abstraction

这样的包来检查 GADT，它为

reify

提供了更可预测的包装器。

最佳实践可能是使用

th-abstraction

，但对于您的具体示例，

th-abstraction

处理 GADT 的方式可能会使其变得更加困难，所以也许您想坚持使用

reify

。

我不确定像

getCons

这样的函数会有多大用处，但这里是你如何实现它的方法。

首先，作为一个重要的调试工具，了解如何将

reify

的结果转储到控制台会很有帮助。与许多 TH 函数不同，

reify

无法直接在

IO

中运行（例如，从 GHCi 提示符）。相反，它需要在

Q

monad 中的“真实”编译时模板 Haskell 代码中运行，如以下示例所示：

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TemplateHaskell #-}

module Pkt where

import Language.Haskell.TH

data Msg = ResourcesM
data Dir = Ask | Ans
data MyResources

data Pkt (m :: Msg) (d :: Dir) where
   GetResourcesPkt :: Pkt 'ResourcesM 'Ask
   MyResourcesPkt :: MyResources -> Pkt 'ResourcesM 'Ans

reify (mkName "Pkt") >>= runIO . print >> pure []

在编译时，这会将以下内容打印到控制台：

$ ghc Pkt.hs
[1 of 1] Compiling Pkt              ( Pkt.hs, Pkt.o, Pkt.dyn_o )
TyConI (DataD [] Pkt.Pkt [KindedTV m_6989586621679011365 () (ConT Pkt.Msg),
KindedTV d_6989586621679011366 () (ConT Pkt.Dir)] Nothing [GadtC [Pkt.GetResourcesPkt]
[] (AppT (AppT (ConT Pkt.Pkt) (PromotedT Pkt.ResourcesM)) (PromotedT Pkt.Ask)),
GadtC [Pkt.MyResourcesPkt] [(Bang NoSourceUnpackedness NoSourceStrictness,ConT 
Pkt.MyResources)] (AppT (AppT (ConT Pkt.Pkt) (PromotedT Pkt.ResourcesM)) (PromotedT 
Pkt.Ans))] [])

或者，重新格式化：

TyConI (DataD                                     -- data
  []
  Pkt.Pkt                                         --      Pkt
  [ KindedTV m_... () (ConT Pkt.Msg)              --          (m :: Msg)
  , KindedTV d_... () (ConT Pkt.Dir)]             --          (d :: Dir) where
  Nothing
  [ GadtC [Pkt.GetResourcesPkt]                   --   GetResourcePkg ::
          []
          (AppT (AppT
            (ConT Pkt.Pkt)                        --     Pkt
            (PromotedT Pkt.ResourcesM))           --         'ResourcesM
            (PromotedT Pkt.Ask))                  --         'Ask
  , GadtC [Pkt.MyResourcesPkt]                    --   MyResourcesPkt ::
          [( Bang NoSourceUnpackedness
                  NoSourceStrictness
           , ConT Pkt.MyResources)]               --     MyResources ->
          (AppT (AppT
            (ConT Pkt.Pkt)                        --     Pkt
            (PromotedT Pkt.ResourcesM))           --         'ResourcesM
            (PromotedT Pkt.Ans))]                 --         'Ans
  [])

所以，作为第一次写作

getCons

，你可以尝试：

{-# LANGUAGE TemplateHaskell #-}

module GetCons where

import Data.List
import Language.Haskell.TH

getCons :: Q Type -> Q Type -> Q (Maybe Name)
getCons qm qd
  = do m <- qm
       d <- qd
       TyConI (DataD _ _ _ _ cns _) <- reify (mkName "Pkt")
       pure $ consName <$> find (match m d) cns
  where consName (GadtC [n] _ _) = n
        match m d (GadtC _ _ (AppT (AppT (ConT _) m') d')) = m==m' && d==d'

然后，在单独的模块中，您可以在您的

Pkt

类型上使用它：

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TemplateHaskell #-}

module Pkt where

import Data.List
import Language.Haskell.TH
import GetCons

data Msg = ResourcesM
data Dir = Ask | Ans
data MyResources

data Pkt (m :: Msg) (d :: Dir) where
   GetResourcesPkt :: Pkt ResourcesM 'Ask
   MyResourcesPkt :: MyResources -> Pkt 'ResourcesM 'Ans

do c <- getCons [t| 'ResourcesM |] [t| 'Ask |]
   runIO $ print c
   pure []

编译时，会打印匹配的构造函数名称：

$ ghc Pkt
[1 of 2] Compiling GetCons          ( GetCons.hs, GetCons.o, GetCons.dyn_o )
[2 of 2] Compiling Pkt              ( Pkt.hs, Pkt.o, Pkt.dyn_o ) [Source file changed]
Just Pkt.GetResourcesPkt