Использование Text.Generic.Diff для генерации вывода, содержащего «вставленные» / «удаленные» маркеры - PullRequest
Новая
       10

Использование Text.Generic.Diff для генерации вывода, содержащего «вставленные» / «удаленные» маркеры

2 голосов
/ 26 марта 2019

Я использую пакет Haskell gdiff для вычисления различий между деревьями. Результатом алгоритма сравнения является «скрипт редактирования», который описывает последовательность операций, которая преобразует дерево «до» в дерево «после». gdiff предоставляет функцию "patch", которая применяет скрипт редактирования к дереву "before", создавая дерево "after".

Что мне нужно сделать, так это изменить эту операцию исправления так, чтобы вывод представлял собой дерево «после», в котором изменения выделены.

В качестве примера представьте, что дерево является документом AST. Я хочу создать вывод, который показывает вставки / удаления, встроенные в документ «после».

Пока что я написал программу, которая успешно использует gdiff для вычисления различий между экземплярами простой структуры данных двоичного дерева. Что я не могу понять, так это как изменить полученный скрипт редактирования так, чтобы он вставлял маркеры «вставлено» и «удалено» при выполнении операции исправления.

Может кто-нибудь помочь?

Различие двух бинарных деревьев

Вот моя двоичная древовидная структура данных: 

data Tree = Node String Tree Tree
          | Empty
          deriving Show

А вот мои примеры деревьев «до» и «после»: 

before :: Tree
before =
  Node "root"
    (Node "A"
      (Empty)
      (Empty)
    )
    (Empty)

after :: Tree
after =
  Node "root"
    (Node "A"
      (Node "B" Empty Empty)
      (Empty)
    )
    (Empty)

Разница выполняется следующим образом: 

runDiff :: EditScript TreeFamily Tree Tree
runDiff = diff before after

main :: IO ()
main = do
  putStrLn ("before     = " ++ (show before))
  putStrLn ("after      = " ++ (show after))

  let edit = runDiff
  putStrLn ("edit       = " ++ (show edit))

  let compressed = compress edit
  putStrLn ("compressed = " ++ (show compressed))

  let result = patch edit before
  putStrLn ("result     = " ++ (show result))

(Я вернусь к определению TreeFamily через мгновение.)

Вывод: 

before     = Node "root" (Node "A" Empty Empty) Empty
after      = Node "root" (Node "A" (Node "B" Empty Empty) Empty) Empty
edit       = Cpy Node $ Cpy "root" $ Cpy Node $ Cpy "A" $ Ins Node $ Ins "B" $ Cpy Empty $ Cpy Empty $ Cpy Empty $ Ins Empty $ End
compressed = Cpy Node $ CpyTree $ Cpy Node $ CpyTree $ Ins Node $ Ins "B" $ CpyTree $ CpyTree $ CpyTree $ Ins Empty $ End
result     = Node "root" (Node "A" (Node "B" Empty Empty) Empty) Empty

Предлагаемая стратегия: обработать скрипт редактирования

Я думаю, что я могу реализовать операцию «генерировать разметку после дерева», обработав скрипт редактирования так, чтобы ... $ Ins Node $ ... был заменен на ... $ Ins InsNode $ ..., где InsNode - другой конструктор Tree: 

data Tree = Node String Tree Tree
          | InsNode String Tree Tree
          | Empty
          deriving Show

(И аналогично для удалений, но этот пост посвящен только вставке.)

Обработанный скрипт редактирования затем будет передан в существующую функцию исправления gdiff.

Определение TreeFamily

Библиотека gdiff требует от пользователя определения "семейного типа данных". Вот мое определение. Обратите внимание, что я включил тип InsNode. Хотя это не отображается во входных данных, я думаю, gdiff должен знать об этом, чтобы выполнить замену от Node до InsNode, описанную выше. 

data TreeFamily :: * -> * -> * where
    Node'       ::           TreeFamily Tree (Cons String (Cons Tree (Cons Tree Nil)))
    InsNode'    ::           TreeFamily Tree (Cons String (Cons Tree (Cons Tree Nil)))
    String'     :: String -> TreeFamily String Nil
    Empty'      ::           TreeFamily Tree Nil


