{- |
Description: Module for 'Edit's to 'AST's.
License: GNU LGPLv3
Maintainer: paul.bittner@uni-ulm.de

Module for 'Edit's to 'AST's.
-}
module Edits where

import UUID
import Tree
import AST
import Grammar

import Util
import ListUtil

import Data.List
import Data.Set

-- | Each edit is associated to a type depending on what it does.
data EditType
    = Identity  -- ^ @Identity@ edits do nothing to the AST (they are noops).
    | TraceOnly -- ^ @TraceOnly@ are edits that do not alter the AST but have a non-empty delta. This delta is used to descibe side-effects that should be applied to all nodes in the delta (e.g., change their feature mapping).
    | Insert    -- ^ @Insert@ edits only add nodes to a tree.
    | Delete    -- ^ @Delete@ edits only remove nodes from a tree.
    | Move      -- ^ @Move@s only relocate nodes within the same tree.
    | Update    -- ^ @Update@s only change the contents of one or more nodes without altering the tree structure.
    deriving (EditType -> EditType -> Bool
(EditType -> EditType -> Bool)
-> (EditType -> EditType -> Bool) -> Eq EditType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EditType -> EditType -> Bool
$c/= :: EditType -> EditType -> Bool
== :: EditType -> EditType -> Bool
$c== :: EditType -> EditType -> Bool
Eq, Int -> EditType -> ShowS
[EditType] -> ShowS
EditType -> String
(Int -> EditType -> ShowS)
-> (EditType -> String) -> ([EditType] -> ShowS) -> Show EditType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EditType] -> ShowS
$cshowList :: [EditType] -> ShowS
show :: EditType -> String
$cshow :: EditType -> String
showsPrec :: Int -> EditType -> ShowS
$cshowsPrec :: Int -> EditType -> ShowS
Show)

-- | An edit to an AST.
data Edit g a = Edit {
    -- | The type of this edit classifying its behaviour.
    Edit g a -> EditType
edittype :: EditType,
    -- | The name of this edit. Used for debugging and printing.
    Edit g a -> String
name :: String,
    -- | Applies the edit to an AST, yielding the edited AST.
    Edit g a -> AST g a -> AST g a
run :: AST g a -> AST g a,
    -- | Computs the set of all nodes that will be altered (inserted, deleted, moved, updated ...) when applying the edit to a given AST.
    Edit g a -> AST g a -> Set (Node g a)
delta :: AST g a -> Set (Node g a)
}

-- | An @EditScript@ is a sequence of edits that should be applied in order to a single AST.
type EditScript g a = [Edit g a]

instance Show (Edit g a) where
    show :: Edit g a -> String
show = Edit g a -> String
forall g a. Edit g a -> String
name

-- | Runs an entire edit script on a given AST.
-- If curried, turns an edit script into one single function that can run that script on any AST.
foldEditScript :: EditScript g a -> AST g a -> AST g a
foldEditScript :: EditScript g a -> AST g a -> AST g a
foldEditScript es :: EditScript g a
es = ((AST g a -> AST g a)
 -> (AST g a -> AST g a) -> AST g a -> AST g a)
