{-# LANGUAGE DeriveGeneric #-}
module Diffing where

import GHC.Generics
import Data.Typeable
import Data.Aeson

import Component
import Unsafe.Coerce (unsafeCoerce)

{-

Since actions 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
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
(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
/= :: 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 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
$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 = Options -> Change a -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
defaultOptions

diff
  :: Maybe Location
  -> Location
  -> Purview parentAction action m
  -> Purview parentAction action m
  -> [Change (Purview parentAction action m)]
diff :: forall parentAction action (m :: * -> *).
Maybe Location
-> Location
-> Purview parentAction action m
-> Purview parentAction action m
-> [Change (Purview parentAction action m)]
diff Maybe Location
target Location
location Purview parentAction action m
oldGraph Purview parentAction action m
newGraph = case (Purview parentAction action m
oldGraph, Purview parentAction action m
newGraph) of

  (Html String
kind [Purview parentAction action m]
children, Html String
kind' [Purview parentAction action m]
children') ->
    ((Int, Purview parentAction action m,
  Purview parentAction action m)
 -> [Change (Purview parentAction action m)])
-> [(Int, Purview parentAction action m,
     Purview parentAction action m)]
-> [Change (Purview parentAction action m)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
      (\(Int
index, Purview parentAction action m
oldChild, Purview parentAction action m
newChild) -> Maybe Location
-> Location
-> Purview parentAction action m
-> Purview parentAction action m
-> [Change (Purview parentAction action m)]
forall parentAction action (m :: * -> *).
Maybe Location
-> Location
-> Purview parentAction action m
-> Purview parentAction action m
-> [Change (Purview parentAction action m)]
diff Maybe Location
target (Int
indexInt -> Location -> Location
forall a. a -> [a] -> [a]
:Location
location) Purview parentAction action m
oldChild Purview parentAction action m
newChild)
      (Location
-> [Purview parentAction action m]
-> [Purview parentAction action m]
-> [(Int, Purview parentAction action m,
     Purview parentAction action m)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0..] [Purview parentAction action m]
children [Purview parentAction action m]
children')

  (Text String
str, Text String
str') ->
    [Location
-> Purview parentAction action m
-> Change (Purview parentAction action m)
forall a. Location -> a -> Change a
Update Location
location (String -> Purview parentAction action m
forall parentAction action (m :: * -> *).
String -> Purview parentAction action m
Text String
str') | String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
str']

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

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

  (Hide (EffectHandler Maybe Location
_ Maybe Location
loc state
state newAction
-> state
-> m (state -> state, [DirectedEvent parentAction newAction])
_ state -> Purview newAction any m
cont), Hide (EffectHandler Maybe Location
_ Maybe Location
loc' state
newState newAction
-> state
-> m (state -> state, [DirectedEvent parentAction newAction])
_ state -> Purview newAction any m
newCont)) ->
    case state -> Maybe state
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast state
state of
      Just state
state' ->
        [Location
-> Purview parentAction action m
-> Change (Purview parentAction action m)
forall a. Location -> a -> Change a
Update Location
location Purview parentAction action m
newGraph | 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 parentAction action m)]
-> [Change (Purview parentAction action m)]
-> [Change (Purview parentAction action 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 parentAction action m
-> Purview parentAction action m
-> [Change (Purview parentAction action m)]
forall parentAction action (m :: * -> *).
Maybe Location
-> Location
-> Purview parentAction action m
-> Purview parentAction action m
-> [Change (Purview parentAction action m)]
diff Maybe Location
target (Int
0Int -> Location -> Location
forall a. a -> [a] -> [a]
:Location
location) ((state -> Purview newAction any m)
-> state -> Purview parentAction action m
forall a b. a -> b
unsafeCoerce state -> Purview newAction any m
cont state
state) ((state -> Purview newAction any m)
-> state -> Purview parentAction action m
forall a b. a -> b
unsafeCoerce state -> Purview newAction any m
newCont state
newState)

      -- different kinds of state
      Maybe state
Nothing ->
        [Location
-> Purview parentAction action m
-> Change (Purview parentAction action m)
forall a. Location -> a -> Change a
Update Location
location Purview parentAction action m
newGraph]

  ((Attribute Attributes action
attr Purview parentAction action m
a), (Attribute Attributes action
attr' Purview parentAction action m
b)) ->
    [Location
-> Purview parentAction action m
-> Change (Purview parentAction action m)
forall a. Location -> a -> Change a
Update Location
location Purview parentAction action m
newGraph | Attributes action
attr Attributes action -> Attributes action -> Bool
forall a. Eq a => a -> a -> Bool
/= Attributes action
attr']

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

  ((EffectHandler Maybe Location
_ Maybe Location
_ state
_ action
-> state -> m (state -> state, [DirectedEvent parentAction action])
_ state -> Purview action any m
_), Purview parentAction action m
_) ->
    [Location
-> Purview parentAction action m
-> Change (Purview parentAction action m)
forall a. Location -> a -> Change a
Update Location
location Purview parentAction action m
newGraph]

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

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