¿Cómo eludir la restricción de la etapa de GHC?

Question

Estoy escribiendo un generador de código cuya salida depende de la descripción de los campos de tipo de datos que se almacena en sus instancias de clase. Sin embargo, no puedo encontrar cómo ejecutar una función con un argumento generado por TH.

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

Cuando otro módulo intenta utilizar Generador

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

aparece un 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) 

edición:

Al preguntar pensé que el tema apareció simplemente porque acabo no entendió algo crucial en TH y podría resolverse moviendo algunas funciones al otros módulos.

Si es imposible generar datos precalculados como en el ejemplo de la pregunta, me gustaría obtener más información acerca de las restricciones teóricas de TH.

Answer 1

Esto es de hecho un problema con la restricción de etapa. El problema, como señaló Hammar, se encuentra en la llamada al getDescription.

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

La función getDescription está sobrecargado, y el compilador elige la aplicación en función del tipo de su argumento.

class HasDescription a where 
    getDescription :: a -> Description 

Las clases de tipos están sobrecargadas según los tipos. La única forma de convertir t en un tipo es compilarlo. Pero compilarlo coloca el tipo en el programa compilado. La llamada a getDescription ejecuta en tiempo de compilación, por lo que no tiene acceso a ese tipo.

Si realmente desea evaluar getDescription en la Plantilla Haskell, tiene que escribir su propia implementación de getDescription que lea la estructura de datos de la Plantilla Haskell que está disponible en tiempo de compilación.

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

Puede solucionarlo moviendo el let vinculante dentro de los corchetes Oxford:

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

Por supuesto, esto significa que esto será parte del código generado, pero al menos para este caso, que shouldn' t importa