Type declarations in Template Haskell

Question

Consider the following type (in Haskell):

data CType = CInt | CDouble | CProduct String [(String, CType)]

I would like to have a function that would generate corresponding Haskell type declarations. Constructors CInt and CDouble should correspond to Int and Double types thus result in no declaration. (CProduct t ts) should correspond to the record type with name and constructor defined by t and fields defined by ts list. For example:

ty :: CType
ty = CProduct "Type1" [("proj10", CDouble), ("proj11", CProduct "Type0" [("proj0", CInt)])]

should result in two definitions:

data Type0 = Type0 {proj0 :: Int}
data Type1 = Type1 {proj10 :: Double, proj11 :: Type0} 

To define this function I use Template Haskell:

genType :: CType -> Q Type
genType CInt = return (ConT ''Int)
genType CDouble = return (ConT ''Double)
genType (CProduct s t) =
    do
      l <- lookupTypeName s
      case l of
        Just sn -> return (ConT sn)
        Nothing ->
            do
              sn <- newName s
              return (ConT sn)

genField :: (String, CType) -> Q VarStrictType
genField (s , t) =
    do
      sn <- newName s
      tn <- genType t
      return (sn, NotStrict, tn)

genDecl :: CType -> Q [Dec]
genDecl CInt = return []
genDecl CDouble = return []
genDecl (CProduct s t) =
    do
      ts <- fmap join . mapM (genDecl . snd) $ t
      res <- lookupTypeName s
      case res of
        Just _ -> return ts
        Nothing ->
            do
              sn <- newName s
              sc <- newName s      
              fn <- mapM genField $ t
              let
                  dt = DataD [] sn [] [RecC sc fn] []
              return (dt : ts)

When I invoke the function with $(genDecl ty) for ty :: CType defined above I get following error:

The exact Name ‘Type0_adN6’ is not in scope …
      Probable cause: you used a unique Template Haskell name (NameU), 
      perhaps via newName, but did not bind it

But when I generate definitions one by one everything is fine:

$(fmap (\[x, y] -> [y]) . genDecl $ ty)

$(genDecl $ ty)

So the question is: how to properly add type declarations in Q monad to generate them all at once?

Answer 1

Following version seems to work as intended:

genType :: [(String, Name)] -> CType -> Q Type
genType db CInt = return (ConT ''Int)
genType db CDouble = return (ConT ''Double)
genType db (CProduct s t) =
    do
      let 
          res = lookup s db
      case res of
        Nothing -> return (TupleT 0)
        Just n -> return (ConT n)

genField :: [(String, Name)] -> (String, CType) -> Q VarStrictType
genField db (s , t) =
    do
      sn <- newName s
      tn <- genType db t
      return (sn, NotStrict, tn)

todb = map (\(x, _) -> (nameBase x, x))
crit (x, _) (y, _) = nameBase x == nameBase y 

genDecl :: CType -> Q [(Name, Dec)]
genDecl CInt = return []
genDecl CDouble = return []
genDecl (CProduct s t) =
    do
      ts <- fmap (nubBy crit . join) . mapM (genDecl . snd) $ t
      res0 <- lookupTypeName s
      let
          db = todb ts
          res1 = lookup s db       
      case (res0 , res1) of
        (Just _ , Just _) -> return ts
        (Just _ , Nothing) -> return ts
        (Nothing , Just _) -> return ts
        (Nothing , Nothing) ->
            do
              sn <- newName s
              sc <- newName s
              fs <- mapM (genField db) $ t
              let
                  dt = DataD [] sn [] [RecC sc fs] []
              return ((sn, dt) : ts)           

Answer 2

Here's my assessment of what's happening...

Consider this simplified example which also fails:

ty :: CType
ty = CProduct "Type1" [  ("proj11", CProduct "Type0" [("proj0", CInt)]) ]

1. genType is called with CProduct "Type1" ...
2. The declarations for the fields of Type1 are generated (into ts
3. ts contains the definition of Type0. This declaration works.
4. Then lookupTypName "Type1" is called and this returns Nothing
5. So a new DataD is created with field definitions from fn
6. But the field definitions don't refer to the declarations created in step 2.

Somehow when genField is called for "proj11" you have to use the declarations returned in ts to create the field.

Update

Here is the inline version of what you need to do:

blah :: Q [Dec]
blah = do
  let ty_int = ConT ''Int
  t0_cname <- newName "Type0"
  proj0_name <-  newName "proj0"
  let t0_rec = RecC t0_cname [ (proj0_name, NotStrict, ty_int) ]
  t0_tname <- newName "Type0"
  let t0_decl = DataD [] t0_tname [] [t0_rec] []

  proj11_name <- newName "proj11"
  t1_cname <- newName "Type1"
  let t1_rec = RecC t1_cname [ (proj11_name, NotStrict, ConT t0_tname) ]
  t1_tname <- newName "Type1"
  let t1_decl = DataD [] t1_tname [] [t1_rec] []

  return [t0_decl, t1_decl]

If you expand $(blah) it should work and in ghci you'll see:

*Main> :i Type0
data Type0 = Type0 {proj0 :: Int}   -- Defined at ...
*Main> :i Type1
data Type1 = Type1 {proj11 :: Type0}    -- Defined at ...

The key is in the t1_rec assignment. For the type of the field you have to use the same name (t0_name) that was used in the DataD constructor for Type0.