5

我有一个解析器，它解析为一个包含 Text 值的 ast。我正在尝试将此解析器与 quasiquoting 一起使用，但 Data for Text 的实现不完整。我附上了一个小测试用例，当我尝试编译 Text.hs 时，我得到：

Text.hs:17:9：尝试运行编译时代码时出现异常：Data.Text.Text.toConstr 代码：Language.Haskell.TH.Quote.quoteExp expr "test"

有没有办法让这个工作？

我在这里通读了讨论：http ://www.haskell.org/pipermail/haskell-cafe/2010-January/072379.html

似乎没有人找到解决此问题的适当方法？另外，我尝试了那里给出的 Data 实例，但它没有工作，我不知道如何修复它（或者如何使用它，因为文本包已经有 Text 的 Data 实例）。我不太了解很多泛型的东西以及它是如何工作的。

到目前为止，我唯一的解决方案是放弃在 ast 中使用 Text 并重新使用 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

解决方案：使用 extQ 将此函数添加到 dataToExpQ 调用中：

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
4

1 回答 1

3

添加一个extQfor handleTextwherehandleText明确地将 Text 带到 ExpQ，而不是通过通用机制。

例如，这里有一个字符串，它比显式的 cons 单元更有效地呈现它们：

      handleStr :: String -> Maybe (TH.ExpQ)
      handleStr x = Just $ TH.litE $ TH.StringL x
于 2013-02-01T04:26:01.887 回答