Echologie
Echologie

Reputation: 83

Generate a data declaration with TemplateHaskell

I wonder how to generate a bunch of constants based on a list of names.

I started with this working example:

ConstantCreation.hs

module ConstantCreation where

import Language.Haskell.TH

createConstant :: String -> Q [Dec]
createConstant constantName = do constantType   <- newName constantName
                                 constant       <- newName constantName
                                 return [ DataD []
                                          constantType []
                                          [NormalC constant []]
                                          []                       ]

MyConstants.hs

{-# LANGUAGE TemplateHaskell #-}

module MyConstants where

import ConstantCreation

$(do constantsDeclarations <- mapM createConstant
                                       [ "MyFirstCustomConstant"  ,
                                         "MySecondCustomConstant"   ]
     return $ mconcat constantsDeclarations)

But things get tricky when I try to add a deriving Show.

I first tried changing the function createConstant like this:

createConstant constantName = do constantType   <- newName constantName
                                 constant       <- newName constantName
                                 return [ DataD []
                                          constantType []
                                          [NormalC constant []]
                                          [GHC.Show.Show]          ]

as suggested if I run the command runQ [d|data MyConstant = MyConstant deriving Show|] in GHCi, but it throws the error Not in scope: data constructor ‘GHC.Show.Show’

So I tried do define my function like this :

createConstant constantName = [d|data $(ConT $ newName constantName) = $(NormalC (newName constantName) []) deriving Show|]

but then I had the following error:

Cannot parse data constructor in a data/newtype declaration: $(NormalC
                                                                 (newName constantName) [])

It would really be a pitty to have to define Show instances by hand, so I wonder what's going badly.

Thanks for any advice or explanation.

Upvotes: 2

Views: 400

Answers (1)

pat
pat

Reputation: 12749

You can use ''Show to get the Type with the name that is in scope.

{-# LANGUAGE TemplateHaskell #-}

module Constant where

import Language.Haskell.TH

createConstant constantName = do
    tname <- newName constantName
    cname <- newName constantName
    return [DataD [] tname [] [NormalC cname []] [''Show]]

Upvotes: 1

Related Questions