{-# LANGUAGE CPP #-}
-- | Tree diffing working on @containers@ 'Tree'.
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

-- | A breadth-traversal diff.
--
-- It's different from @gdiff@, as it doesn't produce a flat edit script,
-- but edit script iself is a tree. This makes visualising the diff much
-- simpler.
--
-- ==== Examples
--
-- Let's start from simple tree. We pretty print them as s-expressions.
--
-- >>> let x = Node 'a' [Node 'b' [], Node 'c' [return 'd', return 'e'], Node 'f' []]
-- >>> ppTree PP.char x
-- (a b (c d e) f)
--
-- If we modify an argument in a tree, we'll notice it's changed:
--
-- >>> let y = Node 'a' [Node 'b' [], Node 'c' [return 'x', return 'e'], Node 'f' []]
-- >>> ppTree PP.char y
-- (a b (c x e) f)
--
-- >>> ppEditTree PP.char (treeDiff x y)
-- (a b (c -d +x e) f)
--
-- If we modify a constructor, the whole sub-trees is replaced, though there
-- might be common subtrees.
--
-- >>> let z = Node 'a' [Node 'b' [], Node 'd' [], Node 'f' []]
-- >>> ppTree PP.char z
-- (a b d f)
--
-- >>> ppEditTree PP.char (treeDiff x z)
-- (a b -(c d e) +d f)
--
-- If we add arguments, they are spotted too:
--
-- >>> let w = Node 'a' [Node 'b' [], Node 'c' [return 'd', return 'x', return 'e'], Node 'f' []]
-- >>> ppTree PP.char w
-- (a b (c d x e) f)
--
-- >>> ppEditTree PP.char (treeDiff x w)
-- (a b (c d +x e) f)
--
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 forall a. Eq a => a -> a -> Bool
== a
b = forall a. a -> Edit a
Cpy forall a b. (a -> b) -> a -> b
$ forall a. a -> [Edit (EditTree a)] -> EditTree a
EditNode a
a (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Eq a => Edit (Tree a) -> Edit (EditTree a)
rec (forall a. (a -> a -> Bool) -> [a] -> [a] -> [Edit a]
diffBy forall a. Eq a => a -> a -> Bool
(==) [Tree a]
as [Tree a]
bs))
    | Bool
otherwise = forall a. a -> a -> Edit a
Swp (forall a. Tree a -> EditTree a
treeToEdit Tree a
ta) (forall a. Tree a -> EditTree a
treeToEdit Tree a
tb)
  where
    rec :: Edit (Tree a) -> Edit (EditTree a)
rec (Ins Tree a
x)   = forall a. a -> Edit a
Ins (forall a. Tree a -> EditTree a
treeToEdit Tree a
x)
    rec (Del Tree a
y)   = forall a. a -> Edit a
Del (forall a. Tree a -> EditTree a
treeToEdit Tree a
y)
    rec (Cpy Tree a
z)   = forall a. a -> Edit a
Cpy (forall a. Tree a -> EditTree a
treeToEdit Tree a
z)
    rec (Swp Tree a
x Tree a
y) = forall a. Eq a => Tree a -> Tree a -> Edit (EditTree a)
treeDiff Tree a
x Tree a
y

-- | Type used in the result of 'treeDiff'.
--
-- It's essentially a 'Tree', but the forest list is changed from
-- @[tree a]@ to @['Edit' (tree a)]@. This highlights that
-- 'treeDiff' performs a list diff on each tree level.
data EditTree a
    = EditNode a [Edit (EditTree a)]
  deriving Int -> EditTree a -> ShowS
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
showList :: [EditTree a] -> ShowS
$cshowList :: forall a. Show a => [EditTree a] -> ShowS
show :: EditTree a -> String
$cshow :: forall a. Show a => EditTree a -> String
showsPrec :: Int -> EditTree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> EditTree a -> ShowS
Show

treeToEdit :: Tree a -> EditTree a
treeToEdit :: forall a. Tree a -> EditTree a
treeToEdit = forall a. Tree a -> EditTree a
go where go :: Tree a -> EditTree a
go (Node a
x [Tree a]
xs) = forall a. a -> [Edit (EditTree a)] -> EditTree a
EditNode a
x (forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> Edit a
Cpy 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