Create a lazy signal that employs an Effect

[bbarker]

I'd like to have something like a signal that reads the current date:

dateTimeWidg :: Widget HTML DateTime
dateTimeWidg = liftEffect nowDateTime

dateTimeSig :: Signal HTML DateTime
dateTimeSig = sig initDate
  where
    sig dt = step dt do
      newDt <- dateTimeWidg
      pure $ sig newDt

The widget seems fine, however, the signal creates an infinite (eagerly evaluated) loop, since dateTimWidg returns immediately.

Ideally, there would be a way to have dateTimeSig only queried when other signals at the same level fire. The particular goal here is that I have user's inputting data to records, but this particular field of the record should be automatically timestamped by the app.

[bbarker]

I guess I would add that I think this would not be an issue if I could call liftEffect from Signal directly, but its type doesn't allow for that, as far as I can tell.

[ajnsit]

A signal must always have a value, even just after construction. With a liftEffect :: Effect a -> Signal a, it's not possible to have an a before executing the effect, hence there's no way to make a signal with just an effect.

It is however possible to have functions -

-- For pure side effects
execEffect :: Effect Unit -> Signal Unit
execEffect e = step unit do
  a <- liftEffect e
  pure (step unit empty)

-- Or when you want the return value
runEffect :: forall a. Effect a -> Signal (Maybe a)
runEffect e = step Nothing do
  a <- liftEffect e
  pure (step (Just a) empty)

-- Or with a supplied initial value instead of using a Maybe
runEffectWithInit :: forall a. a -> Effect a -> Signal a
runEffectWithInit i e = step i do
  a <- liftEffect e
  pure (step a empty)

For dateTimeSig, the runEffectWithInit function should suffice. The date will get updated everytime the signal reflows from upstream. This allows you to control how often you want to poll for the current date.

[bbarker]

@ajnsit Thanks, this does look like what I need. But a question: at first I thought empty was mempty, but that seems incorrect - what is it?

[ajnsit]

empty is similar to mempty. It's the identity for <|> (alt) just like mempty is the identity for <> (append). empty is defined in the Plus class.

Basically -
Plus:empty:Alt:alt = Monoid:mempty:Semigroup:append

[bbarker]

Ah, I see! I'd been using mempty for Concur in the past but now realize that was for values of type HTML, rather than for type families like Widget.

I'm getting the following type error with the code at the moment:

[1/1 KindsDoNotUnify] src/Metajelo/FormUtil.purs:405:49

  405  runEffectWithInit :: forall a. a -> Effect a -> Signal a
                                                       ^^^^^^

  Could not match kind

    Type

  with kind

    Type -> Type

  while checking the kind of a -> Effect a -> Signal a
  in value declaration runEffectWithInit

The new type signature I'm using is:

runEffectWithInit :: forall a v. MonadEffect v => a -> Effect a -> Signal v a

But I get a similar error:

[1/1 KindsDoNotUnify] src/Metajelo/FormUtil.purs:404:68

  404  runEffectWithInit :: forall a v. MonadEffect v => a -> Effect a -> Signal v a
                                                                          ^^^^^^

  Could not match kind

    Type

  with kind

    Type -> Type

  while checking the kind of MonadEffect v => a -> Effect a -> Signal v a
  in value declaration runEffectWithInit

[bbarker]

It does work with the concrete type HTML used in place of v, pointing to the issue with kinds, though not sure how to address it yet.

[bbarker]

To qualify my above comment, when I said it works, it does compile, but the issue of the app hanging still seems to occur, with an out of memory error reported on the browser's console.

[ajnsit]

runEffectWithInit :: forall a v. MonadEffect v => a -> Effect a -> Signal v a

Ah you don't need the MonadEffect here. v here is the view and of kind *, but a Monad or MonadEffect needs to take a type parameter and so needs to be of kind * -> *

