Question

I have a parser which parses to an ast which contains Text values. I
am trying to use this parser with quasiquoting, but the implementation
of Data for Text is incomplete. I’ve attached a smallish test case, when I try to compile Text.hs I get:

Text.hs:17:9:
Exception when trying to run compile-time code:
Data.Text.Text.toConstr
Code: Language.Haskell.TH.Quote.quoteExp expr ” test “

Is there a way to get this working?

I read through the discussion here: http://www.haskell.org/pipermail/haskell-cafe/2010-January/072379.html

It seems that no-one has found a proper solution to this issue? Also, I tried the Data instance given there and it didn’t work, I have no idea how to fix it (or how to use it since the text package already has a Data instance for Text). I don’t really understand a lot of the generics stuff and how it works.

The only solution I have so far is to give up using Text in the ast and go back to using String.

{-# LANGUAGE DeriveDataTypeable #-}
module Syntax where

import Data.Data
import Data.Text

data Expr = Iden Text
          | Num Integer
          | AntiIden Text
            deriving (Eq,Show,Data,Typeable)


---------------------

module Parser where

import Control.Applicative
import Control.Monad.Identity
import qualified Data.Text as T
import Text.Parsec hiding (many, optional, (<|>), string, label)
import Text.Parsec.Language
import qualified Text.Parsec.Token as P
import Text.Parsec.Text ()

import Syntax

parseExpr :: T.Text -> Either ParseError Expr
parseExpr s =
  runParser expr () "" s

expr :: ParsecT T.Text () Identity Expr
expr =
  whiteSpace >> choice
  [do
   _ <- char '$'
   AntiIden <$> identifier
  ,Num <$> natural
  ,Iden <$> identifier
  ]

identifier :: ParsecT T.Text () Identity T.Text
identifier = T.pack <$> P.identifier lexer

natural :: ParsecT T.Text () Identity Integer
natural = P.natural lexer

lexer :: P.GenTokenParser T.Text () Identity
lexer = P.makeTokenParser langDef

whiteSpace :: ParsecT T.Text () Identity ()
whiteSpace = P.whiteSpace lexer

langDef :: GenLanguageDef T.Text st Identity
langDef = P.LanguageDef
               { P.commentStart   = "{-"
               , P.commentEnd     = "-}"
               , P.commentLine    = "--"
               , P.nestedComments = True
               , P.identStart     = letter <|> char '_'
               , P.identLetter    = alphaNum <|> oneOf "_"
               , P.opStart        = P.opLetter langDef
               , P.opLetter       = oneOf "+-*/<>="
               , P.reservedOpNames= []
               , P.reservedNames  = []
               , P.caseSensitive  = False
               }


-------------------


module Quasi where

import Language.Haskell.TH.Quote
import Language.Haskell.TH
import Data.Generics
import qualified Data.Text as T

import Syntax
import Parser (parseExpr)

expr :: QuasiQuoter
expr = QuasiQuoter {quoteExp = prs
                   ,quotePat = undefined
                   ,quoteType = undefined
                   ,quoteDec = undefined}
  where
    prs :: String -> Q Exp
    prs s = p s
            >>= dataToExpQ (const Nothing
                            `extQ` antiExpE
                           )
    p s = either (fail . show) return (parseExpr $ T.pack s)

antiExpE :: Expr -> Maybe ExpQ
antiExpE v = fmap varE (antiExp v)

antiExp :: Expr -> Maybe Name
antiExp (AntiIden v) = Just $ mkName $ T.unpack v
antiExp _ = Nothing

----------------------------

-- test.hs:

{-# LANGUAGE QuasiQuotes #-}

import Syntax
import Quasi

test,test1,test2 :: Expr

-- works
test = [expr| 1234 |]

-- works
test1 = let stuff = Num 42
        in [expr| $stuff |]

-- doesn't work
test2 = [expr| test |]

main :: IO ()
main = putStrLn $ show test2

Solution: add this function using extQ to the dataToExpQ call:

handleText :: T.Text -> Maybe ExpQ
handleText x =
    -- convert the text to a string literal
    -- and wrap it with T.pack
    Just $ appE (varE 'T.pack) $ litE $ StringL $ T.unpack x

Answer 1

Add an extQ for handleText where handleText explicitly takes Text to an ExpQ, rather than going through generic machinery.

Here’s one for Strings, for example, that renders them more efficiently than as explicit cons cells:

      handleStr :: String -> Maybe (TH.ExpQ)
      handleStr x = Just $ TH.litE $ TH.StringL x