Traversing a Template Haskell AST

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.

Solution

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