In the code I posted, I had omitted the view argument to Signal so you only need to add that back. You will likely need a Monoid constraint though since most functions for Signals require it. i.e. runEffectWithInit :: forall a v. Monoid v => a -> Effect a -> Signal v a

To qualify my above comment, when I said it works, it does compile, but the issue of the app hanging still seems to occur, with an out of memory error reported on the browser's console.

That's strange, it seems to work for me. Can you show me the code?

I also realised that I already have something similar called fireOnce in Concur.Core.FRP -

fireOnce :: forall v a. Monoid v => Widget v a -> Signal v (Maybe a)

Which can be used with liftEffect to get the same functionality as runEffect. For example, this works for me and shows the current date on the page -

import Effect.Now (now)
showCurrentInstant = dyn do
      name <- justWait
              "UNKNOWN"
              (fireOnce do liftEffect do map show now)
              pure
      display $ D.text name

[bbarker]

@ajnsit Ah, I see my error with regard to MonadEffect, should have thought about that more carefully.

I added updated code in the stampModifiedTime branch; see diff. This causes the default user experience found in the master branch to break as described.

By the way, this might be a good time to mention that this app is getting very close to being useful. I still need to add debouncing to prevent frequent DOM updates, and possibly remove formless as mixing it with continuously updating signals doesn't seem to have much benefit, and does add a few idiosyncrasies with regard to user experience.
In particular, I found the way that I've been using purescript-option in UI.purs rather appealing for using Concur to build modular components that update a hierarchy of records; Option is serving as a thin library to support model and view-model. Would be great to have your opinion on this and ways it could be improved, maybe discussed in another thread. I'm currently using a fork of purescript-option, primarily because sometimes I can't wait for things to be merged :-).

[ajnsit]

@bbarker I replied to your issue about debouncing. Closing this. Please feel free to reopen if necessary.

[bbarker]

@ajnsit This was actually unrelated to debounce, except that debounce might be used as a way to hack around the issue. My above comment states, perhaps not very directly, that this issue is not yet resolved, and provides a branch that elicits the undesirable behavior of the apparent infinite loop.

[ajnsit]

Ah I see, reopening the issue.

[ajnsit]

@bbarker Is it possible to have a small independent code snippet that reproduces the problem?

[bbarker]

Deleted previous comment - haven't been able to minimally reproduce yet, as a simple attempt works. Will look more on Monday if not before.

[bbarker]

@ajnsit OK, finally, reproduced the bug in a minimal example! I don't think it is too surprising now that I look at it in this way. It relates to using loopS. Here is the breaking change in the dateTimeWidget branch of purescript-concur-starter.

I think what is needed is something like sampleOn (described in the monadic-html readme):

Sample this Rx using another Rx: every time an event occurs on the second Rx the output updates with the latest value of this Rx.

val r1: Rx[Char]
val r2: Rx[Int]
val sp: Rx[Int] = r2.sampleOn(r1)
// r1 =>   u   u   u   u ...
// r2 => 1   2 3     4   ...
// sp =>   1   3   3   4 ...

This would allow one to have the dateTimeSignal fire only when some other signal, or collection of signals (more generally) would fire.

[bbarker]

@ajnsit I added another commit to show that the firing of the dateTimeSig, as described above using justWait, does not appear to wait for the signal to reflow from upstream signals (in this case, by upstream I mean the hello signal). Excerpt of relevant code:

dateTimeWidg :: Widget HTML DateTime
dateTimeWidg = do
  liftEffect nowDateTime

dateTimeSig :: Signal HTML DateTime
dateTimeSig = justWait initDate (fireOnce dateTimeWidg) pure

hello :: String -> Signal HTML String
hello s = step s do
  greeting <- D.div'
    [ "Hello" <$ D.button [P.onClick] [D.text "Say Hello"]
    , "Namaste" <$ D.button [P.onClick] [D.text "Say Namaste"]
    ]
  _ <- D.text (greeting <> " Sailor!") <|> D.button [P.onClick] [D.text "restart"]
  pure (hello greeting)

