Генерация парсера с помощью `inverse` с ограничениями по грамматике

Question

Недавно я изучил A Taste of Curry и впоследствии решил протестировать пример простого арифметического синтаксического анализатора, написав несколько более содержательный анализатор: примитивный, но правильный и функциональный анализатор HTML.

Я закончил с работой node2string функция для работы на Node (с атрибутами и детьми), которые я тогда inversed, чтобы получить 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 (или 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")] [])

(У карри нет классов типов, поэтому я пока не знаю, как сделать [NameChar] печатай приятнее)

Тем не менее, мой вопрос:

есть ли способ использовать что-то вроде isAlpha (или, конечно, функция, более верная фактической спецификации HTML) для достижения результата, эквивалентного этому, без необходимости проходить через подробный шаблон, который NameChar а его "поддерживающие члены" есть? Кажется, нет никакого способа даже поместить "функциональное ограничение" где-либо в 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и использовать их в вашей функции преобразования.

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 условие, с другой стороны, является хорошим примером для декларативной спецификации требуемого свойства. Отвечает ли это на ваш вопрос? Я не уверен, к чему ты клонишь.