0

我最近完成了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比我更正确和更深入地了解情况：上述 2 解析结果<input type="submit"/>确实是2 个有效且可构造的值Node将导致 HTML 表示。

我意识到我必须限制Node只允许传入字母 - 不是真的，但让我们保持简单 - 名称（当然也一样Attr）。在比逻辑程序更基础的设置中（例如与纯声明式编程相比，具有更多手写和“指导性”的常规 Haskell），我会简单地将Node构造函数隐藏在例如mkNode哨兵函数后面，但我有这种感觉由于推理引擎或约束求解器的工作方式，在 Curry 中无法正常工作（我可能在这方面错了，实际上我希望是这样）。

所以我最终得到了以下结果。我认为 Curry 元编程（或 Template Haskell，如果 Curry 支持的话）可以用来清理手动样板，但表面处理只是摆脱这种情况的一种方法。

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 规范的函数，当然）来实现与此等效的结果，而不必通过冗长的样板NameChar及其“支持成员”？似乎没有办法在 ADT 中的任何地方放置“功能限制”。

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

4

1 回答 1

1

您可以使用 just 获得相同的结果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 "

编辑：由于您似乎是函数模式的粉丝，您可以为Nodes 和Attrs 定义生成器并在转换函数中使用它们。

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另一方面，条件是所需属性的声明性规范的一个很好的例子。这回答了你的问题了吗？我不确定你的目标是什么。

于 2015-11-09T08:38:46.850 回答