Monad Transformer for Halogen Components - monad-transformers

I'm trying to figure out in which way I can use a transformer on the monad that a Halogen component contains.
I'd like to extend the intro example by a ReaderT that carries a Config record which in this case could be used to make the strings configurable, but I'm a lost when it comes to putting it all together.
Let's say we define our Config like this:
-- | Global configuration
newtype Config = Config { toggleText :: String
, onText :: String
, offText :: String
}
Our ui function would then turn from
forall m eff. (Monad m) => Component m Input Input
to
forall m (Monad m) => Component (ReaderT Config m) Input Input.
To evaluate our main function, we'd then use hoistComponent to turn it back into its previous form:
main = do
let config = Config { toggleText: "Toggle Button"
, onText: "On"
, offText: "Off"
}
Tuple node _ <- runUI $ hoistComponent (runReaderT config) ui
appendToBody node
I'm not sure if this even makes sense so far, but pretending that it does, the next step is where I'm struggling. In an ideal world, my ui function would allow me to do something like this:
ui :: forall m eff. (Monad m) => Component (ReaderT Config m) Input Input
ui = render <$> stateful (State { on: false }) update
where
render :: State -> H.HTML (ReaderT Config m Input)
render (State s) = do
(Config conf) <- ask
return $ H.div_ [ H.h1_ [ H.text conf.toggleText ]
, H.button [ A.onClick (A.input_ ToggleState) ]
[ H.text (if s.on then conf.onText else conf.offText) ]
]
update :: State -> Input -> State
update (State s) ToggleState = State { on: not s.on }
But I end up with a long chain of unification errors and don't know where to start. Obviously, the inner use of ask cannot work like this, because I'd need to lift it into the HTML context, but I'm not even sure if that's possible.
It would be great if someone could guide my through the types here and tell me if that general approach is sensible. A full (non-compiling) example is on GitHub. I18n should only serve as a simple example use of the Reader here.

The monad m is the monad for event handlers. The HTML document itself would not have access to the configuration in your Reader monad.
You would use Reader if you wanted your event handlers to have access to some configuration object, and you would have to replace the use of A.input_ with an action in the Reader monad.
To do what you want to do, you probably want something more like MonadReader Config m => m (Component _ _ _), where the component itself depends on the configuration.

Related

How do I use multiple reactive streams in the same pipeline?

