Question

我最近跟着A Taste of Curry，然后决定通过编写一个更实质的解析器来测试这个简单的算术解析器示例：一个原始但正确且功能强大的HTML解析器。

我最终使用node2string函数对Node（带属性和子项）进行操作，然后我inverse获取parse函数，在文章中举例说明。

第一个天真的实现有错误，它解析了任何东西，例如简单的<input/> HTML代码段只有一个Node表示形式;其他一切都不确定地产生了无效的东西，比如

Node { name = "input", attrs = [Attr "type" "submit"] }
Node { name = "input type=\"submit\"", attrs = [] }

等等。

经过一些初步尝试从node2string内解决这个问题之后，我意识到这一点，我相信所有经验丰富的逻辑程序员都会立刻看到，parse = inverse node2string对于这种情况更为正确和富有洞察力。我是：<input type="submit"/>的上述2个解析结果确实是导致HTML表示的Node的2个有效且可构造的值。

我意识到我必须约束Node只允许以字母顺序传递 - 不是真的，而是让它保持简单 - 名称（当然对于Attr也是如此）。在一个不那么基本的设置而不是逻辑程序（比如常规Haskell有更多的手写和＆＃34;指令＆＃34;而不是纯粹的声明性编程），我只是隐藏了Node构造函数，例如一个mkNode哨兵函数，但我觉得由于推理引擎或约束求解器的工作原理，这在Curry中效果不佳（我可能在这方面做错了，事实上我希望我是这样）

所以我最终得到了以下内容。我认为Curry元编程（或模板Haskell，如果Curry支持它）可用于清理手动boielrplate，但美化处理只是摆脱这种情况的一种方式。

data Name = Name [NameChar] -- newtype crashes the compiler
data NameChar = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z

name2char :: NameChar -> Char
name2char c = case c of A -> 'a'; B -> 'b'; C -> 'c'; D -> 'd'; E -> 'e'; F -> 'f'; G -> 'g'; H -> 'h'; I -> 'i'; J -> 'j'; K -> 'k'; L -> 'l'; M -> 'm'; N -> 'n'; O -> 'o'; P -> 'p'; Q -> 'q'; R -> 'r'; S -> 's'; T -> 't'; U -> 'u'; V -> 'v'; W -> 'w'; X -> 'x'; Y -> 'y'; Z -> 'z'

name2string :: Name -> String
name2string (Name s) = map name2char s

-- for "string literal" support
nameFromString :: String -> Name
nameFromString = inverse name2string

data Node = Node { nodeName :: Name, attrs :: [Attr], children :: [Node] }
data Attr = Attr { attrName :: Name, value :: String }

attr2string :: Attr -> String
attr2string (Attr name value) = name2string name ++ "=\"" ++ escape value ++ "\""
  where escape = concatMap (\c -> if c == '"' then "\\\"" else [c])

node2string :: Node -> String
node2string (Node name attrs children) | null children = "<" ++ name' ++ attrs' ++ "/>"
                                       | otherwise     = "<" ++ name' ++ attrs' ++ ">" ++ children' ++ "</" ++ name' ++ ">"
  where name'     = name2string name
        attrs'    = (concatMap ((" " ++) . attr2string) attrs)
        children' = intercalate "" $ map (node2string) children

inverse :: (a -> b) -> (b -> a)
inverse f y | f x =:= y = x where x free

parse :: String -> Node
parse = inverse node2string

事实上，这完全符合我的判断：

Parser> parse "<input type=\"submit\"/>"
(Node [I,N,P,U,T] [(Attr [T,Y,P,E] "submit")] [])

Parser> parse "<input type=\"submit\" name=\"btn1\"/>"
(Node [I,N,P,U,T] [(Attr [T,Y,P,E] "submit"),(Attr [N,A,M,E] "btn1")] [])

（Curry没有类型类，所以我还不知道如何让[NameChar]打印得更好）

但是，我的问题是：

有没有办法使用像isAlpha这样的东西（或者当然是更符合实际HTML规范的函数）来实现与此相当的结果，而不必经过{{{{ 1}}及其支持成员＆＃34;是？似乎没有办法放置＆＃34;功能限制＆＃34; ADT内的任何地方。

在依赖类型的函数逻辑编程语言中，我只是在类型级别表达约束并让推理引擎或约束求解器处理它，但在这里我似乎不知所措。

Answer 1

只使用Char即可获得相同的结果。正如您已经指出的那样，您可以使用isAlpha将name2char定义为部分身份。我更改了以下代码行。

type NameChar = Char

name2char :: NameChar -> Char
name2char c | isAlpha c = c

然后，两个示例性表达式评估如下。

test> parse "<input type=\"submit\" name=\"btn1\"/>"
(Node (Name "input") [(Attr (Name "type") "submit"),(Attr (Name "name") "btn1")] [])

test> parse "<input type=\"submit\"/>"
(Node (Name "input") [(Attr (Name "type") "submit")] [])

作为副作用，带有非字母字符的名称会以nameFromString静默失败。

test> nameFromString "input "

编辑：由于您似乎是功能模式的粉丝，因此您可以为Node和Attr定义生成器，并在转换函数中使用它们。< / p>

attr :: Name -> String -> Attr
attr name val
  | name `elem` ["type", "src", "alt", "name"] = Attr name val

node :: String -> [Attr] -> [Node] -> Node
node name [] nodes
  |  name `elem` ["a", "p"] = Node name [] nodes
node name attrPairs@(_:_) nodes
  |  name `elem` ["img", "input"] = Node name attrPairs nodes

node2string :: Node -> String
node2string (node name attrs children)
  | null children = "<" ++ name ++ attrs' ++ "/>"
  | otherwise     = "<" ++ name ++ attrs' ++ ">"
                  ++ children' ++ "</" ++ name' ++ ">"
 where
  name'     = name
  attrs'    = concatMap ((" " ++) . attr2string) attrs
  children' = intercalate "" $ map (node2string) children

attr2string :: Attr -> String
attr2string (attr name val) = name ++ "=\"" ++ escape val ++ "\""
 where
  escape = concatMap (\c -> if c == '"' then "\\\"" else [c])

这种方法有其缺点;它适用于一组特定的有效名称，但在使用像之前一样的谓词时会失败（例如all isAlpha name）。

<强> EDIT2：除了具有isAlpha条件的解决方案比您的详细解决方案“更漂亮”这一事实之外，它还以声明方式定义。如果没有您的评论，您很难（很容易地）使用NameChar数据类型编码字母字符。另一方面，isAlpha条件是所需属性的声明性规范的一个很好的例子。这回答了你的问题了吗？我不确定你的目标是什么。

用`inverse`生成一个解析器，对语法有约束

1 个答案: