How to circumvent GHC Stage Restriction?

Question

I am writing a code generator whose output depends on datatype fields description which is stored in their class instances. However, I cannot find how to run a function with a TH-generated argument.

{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
module Generator where
import Language.Haskell.TH
import Language.Haskell.TH.Syntax

data Description = Description String [Description] deriving Show

class HasDescription a where
  getDescription :: a -> Description

instance HasDescription Int where
  getDescription _ = Description "Int" []

instance (HasDescription a, HasDescription b) => HasDescription (a, b) where
  getDescription (_ :: (a, b)) = Description "Tuple2" [getDescription (undefined :: a), getDescription (undefined :: b)]

-- | creates instance of HasDescription for the passed datatype changing descriptions of its fields
mkHasDescription :: Name -> Q [Dec]
mkHasDescription dName = do
  reify dName >>= runIO . print
  TyConI (DataD cxt name tyVarBndr [NormalC cName types] derives) <- reify dName
  -- Attempt to get description of data to modify it.
  let mkSubDesc t = let Description desc ds = getDescription (undefined :: $(return t)) in [| Description $(lift $ desc ++ "Modified") $(lift ds) |]

  let body = [| Description $(lift $ nameBase dName) $(listE $ map (mkSubDesc . snd) types) |]
  getDescription' <- funD 'getDescription [clause [wildP] (normalB body) []]
  return [ InstanceD [] (AppT (ConT ''HasDescription) (ConT dName)) [getDescription'] ]

When another module tries to use Generator

{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
import Generator

data MyData = MyData Int Int

mkHasDescription ''MyData

{- the code I want to generate
instance HasDescription MyData where
  getDescription _ = Description "MyData" [Description "IntModified" [], Description "IntModified" []]
-}

there appears an error

Generator.hs:23:85:
GHC stage restriction: `t'
  is used in a top-level splice or annotation,
  and must be imported, not defined locally
In the first argument of `return', namely `t'
In the expression: return t
In an expression type signature: $(return t)

edit:

When asking I thought that the issue appeared just because I just did not grasp something crucial in TH and it could be resolved with moving some functions to the other modules.

If it is impossible to generate precomputed data as in example from the question, I would like to learn more about the theoretical restrictions of TH.

Answer 1

This is indeed an issue with the stage restriction. The problem, as hammar pointed out, lies with the call to getDescription.

let mkSubDesc t = ... getDescription (undefined :: $(return t)) ...

The function getDescription is overloaded, and the compiler chooses the implementation based on the type of its argument.

class HasDescription a where
  getDescription :: a -> Description

Type classes are overloaded based on types. The only way to convert t to a type is to compile it. But compiling it puts the type in the compiled program. The call to getDescription runs at compile time, so it has no access to that type.

If you really want to evaluate getDescription in Template Haskell, you have to write your own implementation of getDescription that reads the Template Haskell data structure that is available at compile time.

getDescription2 :: Type -> Q Description
getDescription2 t = cases con [ ([t| Int |], "Int")
                              , (return (TupleT 2), "Tuple")
                              ]
  where
    (con, ts) = fromApp t
    fromApp (AppT t1 t2) = let (c, ts) = fromApp t1 in (c, ts ++ [t2])
    fromApp t = (t, [])
    cases x ((make_y, name):ys) = do y <- make_y
                                     if x == y
                                       then do ds <- mapM getDescription2 ts
                                               return $ Description name ds
                                       else cases x ys
    cases x [] = error "getDescription: Unrecognized type"

Answer 2

You can fix it by moving the let binding inside the Oxford brackets:

let mkSubDesc t = [| let Description desc ds = getDescription (undefined :: $(return t))
                     in Description (desc ++ "Modified") ds |]

Of course, this means that this will be part of the generated code, but at least for this case, that shouldn't matter.