Traversing a Template Haskell AST

Question

I have gethered that Haskell code in template-haskell is not represented as a single AST, but rather four cross-referencing types of Pat, Exp, Dec and Type. I have also found no traversal facilities within the library, or anywhere else for that matter.

I was initially looking for a unified representation of the four said types:

-- The single representation for Haskell code
data HCode = HE Exp | HD Dec | HP Pat | HT Type

-- And common functions in tree traversal such as:
children :: HCode -> [HCode]
children (HE (VarE _)) = []
children (HE (AppTypeE e t)) = [HE e, HT t] 
children c = ...

-- Ultimately a transform function similar to:
-- (Not really arguing about this exact model of tree transformation)
preorder :: (HCode -> HCode) -> HCode -> HCode
preorder f h = 
  let h' = f h
   in rebuildWithChildren h' . fmap (preorder f) . children $ h'
     

And now I have grown to believe writing it this way, aside from being time-consuming, is wasteful, since traversing/transforming ASTs is common practice, and I figured it might be best to ask what available solution there is among the practitioners.

Answer 1

Generally, I'm not sure that generic traversal of TH is likely to come up very often. (I'm struggling to imagine a useful transformation of a TH AST in a situation where you wouldn't just generate the TH already transformed that way.) I guess there are some situations where you want to perform queries or transformations of user-supplied quasiquotes without parsing the entire AST?

Anyway, if you can find a use for it, you can use SYB generics. For example, here's a query to extract literals from patterns and expressions from an arbitrary TH "thing":

{-# LANGUAGE TemplateHaskell #-}

import Data.Generics
import Language.Haskell.TH

getLiterals :: Data d => d -> [Lit]
getLiterals = everything (++) (mkQ [] litE `extQ` litP)
  where litE (LitE l) = [l]
        litE _ = []
        litP (LitP l) = [l]
        litP _ = []

main = do mydec <- runQ [d| foo 4 = "hello" |]
          print mydec
          print $ getLiterals mydec
          myexp <- runQ [| '1' + "sixteen" |]
          print myexp
          print $ getLiterals myexp

Here's a transformation that commutes all infix operators in patterns, expressions, and types (example for InfixT not shown):

{-# LANGUAGE TemplateHaskell #-}

import Data.Generics
import Language.Haskell.TH

causeChaos :: Data d => d -> d
causeChaos = everywhere (mkT destroyExpressions `extT` manglePatterns `extT` bludgeonTypes)
  where destroyExpressions (InfixE l x r) = InfixE r x l
        destroyExpressions (UInfixE l x r) = UInfixE r x l
        destroyExpressions e = e
        manglePatterns (InfixP l x r) = InfixP r x l
        manglePatterns (UInfixP l x r) = UInfixP r x l
        manglePatterns e = e
        bludgeonTypes (InfixT l x r) = InfixT r x l
        bludgeonTypes (UInfixT l x r) = UInfixT r x l
        bludgeonTypes e = e

main = do mydec <- runQ [d| append :: [a] -> [a] -> [a]
                            append (x:xs) ys = x : append xs ys
                            append [] ys = ys
                         |]
          print mydec
          print $ causeChaos mydec