outerLoop :: Signal HTML (Maybe DateTime)
outerLoop = loopS Nothing \lastDateMay -> D.div_ [] do
  helloOut <- hello "INIT"
  dateTime <- dateTimeSig
  display $ D.text helloOut
  pure $ pure $ dateTime

At this time, I'm not entirely sure how to address the issue in Concur, either with existing functionality, or by providing new functionality.

[ajnsit]

Thanks @bbarker I will take a look at this soon!

[bbarker]

Hi @ajnsit,

I can try to dig into this more, but wanted to see if you've tried it in another implementation of Concur first; seems like that might be useful.

[ajnsit]

@bbarker I haven't tried it in another implementation. It would be interesting to see if the issue still manifests with something other than React. Apologies that I haven't had a lot of time to dig into this yet. Will try to get to it.

[ajnsit]

@bbarker I have two completely independent backends for Purescript-Concur right now. They are not publically released yet, but I'll check your examples internally and get back to you soon.

[bbarker]

Hi @ajnsit,

Just curious if you'd had a chance to check this with either of the other backends yet - if not, do you think either is in a state that is worth giving it a try?

[bbarker]

I came back to this one and tried the following, which worked:

genRecIdent :: CtrlSignal HTML (Opt.Option (M.BaseIdRows ()))
genRecIdent oldId = do
  let idMay = Opt.get (SProxy :: _ "id") oldId
  idMayNew <- case idMay of
    Just idOld -> pure $ Just idOld
    Nothing -> do
      uuid <- runEffectInit UUID.emptyUUID UUID.genUUID
      pure $ do
        pfx <- urnPrefix
        uuidNES <- fromString $ UUID.toString uuid
        pure $ pfx <> uuidNES
  pure $ execState (do
    get >>= Opt.maySetOptState (SProxy :: _ "id") idMayNew
    get >>= Opt.maySetOptState (SProxy :: _ "idType") (Just M.URN)
  ) oldId
  where
    urnPrefix = fromString "urn:uuid:"

This was basically using one of your functions above:

runEffectInit :: forall a. a -> Effect a -> Signal HTML a
runEffectInit i e = step i do
  a <- liftEffect e
  pure (step a empty)

So, given that, I thought I could return to the problem at hand and write another similar function, also using runEffectInit. However, this one still hangs:

dateInput :: CtrlSignal HTML (Either String M.XsdDate)
dateInput iVal = do
  iValNesEi <- runEffectInit (runErr iVal) $ dateToNesEi iVal
  prevTxt :: String <- pure $ case iValNesEi of
    Left _ -> ""
    Right dtStr -> toString dtStr
  prevErr <- pure $ case iValNesEi of
    Left err -> err
    Right _ -> ""
  txtMay :: Maybe NonEmptyString <- textInput (fromString prevTxt)
  display $ case iValNesEi of
    Right _ -> mempty
    Left err -> errorDisplay $ Just err
  case txtMay of
    Just txtNE -> runEffectInit (runErr txtNE) $
      (lmap show) <$> (EX.try $ MR.parseDate txtNE)
    Nothing -> pure $ Left "no date input"
  where
    dateToNesEi :: Either String DateTime -> Effect (Either String NonEmptyString)
    dateToNesEi dtEi = do
      let dt = fromMaybe bottom $ hush dtEi
      nesEi <- EX.try $ MW.dateTimeToStr dt
      pure $ (lmap show) nesEi
    runErr :: forall a b. Show a => a -> Either String b
    runErr ei = Left $ "Run time date parsing error on " <> (show ei)

[bbarker]

Also, as an additional datapoint, I confirmed that replacing occurrences of runEffectInit with similar usage of unsafePerformEffect fixed the issue. Obviously, this isn't ideal, but I'm happy to say that it at least seems to work here (though I need to do some more testing tomorrow to make sure I'm not breaking other things).