memoB/memoE possibly unsafe

[ocharles]

I have the following program:

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecursiveDo #-}

module Main where

import Control.FRPNow
import Control.Monad.Trans.Class
import Data.Bool
import Data.Char
import Francium
import Francium.Components.Form.Input
import Francium.HTML
import Francium.Hooks
import GHCJS.Foreign
import GHCJS.Types
import VirtualDom

one
  :: String -> Behavior Bool -> Now (HTML Behavior (), EvStream String)
one label hasFocus =
  do (clickHook,clicks) <- newClickHook
     return (do suffix <-
                  fmap (bool "" "!")
                       (lift hasFocus)
                div_ (applyHooks clickHook)
                     (do text (toJSString label)
                         suffix)
            ,label <$ clicks)

main :: IO ()
main =
  react (mdo (item1,focus1) <-
               one "One" (fmap ("One" ==) focus)
             (item2,focus2) <-
               one "Two" (fmap ("Two" ==) focus)
             focus <-
               sample (fromChanges "One"
                                   (merge focus1 focus2))
             return (do item1
                        item2))

Unfortunately it's quite deeply tied to work I'm doing, and not a standalone example. It shows two HTML <div> elements that can be clicked, which changes the focused element. It begins with "One" having focus.

If I use the Hackage release, I can click "Two" which immediately gives it focus. From that point on, rendering always seems to lag a frame behind - meaning I have to click "One" twice to shift focus back to "One".

If I change memoB to be the same as id, then the behavior changes. Now, I have to click on "Two" twice, right from the start, in order for it to have focus, rather than once as observed previously.

Neither of these do what I expect (it should only require a single click to change focus), but the fact that the behavior has changed makes me think that memoB and memoE are not semantically acting as identity.

In both programs a single click does cause a re-render, but it appears that the behavior containing the rendered view of each element ("One!" or "Two!") changes after the composed rendering (do item1 ; item2) is observed to change. This is probably a separate bug, and I'm trying to work out what's going on with that next.

[ocharles]

I have noticed that the underlying data that is varying (HTML fragments) has a questionable Eq instance, which I think might be the problem. Essentially, the Eq instance uses JavaScript reference equality, rather than a structural equality. That is,

htmlFromText "hello" /= htmlFromText "hello"

as the two HTML fragments are allocated separately in the JS heap and are thus not equal. I'm not sure if this has any impact against the memo strategy and other assumptions.

[atzeus]

Can you give the full code? Or a more minimal example? Cheers! This might also have to do with how react is implemented?

[ocharles]

Here is a somewhat more minimal example (it's at least self-contained!)

{-# LANGUAGE RecursiveDo #-}

module Main where

import Control.Concurrent
import Control.Applicative
import Control.FRPNow
import Control.Monad.Trans.Class
import Data.Bool
import Data.Char
import System.IO.Unsafe
import Data.Monoid
import Data.Unique

data FunkyString =
  FunkyString String
              Unique

instance Eq FunkyString where
  FunkyString _ a == FunkyString _ b = a == b

instance Monoid FunkyString where
  mempty = funky ""
  FunkyString a _ `mappend` FunkyString b _ =
    funky (a <> b)

funky :: String -> FunkyString
funky x =
  unsafePerformIO (fmap (FunkyString x) newUnique)

unFunky :: FunkyString -> String
unFunky (FunkyString a _) = a

one
  :: String -> Behavior Bool -> Now (Behavior FunkyString)
one label hasFocus =
  return (do suffix <-
               fmap (bool "" "!") hasFocus
             return (funky (label <> suffix)))

main :: IO ()
main =
  react (mdo (change,f) <- callbackStream
             async (let loop a b = do
                          threadDelay 1000000
                          putStrLn ("Selecting " <> a)
                          f a
                          loop b a
                    in loop "Two" "One")
             item1 <-
               one "One" (fmap ("One" ==) focus)
             item2 <-
               one "Two" (fmap ("Two" ==) focus)
             focus <-
               sample (fromChanges "One" change)
             return (liftA2 (<>) item1 item2))

react :: Now (Behavior FunkyString) -> IO ()
react app =
  do runNowMaster
       (do b <- app
           sample b >>= sync . putStrLn . ("Starting with " ++) . unFunky
           callIOStream (putStrLn . ("View is now " ++) . unFunky)
                        (toChanges b)
           pure never)

When ran with memoB using unsafePerformIO, we see:

Starting with One!Two
Selecting Two
View is now OneTwo!
Selecting One
View is now OneTwo!
Selecting Two
View is now One!Two
Selecting One
View is now OneTwo!
Selecting Two
View is now One!Two

Notice how when it selects One, the view is OneTwo! which only happens when Two is selected. Selecting Two after that then renders One!Two, which is the "lagging" output.

[atzeus]

Thanks! It's on my stack of things to do :)