How to get terms names of GADT in Template Haskell?

Question

If I have GADT like:

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

how to get in Template Haskell names GetResolurcesPkt, MyResourcesPkt? I plan to generate case-s in compile time and similar, so I need MyResourcesPkt to generate code like:

case x of
  MyResourcesPkt rs -> ...

I think about some function like getCons 'ResourcesM 'Ask => GetResourcesPkt (as Name?) or similar. Is it possible at all? Maybe I need to know their arity too, if it's impossible to do {} or {..} in TH.

Answer 1

You can inspect the GADT using reify or a package like th-abstraction that provides more predictable wrappers around reify.

Best practice is probably to use th-abstraction, but for your specific example, the way th-abstraction handles GADTs might make it more difficult, so maybe you want to stick with reify.

I'm not sure how useful a function like getCons will be, but here's how you could implement it.

First, as an important debugging tool, it's helpful to know how to dump the result of reify to the console. Unlike many TH functions, reify can't be run directly in IO (e.g., from the GHCi prompt). Instead, it needs to run in "real" compile-time Template Haskell code in the Q monad, like in the following example:

{-# 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

do pkt <- reify (mkName "Pkt")
   runIO $ print pkt
   pure []

At compile time, this prints the following to the console:

$ 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))] [])

or, reformatted:

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
  [])

So, as a first crack at writing getCons, you might try:

{-# 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'

Then, in a separate module, you can use it on your Pkt type:

{-# 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 []

When compiled, this prints the matched constructor name:

$ 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