{-# LANGUAGE CPP #-}
module Test.StateMachine.TreeDiff.Tree (treeDiff, EditTree (..), Edit (..)) where
import Data.Tree
(Tree(..))
import Test.StateMachine.TreeDiff.List
#ifdef __DOCTEST__
import qualified Text.PrettyPrint as PP
#endif
treeDiff :: Eq a => Tree a -> Tree a -> Edit (EditTree a)
treeDiff :: forall a. Eq a => Tree a -> Tree a -> Edit (EditTree a)
treeDiff ta :: Tree a
ta@(Node a
a [Tree a]
as) tb :: Tree a
tb@(Node a
b [Tree a]
bs)
| a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b = EditTree a -> Edit (EditTree a)
forall a. a -> Edit a
Cpy (EditTree a -> Edit (EditTree a))
-> EditTree a -> Edit (EditTree a)
forall a b. (a -> b) -> a -> b
$ a -> [Edit (EditTree a)] -> EditTree a
forall a. a -> [Edit (EditTree a)] -> EditTree a
EditNode a
a ((Edit (Tree a) -> Edit (EditTree a))
-> [Edit (Tree a)] -> [Edit (EditTree a)]
forall a b. (a -> b) -> [a] -> [b]
map Edit (Tree a) -> Edit (EditTree a)
forall {a}. Eq a => Edit (Tree a) -> Edit (EditTree a)
rec ((Tree a -> Tree a -> Bool)
-> [Tree a] -> [Tree a] -> [Edit (Tree a)]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [Edit a]
diffBy Tree a -> Tree a -> Bool
forall a. Eq a => a -> a -> Bool
(==) [Tree a]
as [Tree a]
bs))
| Bool
otherwise = EditTree a -> EditTree a -> Edit (EditTree a)
forall a. a -> a -> Edit a
Swp (Tree a -> EditTree a
forall a. Tree a -> EditTree a
treeToEdit Tree a
ta) (Tree a -> EditTree a
forall a. Tree a -> EditTree a
treeToEdit Tree a
tb)
where
rec :: Edit (Tree a) -> Edit (EditTree a)
rec (Ins Tree a
x) = EditTree a -> Edit (EditTree a)
forall a. a -> Edit a
Ins (Tree a -> EditTree a
forall a. Tree a -> EditTree a
treeToEdit Tree a
x)
rec (Del Tree a
y) = EditTree a -> Edit (EditTree a)
forall a. a -> Edit a
Del (Tree a -> EditTree a
forall a. Tree a -> EditTree a
treeToEdit Tree a
y)
rec (Cpy Tree a
z) = EditTree a -> Edit (EditTree a)
forall a. a -> Edit a
Cpy (Tree a -> EditTree a
forall a. Tree a -> EditTree a
treeToEdit Tree a
z)
rec (Swp Tree a
x Tree a
y) = Tree a -> Tree a -> Edit (EditTree a)
forall a. Eq a => Tree a -> Tree a -> Edit (EditTree a)
treeDiff Tree a
x Tree a
y
data EditTree a
= EditNode a [Edit (EditTree a)]
deriving Int -> EditTree a -> ShowS
[EditTree a] -> ShowS
EditTree a -> String
(Int -> EditTree a -> ShowS)
-> (EditTree a -> String)
-> ([EditTree a] -> ShowS)
-> Show (EditTree a)
forall a. Show a => Int -> EditTree a -> ShowS
forall a. Show a => [EditTree a] -> ShowS
forall a. Show a => EditTree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> EditTree a -> ShowS
showsPrec :: Int -> EditTree a -> ShowS
$cshow :: forall a. Show a => EditTree a -> String
show :: EditTree a -> String
$cshowList :: forall a. Show a => [EditTree a] -> ShowS
showList :: [EditTree a] -> ShowS
Show
treeToEdit :: Tree a -> EditTree a
treeToEdit :: forall a. Tree a -> EditTree a
treeToEdit = Tree a -> EditTree a
forall a. Tree a -> EditTree a
go where go :: Tree a -> EditTree a
go (Node a
x [Tree a]
xs) = a -> [Edit (EditTree a)] -> EditTree a
forall a. a -> [Edit (EditTree a)] -> EditTree a
EditNode a
x ((Tree a -> Edit (EditTree a)) -> [Tree a] -> [Edit (EditTree a)]
forall a b. (a -> b) -> [a] -> [b]
map (EditTree a -> Edit (EditTree a)
forall a. a -> Edit a
Cpy (EditTree a -> Edit (EditTree a))
-> (Tree a -> EditTree a) -> Tree a -> Edit (EditTree a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> EditTree a
go) [Tree a]
xs)
#ifdef __DOCTEST__
ppTree :: (a -> PP.Doc) -> Tree a -> PP.Doc
ppTree pp = ppT
where
ppT (Node x []) = pp x
ppT (Node x xs) = PP.parens $ PP.hang (pp x) 2 $
PP.sep $ map ppT xs
ppEditTree :: (a -> PP.Doc) -> Edit (EditTree a) -> PP.Doc
ppEditTree pp = PP.sep . ppEdit
where
ppEdit (Cpy tree) = [ ppTree tree ]
ppEdit (Ins tree) = [ PP.char '+' PP.<> ppTree tree ]
ppEdit (Del tree) = [ PP.char '-' PP.<> ppTree tree ]
ppEdit (Swp a b) =
[ PP.char '-' PP.<> ppTree a
, PP.char '+' PP.<> ppTree b
]
ppTree (EditNode x []) = pp x
ppTree (EditNode x xs) = PP.parens $ PP.hang (pp x) 2 $
PP.sep $ concatMap ppEdit xs
#endif