{-# LANGUAGE DeriveGeneric #-}
module Diffing where

import GHC.Generics
import Data.Aeson

import Component
import Unsafe.Coerce (unsafeCoerce)

{-

Since events target specific locations, we can't stop going the tree early
because changes may have happened beneath the top level.  kind of the
downside not having a single, passed down, state.

We still need render, but render needs to be targeted to specific locations.

I dunno how it should work lol.

Let's start at the basics, with dumb tests.  If there's a div in the new
tree, and not one in the old tree, it should produce something saying
to add that div.

To know where to make a change, I guess you need a location and a command.

-}
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]

  -- TODO: add Handler
  (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']
      -- TODO: this is weak, instead of walking the whole tree it should be targetted
      --       to specific effect handlers

      -- if we hit the target, we're already saying update the whole tree
      [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]

  -- (a, b) -> error (show a <> "\n" <> show b)