purview-0.2.0.0: src/Diffing.hs

{-# 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 (Show, Eq, Generic)

instance ToJSON a => ToJSON (Change a) where
  toEncoding = genericToEncoding defaultOptions

diff
  :: Maybe Location
  -> Location
  -> Purview event m
  -> Purview event m
  -> [Change (Purview event m)]
diff target location oldGraph newGraph = case (oldGraph, newGraph) of

  (Html kind children, Html kind' children') ->
    concatMap
      (\(index, oldChild, newChild) -> diff target (index:location) oldChild newChild)
      (zip3 [0..] children children')

  (Text str, Text str') ->
    [Update location (Text str') | str /= str']

  (Html kind children, unknown) ->
    [Update location newGraph]

  (unknown, Html kind children) ->
    [Update location newGraph]

  -- TODO: add Handler
  (EffectHandler _ loc initEvents state _ cont, EffectHandler _ loc' initEvents' newState _ newCont) ->
    [Update location newGraph | unsafeCoerce state /= newState && loc == 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
      <> if Just location == target
         then []
         else diff target (0:location) (unsafeCoerce cont state) (unsafeCoerce newCont newState)


  (Attribute attr a, Attribute attr' b) ->
    [Update location newGraph | attr /= attr']

  (Value _, _) ->
    [Update location newGraph]

  (EffectHandler _ _ _ _ _ _, _) ->
    [Update location newGraph]

  (_, _) -> [Update location newGraph]

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