如何为Haskell的EvalATree类型实现Read实例？已写解析器但无法应用

类型定义 #

data EvalATree b a = Leaf a | Node ([b] -> a) [EvalATree b a]

已实现的Show与Foldable实例（a=b时） #

instance (Show a, Show a) => Show (EvalATree a a) where
  show :: (Show a, Show a) => EvalATree a a -> String
  show (Leaf a) = "Leaf " ++ show a
  show (Node g trees) = "Node " ++ show (calcNode (Node g trees)) ++ " " ++ show trees

instance Foldable (EvalATree a) where
  foldr f z (Leaf x) = f x z
  foldr f z (Node func subtrees) = foldr (\subtree acc -> foldr f acc subtree) z subtrees

问题 #

无法实现该类型的Read实例，原因是Node构造器中的函数仅以名称形式存在，需要从字典中获取对应函数；已编写解析器，但不知道如何将其应用到Read实例中：

parseEvalATree :: (Read a, Read a) =>  Parser a -> Parser (EvalATree a a)
parseEvalATree parserA = parseLeaf parserA <|> parseNode intFunctionDict parserA

parseLeaf :: (Read a, Read a) => Parser a -> Parser (EvalATree a a)
parseLeaf parserA = Leaf <$> parserA

parseNode :: (Read a, Read a) => Map String ([a] -> a) -> Parser a -> Parser (EvalATree a a)
parseNode dict parserA = do
  string "Node"
  spaces
  funcName <- many1 letter
  spaces
  subtrees <- between (char '[') (char ']') (parseEvalATree parserA `sepBy` char ',')
  let func = case Map.lookup funcName dict of
        Just f -> f
        Nothing -> error "Function not defined"
  return (Node func subtrees)

解决方案 #

核心矛盾 #

Haskell标准Read类的实例是无上下文的，无法携带额外参数（比如你的函数字典）。因此有两种解决方向：

1. 硬编码字典实现标准Read实例 #

如果函数字典是全局固定的（比如intFunctionDict是常量），可以直接将其嵌入Read实例的解析逻辑中，使用Text.Read模块的工具实现：

import Text.Read
import qualified Data.Map as Map

-- 示例全局函数字典
intFunctionDict :: Map String ([Int] -> Int)
intFunctionDict = Map.fromList [
    ("sum", sum),
    ("product", product)
  ]

instance Read (EvalATree Int Int) where
  readPrec = parens $ 
    -- 解析Leaf
    (prec 10 $ do
      Ident "Leaf" <- lexP
      val <- readPrec
      return $ Leaf val) 
    <++ 
    -- 解析Node
    (prec 10 $ do
      Ident "Node" <- lexP
      Ident funcName <- lexP
      subtrees <- readPrec
      case Map.lookup funcName intFunctionDict of
        Just func -> return $ Node func subtrees
        Nothing -> pfail)

2. 自定义带上下文的读取函数 #

如果需要动态传入不同的函数字典，放弃标准Read实例，基于你已有的解析器封装自定义读取函数：

import Text.Parsec
import qualified Data.Map as Map

-- 自定义解析函数，支持传入函数字典
readEvalATree :: Map String ([a] -> a) -> Parser a -> String -> Either ParseError (EvalATree a a)
readEvalATree dict parser input = parse (parseEvalATree' dict parser <* eof) "" input
  where
    parseEvalATree' d p = parseLeaf p <|> parseNode d p
    parseLeaf p = Leaf <$> p

-- 调用示例（解析Int类型的EvalATree）
readIntEvalATree :: String -> Either ParseError (EvalATree Int Int)
readIntEvalATree = readEvalATree intFunctionDict readParser
  where
    readParser = do
      s <- many1 (noneOf " ,[]")
      case reads s of
        [(x, "")] -> return x
        _ -> fail "无效的Int值"

关键注意事项 #

你当前的Show实例存在格式不兼容问题：Show输出的是calcNode的计算结果（比如Node 3 [Leaf 1, Leaf 2]），但你的解析器期望读取函数名称（比如Node sum [Leaf 1, Leaf 2]）。必须修正Show实例，让它输出函数名称而非计算结果，否则无法正确解析。

最直接的修正方式是修改数据类型，让Node同时存储函数名和函数：

data EvalATree b a = Leaf a | Node String ([b] -> a) [EvalATree b a]

-- 修正后的Show实例
instance (Show a) => Show (EvalATree a a) where
  show (Leaf a) = "Leaf " ++ show a
  show (Node name _ trees) = "Node " ++ show name ++ " " ++ show trees

内容的提问来源于stack exchange，提问作者WmWarescot