-> (AST g a -> AST g a)
-> [AST g a -> AST g a]
-> AST g a
-> AST g a
forall a b. (a -> b -> b) -> b -> [a] -> b
reversefoldr (AST g a -> AST g a) -> (AST g a -> AST g a) -> AST g a -> AST g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) AST g a -> AST g a
forall a. a -> a
id ([AST g a -> AST g a] -> AST g a -> AST g a)
-> [AST g a -> AST g a] -> AST g a -> AST g a
forall a b. (a -> b) -> a -> b
$ Edit g a -> AST g a -> AST g a
forall g a. Edit g a -> AST g a -> AST g a
run (Edit g a -> AST g a -> AST g a)
-> EditScript g a -> [AST g a -> AST g a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EditScript g a
es

-- | The identity of edits.
-- Does nothing and has an empty delta for all trees.
edit_identity :: Edit g a
edit_identity :: Edit g a
edit_identity = Edit :: forall g a.
EditType
-> String
-> (AST g a -> AST g a)
-> (AST g a -> Set (Node g a))
-> Edit g a
Edit {
    edittype :: EditType
edittype = EditType
Identity,
    run :: AST g a -> AST g a
run = AST g a -> AST g a
forall a. a -> a
id,
    delta :: AST g a -> Set (Node g a)
delta = \_ -> Set (Node g a)
forall a. Set a
empty,
    name :: String
name = "identity"}

{- |
An identity edit that will keep the given set of nodes as delta for the feature trace recording.
Upon recording, all given nodes will have their feature trace changed to the feature context.
This function assumes that the given set of nodes is a subset of the nodes in the future edited tree.
-}
edit_trace_only :: Set (Node g a) -> Edit g a
edit_trace_only :: Set (Node g a) -> Edit g a
edit_trace_only nodes :: Set (Node g a)
nodes = Edit :: forall g a.
EditType
-> String
-> (AST g a -> AST g a)
-> (AST g a -> Set (Node g a))
-> Edit g a
Edit {
    edittype :: EditType
edittype = EditType
TraceOnly,
    run :: AST g a -> AST g a
run = AST g a -> AST g a
forall a. a -> a
id,
    delta :: AST g a -> Set (Node g a)
delta = \_ -> Set (Node g a)
nodes,
    name :: String
name = "tracechange"}

-- | Inserts a subtree into another tree.
-- The given tree (first argument) will become the @i@-th child of the node with the given UUID.
edit_ins_tree :: (Eq a) => AST g a -> UUID -> Int -> Edit g a
edit_ins_tree :: AST g a -> Int -> Int -> Edit g a
edit_ins_tree stree :: AST g a
stree p :: Int
p i :: Int
i = Edit :: forall g a.
EditType
-> String
-> (AST g a -> AST g a)
-> (AST g a -> Set (Node g a))
-> Edit g a
Edit {
    edittype :: EditType
edittype = EditType
Insert,
    run :: AST g a -> AST g a
run = \t :: AST g a
t -> if (Node g a -> Bool) -> AST g a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Int
pInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==)(Int -> Bool) -> (Node g a -> Int) -> Node g a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Node g a -> Int
forall g a. Node g a -> Int
uuid) AST g a
t then (AST g a -> AST g a) -> AST g a -> AST g a
forall a. (Tree a -> Tree a) -> Tree a -> Tree a
manipulate AST g a -> AST g a
ins AST g a
t else String -> AST g a
forall a. HasCallStack => String -> a
error (String -> AST g a) -> String -> AST g a
forall a b. (a -> b) -> a -> b
$ "The given parent node "String -> ShowS
forall a. [a] -> [a] -> [a]
++(Int -> String
forall a. Show a => a -> String
show Int
p)String -> ShowS
forall a. [a] -> [a] -> [a]
++" does not exist!",
    delta :: AST g a -> Set (Node g a)
delta = \t :: AST g a
t -> if (Node g a -> Bool) -> AST g a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Int
pInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==)(Int -> Bool) -> (Node g a -> Int) -> Node g a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Node g a -> Int
forall g a. Node g a -> Int
uuid) AST g a
t then AST g a -> Set (Node g a)
forall a. Ord a => Tree a -> Set a
toset AST g a
stree else Set (Node g a)
forall a. Set a
empty,
    name :: String
name = "ins_tree("String -> ShowS
forall a. [a] -> [a] -> [a]
++(String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> [Int] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AST g a -> Int
forall g a. AST g a -> Int
uuidOf AST g a
stree, Int
p, Int
i])String -> ShowS
forall a. [a] -> [a] -> [a]
++")"} -- inverse = del_tree $ uuidOf s
    where ins :: AST g a -> AST g a
ins x :: AST g a
x@(Tree n :: Node g a
n c :: [AST g a]
c) = if Node g a -> Int
forall g a. Node g a -> Int
uuid Node g a
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p
                             then Node g a -> [AST g a] -> AST g a
forall a. a -> [Tree a] -> Tree a
Tree Node g a
n (Int -> AST g a -> [AST g a] -> [AST g a]
forall a. Int -> a -> [a] -> [a]
ListUtil.insertAtIndex Int
i AST g a
stree [AST g a]
c)
                             else AST g a
x

