{-# LANGUAGE DeriveGeneric #-}
module Diffing where
import GHC.Generics
import Data.Aeson
import Component
import Unsafe.Coerce (unsafeCoerce)
type Location = [Int]
data Change a = Update Location a | Delete Location a | Add Location a
deriving (Int -> Change a -> ShowS
[Change a] -> ShowS
Change a -> String
(Int -> Change a -> ShowS)
-> (Change a -> String) -> ([Change a] -> ShowS) -> Show (Change a)
forall a. Show a => Int -> Change a -> ShowS
forall a. Show a => [Change a] -> ShowS
forall a. Show a => Change a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Change a -> ShowS
showsPrec :: Int -> Change a -> ShowS
$cshow :: forall a. Show a => Change a -> String
show :: Change a -> String
$cshowList :: forall a. Show a => [Change a] -> ShowS
showList :: [Change a] -> ShowS
Show, Change a -> Change a -> Bool
(Change a -> Change a -> Bool)
-> (Change a -> Change a -> Bool) -> Eq (Change a)
forall a. Eq a => Change a -> Change a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Change a -> Change a -> Bool
== :: Change a -> Change a -> Bool
$c/= :: forall a. Eq a => Change a -> Change a -> Bool
/= :: Change a -> Change a -> Bool
Eq, (forall x. Change a -> Rep (Change a) x)
-> (forall x. Rep (Change a) x -> Change a) -> Generic (Change a)
forall x. Rep (Change a) x -> Change a
forall x. Change a -> Rep (Change a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Change a) x -> Change a
forall a x. Change a -> Rep (Change a) x
$cfrom :: forall a x. Change a -> Rep (Change a) x
from :: forall x. Change a -> Rep (Change a) x
$cto :: forall a x. Rep (Change a) x -> Change a
to :: forall x. Rep (Change a) x -> Change a
Generic)
instance ToJSON a => ToJSON (Change a) where
toEncoding :: Change a -> Encoding
toEncoding = Options -> Change a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions
diff
:: Maybe Location
-> Location
-> Purview event m
-> Purview event m
-> [Change (Purview event m)]
diff :: forall event (m :: * -> *).
Maybe Location
-> Location
-> Purview event m
-> Purview event m
-> [Change (Purview event m)]
diff Maybe Location
target Location
location Purview event m
oldGraph Purview event m
newGraph = case (Purview event m
oldGraph, Purview event m
newGraph) of
(Html String
kind [Purview event m]
children, Html String
kind' [Purview event m]
children') ->
((Int, Purview event m, Purview event m)
-> [Change (Purview event m)])
-> [(Int, Purview event m, Purview event m)]
-> [Change (Purview event m)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(\(Int
index, Purview event m
oldChild, Purview event m
newChild) -> Maybe Location
-> Location
-> Purview event m
-> Purview event m
-> [Change (Purview event m)]
forall event (m :: * -> *).
Maybe Location
-> Location
-> Purview event m
-> Purview event m
-> [Change (Purview event m)]
diff Maybe Location
target (Int
indexInt -> Location -> Location
forall a. a -> [a] -> [a]
:Location
location) Purview event m
oldChild Purview event m
newChild)
(Location
-> [Purview event m]
-> [Purview event m]
-> [(Int, Purview event m, Purview event m)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0..] [Purview event m]
children [Purview event m]
children')
(Text String
str, Text String
str') ->
[Location -> Purview event m -> Change (Purview event m)
forall a. Location -> a -> Change a
Update Location
location (String -> Purview event m
forall event (m :: * -> *). String -> Purview event m
Text String
str') | String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
str']
(Html String
kind [Purview event m]
children, Purview event m
unknown) ->
[Location -> Purview event m -> Change (Purview event m)
forall a. Location -> a -> Change a
Update Location
location Purview event m
newGraph]
(Purview event m
unknown, Html String
kind [Purview event m]
children) ->
[Location -> Purview event m -> Change (Purview event m)
forall a. Location -> a -> Change a
Update Location
location Purview event m
newGraph]
(EffectHandler Maybe Location
_ Maybe Location
loc [DirectedEvent event newEvent]
initEvents state
state newEvent
-> state -> m (state -> state, [DirectedEvent event newEvent])
_ state -> Purview newEvent m
cont, EffectHandler Maybe Location
_ Maybe Location
loc' [DirectedEvent event newEvent]
initEvents' state
newState newEvent
-> state -> m (state -> state, [DirectedEvent event newEvent])
_ state -> Purview newEvent m
newCont) ->
[Location -> Purview event m -> Change (Purview event m)
forall a. Location -> a -> Change a
Update Location
location Purview event m
newGraph | state -> state
forall a b. a -> b
unsafeCoerce state
state state -> state -> Bool
forall a. Eq a => a -> a -> Bool
/= state
newState Bool -> Bool -> Bool
&& Maybe Location
loc Maybe Location -> Maybe Location -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Location
loc']
[Change (Purview event m)]
-> [Change (Purview event m)] -> [Change (Purview event m)]
forall a. Semigroup a => a -> a -> a
<> if Location -> Maybe Location
forall a. a -> Maybe a
Just Location
location Maybe Location -> Maybe Location -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Location
target
then []
else Maybe Location
-> Location
-> Purview event m
-> Purview event m
-> [Change (Purview event m)]
forall event (m :: * -> *).
Maybe Location
-> Location
-> Purview event m
-> Purview event m
-> [Change (Purview event m)]
diff Maybe Location
target (Int
0Int -> Location -> Location
forall a. a -> [a] -> [a]
:Location
location) ((state -> Purview newEvent m) -> state -> Purview event m
forall a b. a -> b
unsafeCoerce state -> Purview newEvent m
cont state
state) ((state -> Purview newEvent m) -> state -> Purview event m
forall a b. a -> b
unsafeCoerce state -> Purview newEvent m
newCont state
newState)
(Attribute Attributes event
attr Purview event m
a, Attribute Attributes event
attr' Purview event m
b) ->
[Location -> Purview event m -> Change (Purview event m)
forall a. Location -> a -> Change a
Update Location
location Purview event m
newGraph | Attributes event
attr Attributes event -> Attributes event -> Bool
forall a. Eq a => a -> a -> Bool
/= Attributes event
attr']
(Value a
_, Purview event m
_) ->
[Location -> Purview event m -> Change (Purview event m)
forall a. Location -> a -> Change a
Update Location
location Purview event m
newGraph]
(EffectHandler Maybe Location
_ Maybe Location
_ [DirectedEvent event newEvent]
_ state
_ newEvent
-> state -> m (state -> state, [DirectedEvent event newEvent])
_ state -> Purview newEvent m
_, Purview event m
_) ->
[Location -> Purview event m -> Change (Purview event m)
forall a. Location -> a -> Change a
Update Location
location Purview event m
newGraph]
(Purview event m
_, Purview event m
_) -> [Location -> Purview event m -> Change (Purview event m)
forall a. Location -> a -> Change a
Update Location
location Purview event m
newGraph]