I'm using WebFlux to pull data from two different REST endpoints, and trying to correlate some data from one stream with the other. I have Flux instances called events and egvs and for each event, I want to find the EGV with the nearest timestamp.
final Flux<Tuple2<Double,Object>> data = events
.map(e -> Tuples.of(e.getValue(),
egvs.map(egv -> Tuples.of(egv.getValue(),
Math.abs(Duration.between(e.getDisplayTime(),
egv.getDisplayTime()).toSeconds())))
.sort(Comparator.comparingLong(Tuple2::getT2))
.take(1)
.map(v -> v.getT1())));
When I send data to my Thymeleaf template, the first element of the tuple renders as a number, as I'd expect, but the second element renders as a FluxMapFuseable. It appears that the egvs.map(...) portion of the pipeline isn't executing. How do I get that part of the pipeline to execute?
UPDATE
Thanks, #Toerktumlare - your answer helped me figure out that my approach was wrong. On each iteration through the map operation, the event needs the context of the entire set of EGVs to find the one it matches with. So the working code looks like this:
final Flux<Tuple2<Double, Double>> data =
Flux.zip(events, egvs.collectList().repeat())
.map(t -> Tuples.of(
// Grab the event
t.getT1().getValue(),
// Find the EGV (from the full set of EGVs) with the closest timestamp
t.getT2().stream()
.map(egv -> Tuples.of(
egv.getValue(),
Math.abs(Duration.between(
t.getT1().getDisplayTime(),
egv.getDisplayTime()).toSeconds())))
// Sort the stream of (value, time difference) tuples and
// take the smallest time difference.
.sorted(Comparator.comparingLong(Tuple2::getT2))
.map(Tuple2::getT1)
.findFirst()
.orElse(0.)));
what i think you are doing is that you are breaking the reactive chain.
During the assembly phase reactor will call each operator backwards until it finds a producer that can start producing items and i think you are breaking that chain here:
egvs.map(egv -> Tuples.of( ..., ... )
you see egvs returns something that you need to take care of and chain on to the return of events.map
I'll give you an example:
// This works because we always return from flatMap
// we keep the chain intact
Mono.just("foobar").flatMap(f -> {
return Mono.just(f)
}.subscribe(s -> {
System.out.println(s)
});
on the other hand, this behaves differently:
Mono.just("foobar").flatMap(f -> {
Mono.just("foo").doOnSuccess(s -> { System.out.println("this will never print"); });
return Mono.just(f);
});
Because in this example you can see that we ignore to take care of the return from the inner Mono thus breaking the chain.
You havn't really disclosed what evg actually is so i wont be able to give you a full answer but you should most likely do something like this:
final Flux<Tuple2<Double,Object>> data = events
// chain on egv here instead
// and then return your full tuple object instead
.map(e -> egvs.map(egv -> Tuples.of(e.getValue(), Tuples.of(egv.getValue(), Math.abs(Duration.between(e.getDisplayTime(), egv.getDisplayTime()).toSeconds())))
.sort(Comparator.comparingLong(Tuple2::getT2))
.take(1)
.map(v -> v.getT1())));
I don't have compiler to check against atm. but i believe that is your problem at least. its a bit tricky to read your code.

GUI update patterns in F#

I'm looking for the best way to propagate model updates to the GUI, using a "classic" (as in: non reactive functional) GUI toolkit: Terminal.GUI. Currently I have this code (simplified):
type Tui(state: StateManager) =
let state = state
let window = Window(bla bla bla)
let lblPath = Label(bla bla bla)
let lstView =
{ new ListView(bla bla bla) with
member this.ProcessKey(k: KeyEvent) =
let updateViews() =
Application.MainLoop.Invoke(fun () ->
this.SetSource model.CurrentState.LstData
lblPath.Text <- ustr model.CurrentState.CurrPath)
match k.Key with
| Key.CursorRight ->
state.changeTheState()
updateViews()
true
| _ -> true }
do
Application.Init()
// add all GUI components: window.add(lblPath), etc
Application.Run()
// XXX repetition of updateViews() above!
Application.MainLoop.Invoke(fun () ->
lstView.SetSource model.CurrentState.LstData
lblPath.Text <- ustr model.CurrentState.CurrPath)
The issue here is that the code to update the view components is duplicated. I believe this is because:
in that ProcessKey method of the ListView object expression I cannot access any external method of the Tui class (this is probably also because F# compiler is one-pass only (?))
outside that method I cannot access the updateView function
Is there a better way of doing this that would avoid code repetition? Am I using the wrong pattern GUI update pattern?
(Complete code is here)
Of course, it doesn't need to be too complicated - refactor your update to just take in a listview parameter:
let updateViews (lstView: ListView) =
Application.MainLoop.Invoke(fun () ->
lstView.SetSource state.CurrentState.LstData
...
)
And inside the member definition, call:
updateViews(this)
And below, you can use updateViews lstView.
When you use an object expression, the type of the expression becomes the type you specify in new <type>, so any type augmentations you do inside won't make it outside. For a more OOP approach, declare an intermediate type:
[<AbstractClass>]
type UpdateableList() =
inherit ListView([||])
abstract member Update: unit -> unit
implement your update logic:
{ new UpdateableList(X = Pos.At(0), Y = Pos.At(2), ...) with
member this.Update() =
...
and in your setup, you have access to a public method:
lstView.Update()

Consuming both Strict and Streamed WebSocket Messages in Akka

I am experimenting with building a web socket service using Akka HTTP. I need to handle Strict messages that arrive in totality, as well as handle Streamed messages that arrive in m multiple frames. I am using a route with handleWebSocketMessages() to pass the handling of web sockets off to a flow. The code I have looks something like this:
val route: Route =
get {
handleWebSocketMessages(createFlow())
}
def createFlow(): Flow[Message, Message, Any] = Flow[Message]
.collect {
case TextMessage.Strict(msg) ⇒ msg
case TextMessage.Streamed(stream) => ??? // <= What to do here??
}
.via(createActorFlow())
.map {
case msg: String ⇒ TextMessage.Strict(msg)
}
def createActorFlow(): Flow[String, String, Any] = {
// Set Up Actors
// ... (this is working)
Flow.fromSinkAndSource(in, out)
}
I am not really sure how two handle both Strict and Streamed messages. I realize I could do something like this :
.collect {
case TextMessage.Strict(msg) ⇒ Future.successful(msg)
case TextMessage.Streamed(stream) => stream.runFold("")(_ + _)
}
But now my stream has to handle Future[String] rather than just Strings, which I am then not sure how to handle, especially since obviously I need to handle messages in order.
I did see this akka issue, which seems to be somewhat related, but not exactly what I need (I don't think?).
https://github.com/akka/akka/issues/20096
Any help would be appriciated
Folding sounds like a sensible option. Handling future in your streams can be done using (e.g.)
flowOfFutures.mapAsync(parallelism = 3)(identity)
Please note that mapAsync does preserve the order of the incoming messages, as per docs.
On a different note, other sensible precautions to handle streamed WS messages could be to use completionTimeout and limit to bound time and space for the message to fold (e.g.)
stream.limit(x).completionTimeout(5 seconds).runFold(...)
The ultimate answer based on the below (thanks to svezfaz) answer turned out to be something like this:
val route: Route =
get {
handleWebSocketMessages(createFlow())
}
def createFlow(): Flow[Message, Message, Any] = Flow[Message]
.collect {
case TextMessage.Strict(msg) ⇒
Future.successful(MyCaseClass(msg))
case TextMessage.Streamed(stream) => stream
.limit(100) // Max frames we are willing to wait for
.completionTimeout(5 seconds) // Max time until last frame
.runFold("")(_ + _) // Merges the frames
.flatMap(msg => Future.successful(MyCaseClass(msg)))
}
.mapAsync(parallelism = 3)(identity)
.via(createActorFlow())
.map {
case msg: String ⇒ TextMessage.Strict(msg)
}
def createActorFlow(): Flow[MyCaseClass, String, Any] = {
// Set Up Actors as source and sink (not shown)
Flow.fromSinkAndSource(in, out)
}

Using a F# event and asynchronous in multi-threaded code

EDIT/Notice: Event is now thread-safe in current F# implementation.
I'm working a lot with asynchronous workflows and agents in F#. While I was going a little bit deeper into events I noticed that the Event<_>() type is not thread-safe.
Here I'm not talking about the common problem of raising an event. I'm actually talking about subscribing and removing/disposing from an event. For testing purposes, I have written this short program:
let event = Event<int>()
let sub = event.Publish
[<EntryPoint>]
let main argv =
let subscribe sub x = async {
let mutable disposables = []
for i=0 to x do
let dis = Observable.subscribe (fun x -> printf "%d" x) sub
disposables <- dis :: disposables
for dis in disposables do
dis.Dispose()
}
Async.RunSynchronously(async{
let! x = Async.StartChild (subscribe sub 1000)
let! y = Async.StartChild (subscribe sub 1000)
do! x
do! y
event.Trigger 1
do! Async.Sleep 2000
})
0
The program is simple. I create an event and a function that subscribes a specific amount of events to it, and after that dispose every handler. I use another asynchronous computation to spawn two instances of those function with Async.StartChild. After both functions finished I trigger the event to see if there are some handlers still left.
But when event.Trigger(1) is called the result is that there are still some handlers registered to the event. As some "1" will be printed to the console. That in general means that subscribing and/or Disposing is not thread-safe.
And that is what I didn't expected. If subscribing and disposing is not thread-safe, how can events in general safely be used?
Sure events also can be used outside of threads, and a trigger don't spawn any function in parallel or on different threads. But it is somehow normal to me that events are used in Async, agent-based code or in general with threads. They are often used as a communication to gather information of Backroundworker threads.
With Async.AwaitEvent it is possible to subscribe to an event. If subscribing and disposing is not thread-safe, how is it possible to use events in such an environment? And which purpose has Async.AwaitEvent? Considering that an asynchronous workflow does thread, hoping just using Async.AwaitEvent is basically "broken by design" if subscribing/disposing to an event is not thread-safe by default.
The general question I'm facing is: Is it correct that subscribing and disposing is not thread-safe? From my example it seems to look like it, but probably I missed some important detail. I currently use events a lot in my design, and I usually have MailboxProcessors and use events for notification. So the question is. If events are not thread-safe the whole design I'm currently using is not thread-safe at all. So what is an fix for this situation? Creating a whole new thread-safe event implementation? Do some implementations already exist that face this problem? Or are there other options to use events safely in a highly threaded environment?
FYI; the implementation for Event<int> can be found here.
The interesting bit seems to be:
member e.AddHandler(d) =
x.multicast <- (System.Delegate.Combine(x.multicast, d) :?> Handler<'T>)
member e.RemoveHandler(d) =
x.multicast <- (System.Delegate.Remove(x.multicast, d) :?> Handler<'T>)
Subscribing to an event combines the current event handler with the event handler passed into subscribe. This combined event handler replaces the current one.
The problem from a concurrency perspective is that here we have a race-condition in that concurrent subscribers might use the came current event handler to combine with and the "last" one that writes back the handler win (last is a difficult concept in concurrency these days but nvm).
What could be done here is to introduce a CAS loop using Interlocked.CompareAndExchange but that adds performance overhead that hurts non-concurrent users. It's something one could make a PR off though and see if it viewed favourably by the F# community.
WRT to your second question on what to do about it I can just say what I would do. I would go for the option of creating a version of FSharpEvent that supports protected subscribe/unsubscribe. Perhaps base it of FSharpEvent if your company FOSS policy allows it. If it turns out a success then it could form a future PR to F# core libary.
I don't know your requirements but it's also possible that if what you need is coroutines (ie Async) and not threads then it's possible to rewrite the program to use only 1 thread and thus you won't be affected by this race condition.
At first, thanks to FuleSnable for his answer. He pointed me in the right direction. Based on the information he provided I implemented a ConcurrentEvent type myself. This type uses Interlocked.CompareExchange for adding/removing its handlers so it is lock-free and hopefully the fastest way of doing it.
I started the implementation by copying the Event type from the F# Compiler. (I also leave the comment as-is.) The current implementation looks like this:
type ConcurrentEvent<'T> =
val mutable multicast : Handler<'T>
new() = { multicast = null }
member x.Trigger(arg:'T) =
match x.multicast with
| null -> ()
| d -> d.Invoke(null,arg) |> ignore
member x.Publish =
// Note, we implement each interface explicitly: this works around a bug in the CLR
// implementation on CompactFramework 3.7, used on Windows Phone 7
{ new obj() with
member x.ToString() = "<published event>"
interface IEvent<'T>
interface IDelegateEvent<Handler<'T>> with
member e.AddHandler(d) =
let mutable exchanged = false
while exchanged = false do
System.Threading.Thread.MemoryBarrier()
let dels = x.multicast
let newDels = System.Delegate.Combine(dels, d) :?> Handler<'T>
let result = System.Threading.Interlocked.CompareExchange(&x.multicast, newDels, dels)
if obj.ReferenceEquals(dels,result) then
exchanged <- true
member e.RemoveHandler(d) =
let mutable exchanged = false
while exchanged = false do
System.Threading.Thread.MemoryBarrier()
let dels = x.multicast
let newDels = System.Delegate.Remove(dels, d) :?> Handler<'T>
let result = System.Threading.Interlocked.CompareExchange(&x.multicast, newDels, dels)
if obj.ReferenceEquals(dels,result) then
exchanged <- true
interface System.IObservable<'T> with
member e.Subscribe(observer) =
let h = new Handler<_>(fun sender args -> observer.OnNext(args))
(e :?> IEvent<_,_>).AddHandler(h)
{ new System.IDisposable with
member x.Dispose() = (e :?> IEvent<_,_>).RemoveHandler(h) } }
Some notes on the design:
I started with a recursive loop. But doing that and looking at the compiled code it creates an anonymous class and calling AddHandler or RemoveHandler created an object of this. With direct implementation of the while loop it avoids instantiation of an object whenever a new handler is added/removed.
I explicitly used obj.ReferenceEquals to avoid a generic hash equality.
At least in my tests adding/removing a handler now seems to be thread-safe. ConcurrentEvent can just be swapped with the Event type as needed.
A benchmark if people are curious on how much slower the ConcurrentEvent will be compared to Event:
let stopWatch () = System.Diagnostics.Stopwatch.StartNew()
let event = Event<int>()
let sub = event.Publish
let cevent = ConcurrentEvent<int>()
let csub = cevent.Publish
let subscribe sub x = async {
let mutable disposables = []
for i=0 to x do
let dis = Observable.subscribe (fun x -> printf "%d" x) sub
disposables <- dis :: disposables
for dis in disposables do
dis.Dispose()
}
let sw = stopWatch()
Async.RunSynchronously(async{
// Amount of tries
let tries = 10000
// benchmarking Event subscribe/unsubscribing
let sw = stopWatch()
let! x = Async.StartChild (subscribe sub tries)
let! y = Async.StartChild (subscribe sub tries)
do! x
do! y
sw.Stop()
printfn "Event: %O" sw.Elapsed
do! Async.Sleep 1000
event.Trigger 1
do! Async.Sleep 2000
// Benchmarking ConcurrentEvent subscribe/unsubscribing
let sw = stopWatch()
let! x = Async.StartChild (subscribe csub tries)
let! y = Async.StartChild (subscribe csub tries)
do! x
do! y
sw.Stop()
printfn "\nConcurrentEvent: %O" sw.Elapsed
do! Async.Sleep 1000
cevent.Trigger 1
do! Async.Sleep 2000
})
On my system subscribing/unsubscribing 10,000 handlers with the non-thread-safe Event takes around 1.4 seconds to complete.
The thread-safe ConcurrentEvent takes around 1.8 seconds to complete. So I think the overhead is pretty low.

Liftable for function literal

Is there a way to make a Liftable for a functional literal (with 2.11)? If I have
case class Validator[T](predicate: T => Boolean)
val predicate = (s: String) => s.startsWith("Hi")
then I want to be able to quasiquote predicate too:
q"new Validator($predicate)"
I hoped to magically create a Liftable with an underscore. But that was a little too optimistic:
implicit def liftPredicate[T: Liftable](f: T => Boolean) =
Liftable[T => Boolean]{ f => q"$f(_)" }
I couldn't figure out from looking at StandardLiftables how I could solve this one.
Another way of looking at it:
Say I want to create instances from the following class at compile time with a macro:
abstract class ClassWithValidation {
val predicate: String => Boolean
def validate(s: String) = predicate(s)
}
and I retrieve a functional literal from somewhere else as a variable value:
val predicate = (s: String) => s.startsWith("Hi")
Then I want to simply quasiquote that variable into the construction:
q"""new ClassWithValidation {
val predicate = $predicate
// other stuff...
}"""
But it gives me this error:
Error:(46, 28) Can't unquote String => Boolean, consider providing an
implicit instance of Liftable[String => Boolean]
Normally I can just make such implicit Liftable for a custom type. But I haven't found a way doing the same for a functional literal. Is there a way to do this or do I need to look at it another way?
From what I understand, you're trying to go from a function to an abstract syntax tree that represents its source code (so that it can be spliced into a macro expansion). This is a frequent thing that people request (e.g. it comes up often in DSLs), but there's no straightforward way of achieving that in our current macro system.
What you can do about this at the moment is to save the AST explicitly when declaring a function and then load and use it in your macro. The most convenient way of doing this is via another macro: https://gist.github.com/xeno-by/4542402. One could also imagine writing a macro annotation that would work along the same lines.
In Project Palladium, there is a plan to save typechecked trees for every program being compiled. This means that there will most likely be a straightforward API, e.g. treeOf(predicate) that would automatically return abstract syntax tree comprising the source of the predicate. But that's definitely not something set in stone - we'll see how it goes, and I'll report back on the progress during this year's ScalaDays.

Resources