-- | Delete the node with the given UUID v and move its children up (such that they become children of the deleted node's parent).
edit_del_node :: (Eq a) => UUID -> Edit g a
edit_del_node :: Int -> Edit g a
edit_del_node v :: Int
v = Edit :: forall g a.
EditType
-> String
-> (AST g a -> AST g a)
-> (AST g a -> Set (Node g a))
-> Edit g a
Edit {
    edittype :: EditType
edittype = EditType
Delete,
    run :: AST g a -> AST g a
run = ((AST g a -> Bool) -> AST g a -> AST g a
forall a. (Tree a -> Bool) -> Tree a -> Tree a
filterNodes ((Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=) (Int -> Bool) -> (AST g a -> Int) -> AST g a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AST g a -> Int
forall g a. AST g a -> Int
uuidOf)), --(fmap $ increaseVersion 1).
    delta :: AST g a -> Set (Node g a)
delta = \t :: AST g a
t -> case Int -> AST g a -> Maybe (AST g a)
forall g a. Int -> AST g a -> Maybe (AST g a)
findById Int
v AST g a
t of
        Nothing -> Set (Node g a)
forall a. Set a
empty
        Just t' :: AST g a
t' -> Node g a -> Set (Node g a)
forall a. a -> Set a
singleton (Node g a -> Set (Node g a)) -> Node g a -> Set (Node g a)
forall a b. (a -> b) -> a -> b
$ AST g a -> Node g a
forall a. Tree a -> a
element AST g a
t',
    name :: String
name = "del_node("String -> ShowS
forall a. [a] -> [a] -> [a]
++(Int -> String
forall a. Show a => a -> String
show Int
v)String -> ShowS
forall a. [a] -> [a] -> [a]
++")"}

-- | Delete the entire subtree whose root has the given id.
edit_del_tree :: (Eq a) => UUID -> Edit g a
edit_del_tree :: Int -> Edit g a
edit_del_tree v :: Int
v = Edit :: forall g a.
EditType
-> String
-> (AST g a -> AST g a)
-> (AST g a -> Set (Node g a))
-> Edit g a
Edit {
    edittype :: EditType
edittype = EditType
Delete,
    run :: AST g a -> AST g a
run = ((AST g a -> Bool) -> AST g a -> AST g a
forall a. (Tree a -> Bool) -> Tree a -> Tree a
filterTrees ((Int
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=) (Int -> Bool) -> (AST g a -> Int) -> AST g a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AST g a -> Int
forall g a. AST g a -> Int
uuidOf)), --(fmap $ increaseVersion 1).
    delta :: AST g a -> Set (Node g a)
delta = \t :: AST g a
t -> case Int -> AST g a -> Maybe (AST g a)
forall g a. Int -> AST g a -> Maybe (AST g a)
findById Int
v AST g a
t of
        Nothing -> Set (Node g a)
forall a. Set a
empty
        Just t' :: AST g a
t' -> AST g a -> Set (Node g a)
forall a. Ord a => Tree a -> Set a
toset AST g a
t',
    name :: String
name = "del_tree("String -> ShowS
forall a. [a] -> [a] -> [a]
++(Int -> String
forall a. Show a => a -> String
show Int
v)String -> ShowS
forall a. [a] -> [a] -> [a]
++")"}

-- | Moves the subtree @s@ with the given root (first argument).
-- @s@ will become the i-th child of the node with the given id (second argument).
edit_move_tree :: (Grammar g, Eq a, Show a) => UUID -> UUID -> Int -> Edit g a
edit_move_tree :: Int -> Int -> Int -> Edit g a
edit_move_tree s :: Int
s p :: Int
p i :: Int
i = Edit :: forall g a.
EditType
-> String
-> (AST g a -> AST g a)
-> (AST g a -> Set (Node g a))
-> Edit g a
Edit {
    edittype :: EditType
edittype = EditType
Move,
    run :: AST g a -> AST g a
run = \t :: AST g a
t -> case AST g a -> Maybe (AST g a)
forall g a. AST g a -> Maybe (AST g a)
streeIn AST g a
t of
        Just stree :: AST g a
stree -> (AST g a -> AST g a -> AST g a
forall a g. Eq a => AST g a -> AST g a -> AST g a
ins AST g a
stree)(AST g a -> AST g a) -> (AST g a -> AST g a) -> AST g a -> AST g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AST g a -> AST g a
forall g. AST g a -> AST g a
del (AST g a -> AST g a) -> AST g a -> AST g a
forall a b. (a -> b) -> a -> b
$ AST g a
t
        Nothing -> String -> AST g a
forall a. HasCallStack => String -> a
error (String -> AST g a) -> String -> AST g a
forall a b. (a -> b) -> a -> b
$ "The subtree "String -> ShowS
forall a. [a] -> [a] -> [a]
++(Int -> String
forall a. Show a => a -> String
show Int
s)String -> ShowS
forall a. [a] -> [a] -> [a]
++" cannot be moved because it does not exist in the given tree \n"String -> ShowS
forall a. [a] -> [a] -> [a]
++(AST g a -> String
forall a. Show a => a -> String
show AST g a
t),
    delta :: AST g a -> Set (Node g a)
delta = \t :: AST g a
t -> case AST g a -> Maybe (AST g a)
forall g a. AST g a -> Maybe (AST g a)
streeIn AST g a
t of
        Just stree :: AST g a
stree -> AST g a -> Set (Node g a)
forall a. Ord a => Tree a -> Set a
toset AST g a
stree
        Nothing -> Set (Node g a)
forall a. Set a
empty,
    name :: String
name = "move_tree("String -> ShowS
forall a. [a] -> [a] -> [a]
++(String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show (Int -> String) -> [Int] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
s, Int
p, Int
i])String -> ShowS
forall a. [a] -> [a] -> [a]
++")"}
    where streeIn :: AST g a -> Maybe (AST g a)