instance Family TreeFamily where
    decEq Node' Node'                  = Just(Refl, Refl)
    decEq InsNode' InsNode'            = Just(Refl, Refl)
    decEq (String' s1) (String' s2)
                | s1 == s2             = Just (Refl, Refl)
                | otherwise            = Nothing
    decEq Empty' Empty'                = Just(Refl, Refl)
    decEq _ _                          = Nothing

    fields Node' (Node s t1 t2)        = Just (CCons s (CCons t1 (CCons t2 CNil)))
    fields InsNode' (InsNode s t1 t2)  = Just (CCons s (CCons t1 (CCons t2 CNil)))
    fields (String' _) _               = Just CNil
    fields Empty' Empty                = Just CNil
    fields _ _                         = Nothing

    apply Node' (CCons s (CCons t1 (CCons t2 CNil)))    = Node s t1 t2
    apply InsNode' (CCons s (CCons t1 (CCons t2 CNil))) = InsNode s t1 t2
    apply (String' s) CNil                              = s
    apply Empty' CNil                                   = Empty

    string Node'       = "Node"
    string InsNode'    = "InsNode"
    string (String' s) = show s
    string Empty'      = "Empty"


instance Type TreeFamily Tree where
    constructors = [ Concr Node', Concr InsNode', Concr Empty' ]

instance Type TreeFamily String where
    constructors = [ Abstr String' ]

Первая попытка использования функции processEdit

Функция, которая обрабатывает EditScript для выполнения замены от Node до InsNode, должна иметь ту же сигнатуру, что и функция compress, а именно: 

processEdit :: (Family f) => EditScriptL f txs tys -> EditScriptL f txs tys

Я могу написать следующие уравнения тождества ... 

processEdit End         = End
processEdit (Ins  c  d) = Ins  c   (processEdit d)
processEdit (Del  c  d) = Del  c   (processEdit d)
processEdit (CpyTree d) = CpyTree  (processEdit d)
processEdit (Cpy  c  d) = Cpy  c   (processEdit d)

... но я не знаю, как изменить уравнение Ins для выполнения подстановки. Кто-нибудь может помочь?

Полная программа испытаний для справки 

{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude     #-}


module Main where

import Prelude
import Data.Generic.Diff


-- Data types --

data Tree = Node String Tree Tree
          | InsNode String Tree Tree
          | Empty
          deriving Show


-- GADT Family --

data TreeFamily :: * -> * -> * where
    Node'       ::           TreeFamily Tree (Cons String (Cons Tree (Cons Tree Nil)))
    InsNode'    ::           TreeFamily Tree (Cons String (Cons Tree (Cons Tree Nil)))
    String'     :: String -> TreeFamily String Nil
    Empty'      ::           TreeFamily Tree Nil


instance Family TreeFamily where
    decEq Node' Node'                  = Just(Refl, Refl)
    decEq InsNode' InsNode'            = Just(Refl, Refl)
    decEq (String' s1) (String' s2)
                | s1 == s2             = Just (Refl, Refl)
                | otherwise            = Nothing
    decEq Empty' Empty'                = Just(Refl, Refl)
    decEq _ _                          = Nothing

    fields Node' (Node s t1 t2)        = Just (CCons s (CCons t1 (CCons t2 CNil)))
    fields InsNode' (InsNode s t1 t2)  = Just (CCons s (CCons t1 (CCons t2 CNil)))
    fields (String' _) _               = Just CNil
    fields Empty' Empty                = Just CNil
    fields _ _                         = Nothing

    apply Node' (CCons s (CCons t1 (CCons t2 CNil)))    = Node s t1 t2
    apply InsNode' (CCons s (CCons t1 (CCons t2 CNil))) = InsNode s t1 t2
    apply (String' s) CNil                              = s
    apply Empty' CNil                                   = Empty

    string Node'       = "Node"
    string InsNode'    = "InsNode"
    string (String' s) = show s
    string Empty'      = "Empty"


instance Type TreeFamily Tree where
    constructors = [ Concr Node', Concr InsNode', Concr Empty' ]

instance Type TreeFamily String where
    constructors = [ Abstr String' ]


-- Input trees --

before :: Tree
before =
  Node "root"
    (Node "A"
      (Empty)
      (Empty)
    )
    (Empty)

after :: Tree
after =
  Node "root"
    (Node "A"
      (Node "B" Empty Empty)
      (Empty)
    )
    (Empty)


{-
Function for modifying the edit script

The objective is to transform edit script fragments of the form
    ... $ Ins Node $ ...
to
    ... $ Ins InsNode $ ...
-}

processEdit :: (Family f) => EditScriptL f txs tys -> EditScriptL f txs tys
processEdit End         = End
processEdit (Ins  c  d) = Ins  c   (processEdit d)
processEdit (Del  c  d) = Del  c   (processEdit d)
processEdit (CpyTree d) = CpyTree  (processEdit d)
processEdit (Cpy  c  d) = Cpy  c   (processEdit d)


-- Test --

-- For some reason, this signature is required for type inference to work --
runDiff :: EditScript TreeFamily Tree Tree
runDiff = diff before after

main :: IO ()
main = do
  putStrLn ("before     = " ++ (show before))
  putStrLn ("after      = " ++ (show after))

  let edit = runDiff
  putStrLn ("edit       = " ++ (show edit))

  let compressed = compress edit
  putStrLn ("compressed = " ++ (show compressed))

  let processed = processEdit compressed
  putStrLn ("processed  = " ++ (show processed))

  let result = patch edit before
  putStrLn ("result     = " ++ (show result))

1 Ответ

0 голосов
/ 26 марта 2019

Просто укажите processEdit, чтобы он был на TreeFamily (потому что очевидно, что вы пытаетесь выполнить, относится только к TreeFamily) и сопоставьте шаблон (первый) аргумент с Ins.

* 1006.*

Однако мне не нравится этот подход.Требуется изменить исходный тип данных, и вы потеряете различие в уровне типов между «исходным» деревом и «пропатченным» деревом.Лучшим решением было бы создать другой тип данных (например, ChangedTree) и переопределить patch' :: EditScriptL TreeFamily Tree Tree -> Tree -> ChangedTree.Если вы отслеживаете как вставки, так и удаления, может вам понадобится также изменение типа «замена»?

О, а runDiff нужна подпись типа, потому что в противном случае он не знает, что такое Type _ Tree экземпляр для использования.например.diff @TreeFamily before after (Расширение TypeApplications) исправит это.Классы типов в Haskell открыты, поэтому он не будет автоматически выводить, что вы хотите instance Type TreeFamily Tree, а не какой-то другой instance Type XXX Tree, просто потому, что он не может видеть другие подходящие XXX в области действия прямо сейчас, не означает, что он будетдумаю, это то, что вы намеревались использовать.

...