{-# 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
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
showList :: [Change a] -> ShowS
$cshowList :: forall a. Show a => [Change a] -> ShowS
show :: Change a -> String
$cshow :: forall a. Show a => Change a -> String
showsPrec :: Int -> Change a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Change a -> ShowS
Show, Change a -> Change a -> Bool
forall a. Eq a => Change a -> Change a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Change a -> Change a -> Bool
$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
Eq, 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
$cto :: forall a x. Rep (Change a) x -> Change a
$cfrom :: forall a x. Change a -> Rep (Change a) x
Generic)

instance ToJSON a => ToJSON (Change a) where
  toEncoding :: Change a -> Encoding
toEncoding = 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') ->
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
      (\(Int
index, Purview event m
oldChild, Purview event m
newChild) -> forall event (m :: * -> *).
Maybe Location
-> Location
-> Purview event m
-> Purview event m
-> [Change (Purview event m)]
diff Maybe Location
target (Int
indexforall a. a -> [a] -> [a]
:Location
location) Purview event m
oldChild Purview event m
newChild)
      (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') ->
    [forall a. Location -> a -> Change a
Update Location
location (forall event (m :: * -> *). String -> Purview event m
Text String
str') | String
str forall a. Eq a => a -> a -> Bool
/= String
str']

  (Html String
kind [Purview event m]
children, Purview event m
unknown) ->
    [forall a. Location -> a -> Change a
Update Location
location Purview event m
newGraph]

  (Purview event m
unknown, Html String
kind [Purview event m]
children) ->
    [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) ->
    [forall a. Location -> a -> Change a
Update Location
location Purview event m
newGraph | forall a b. a -> b
unsafeCoerce state
state forall a. Eq a => a -> a -> Bool
/= state
newState Bool -> Bool -> Bool
&& Maybe Location
loc 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
      forall a. Semigroup a => a -> a -> a
<> if forall a. a -> Maybe a
Just Location
location forall a. Eq a => a -> a -> Bool
== Maybe Location
target
         then []
         else forall event (m :: * -> *).
Maybe Location
-> Location
-> Purview event m
-> Purview event m
-> [Change (Purview event m)]
diff Maybe Location
target (Int
0forall a. a -> [a] -> [a]
:Location
location) (forall a b. a -> b
unsafeCoerce state -> Purview newEvent m
cont state
state) (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) ->
    [forall a. Location -> a -> Change a
Update Location
location Purview event m
newGraph | Attributes event
attr forall a. Eq a => a -> a -> Bool
/= Attributes event
attr']

  (Value a
_, 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
_) ->
    [forall a. Location -> a -> Change a
Update Location
location Purview event m
newGraph]

  (Purview event m
_, Purview event m
_) -> [forall a. Location -> a -> Change a
Update Location
location Purview event m
newGraph]

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