streeIn = Int -> AST g a -> Maybe (AST g a)
forall g a. Int -> AST g a -> Maybe (AST g a)
findById Int
s
          del :: AST g a -> AST g a
del = Edit g a -> AST g a -> AST g a
forall g a. Edit g a -> AST g a -> AST g a
run (Edit g a -> AST g a -> AST g a) -> Edit g a -> AST g a -> AST g a
forall a b. (a -> b) -> a -> b
$ Int -> Edit g a
forall a g. Eq a => Int -> Edit g a
edit_del_tree Int
s
          ins :: AST g a -> AST g a -> AST g a
ins t :: AST g a
t = Edit g a -> AST g a -> AST g a
forall g a. Edit g a -> AST g a -> AST g a
run (Edit g a -> AST g a -> AST g a) -> Edit g a -> AST g a -> AST g a
forall a b. (a -> b) -> a -> b
$ AST g a -> Int -> Int -> Edit g a
forall a g. Eq a => AST g a -> Int -> Int -> Edit g a
edit_ins_tree AST g a
t Int
p Int
i

-- | Updates the node with the given UUID to have a new grammar type and a new value.
-- The node will keep its UUID (i.e., not get a new uuid as it is still associated to the same previous node.
edit_update :: (Grammar g, Show a, Eq a) => UUID -> g -> a -> Edit g a
edit_update :: Int -> g -> a -> Edit g a
edit_update id :: Int
id newGrammarType :: g
newGrammarType newVal :: a
newVal = Edit :: forall g a.
EditType
-> String
-> (AST g a -> AST g a)
-> (AST g a -> Set (Node g a))
-> Edit g a
Edit {
    edittype :: EditType
edittype = EditType
Update,
    run :: AST g a -> AST g a
run = \t :: AST g a
t -> (\n :: Node g a
n ->
        if Node g a -> Int
forall g a. Node g a -> Int
uuid Node g a
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
id
        then Node :: forall g a. a -> g -> Int -> Node g a
Node {value :: a
value = a
newVal, grammartype :: g
grammartype = g
newGrammarType, uuid :: Int
uuid = Node g a -> Int
forall g a. Node g a -> Int
uuid Node g a
n}
        else Node g a
n) (Node g a -> Node g a) -> AST g a -> AST g a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AST g a
t,
    delta :: AST g a -> Set (Node g a)
delta = \t :: AST g a
t -> case Int -> AST g a -> Maybe (AST g a)
forall g a. Int -> AST g a -> Maybe (AST g a)
findById Int
id AST g a
t of
        Nothing -> Set (Node g a)
forall a. Set a
empty
        Just x :: AST g a
x -> AST g a -> Set (Node g a)
forall a. Ord a => Tree a -> Set a
toset AST g a
x,
    name :: String
name = "update("String -> ShowS
forall a. [a] -> [a] -> [a]
++(String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [Int -> String
forall a. Show a => a -> String
show Int
id, g -> String
forall a. Show a => a -> String
show g
newGrammarType, a -> String
forall a. Show a => a -> String
show a
newVal])String -> ShowS
forall a. [a] -> [a] -> [a]
++")"
}