Skip to content

Commit

Permalink
Fix #1863: Binding event to a value
Browse files Browse the repository at this point in the history
  • Loading branch information
alfonsogarciacaro committed Jul 26, 2019
1 parent 3f602ae commit 566b4f3
Show file tree
Hide file tree
Showing 3 changed files with 53 additions and 7 deletions.
21 changes: 15 additions & 6 deletions src/Fable.Transforms/FSharp2Fable.Util.fs
Original file line number Diff line number Diff line change
Expand Up @@ -415,16 +415,25 @@ module Patterns =

/// This matches the boilerplate generated to wrap .NET events from F#
let (|CreateEvent|_|) = function
| Call(Some(Call(None, createEvent,_,_,
[Lambda(_eventDelegate, Call(Some callee, addEvent,[],[],[Value _eventDelegate']));
Lambda(_eventDelegate2, Call(Some _callee2, _removeEvent,[],[],[Value _eventDelegate2']));
Lambda(_callback, NewDelegate(_, Lambda(_delegateArg0, Lambda(_delegateArg1, Application(Value _callback',[],[Value _delegateArg0'; Value _delegateArg1'])))))])),
memb, typArgs, methTypArgs, args)
when createEvent.FullName = Types.createEvent ->
| Call(None,createEvent,_,_,
[Lambda(_eventDelegate, Call(Some callee, addEvent,[],[],[Value _eventDelegate']));
Lambda(_eventDelegate2, Call(Some _callee2, _removeEvent,[],[],[Value _eventDelegate2']));
Lambda(_callback, NewDelegate(_, Lambda(_delegateArg0, Lambda(_delegateArg1, Application(Value _callback',[],[Value _delegateArg0'; Value _delegateArg1'])))))])
when createEvent.FullName = Types.createEvent ->
let eventName = addEvent.CompiledName.Replace("add_","")
Some (callee, eventName)
| _ -> None

let (|CallCreateEvent|_|) = function
| Call(Some(CreateEvent(callee, eventName)), memb, typArgs, methTypArgs, args) ->
Some (callee, eventName, memb, typArgs, methTypArgs, args)
| _ -> None

let (|BindCreateEvent|_|) = function
| Let((var, CreateEvent(value, eventName)), body) ->
Some (var, value, eventName, body)
| _ -> None

let (|ConstructorCall|_|) = function
| NewObject(baseCall, genArgs, baseArgs) -> Some(baseCall, genArgs, baseArgs)
| Call(None, baseCall, genArgs1, genArgs2, baseArgs) when baseCall.IsConstructor ->
Expand Down
9 changes: 8 additions & 1 deletion src/Fable.Transforms/FSharp2Fable.fs
Original file line number Diff line number Diff line change
Expand Up @@ -367,14 +367,21 @@ let private transformExpr (com: IFableCompiler) (ctx: Context) fsExpr =
let body = Fable.Let([ident1, id1Expr], Fable.Let([ident2, id2Expr], restExpr))
return Fable.Let([tupleIdent, tupleExpr], body)

| CreateEvent (callee, eventName, memb, ownerGenArgs, membGenArgs, membArgs) ->
| CallCreateEvent (callee, eventName, memb, ownerGenArgs, membGenArgs, membArgs) ->
let! callee = transformExpr com ctx callee
let! args = transformExprList com ctx membArgs
let callee = get None Fable.Any callee eventName
let genArgs = ownerGenArgs @ membGenArgs |> Seq.map (makeType com ctx.GenericArgs)
let typ = makeType com ctx.GenericArgs fsExpr.Type
return makeCallFrom com ctx (makeRangeFrom fsExpr) typ false genArgs (Some callee) args memb

| BindCreateEvent (var, value, eventName, body) ->
let! value = transformExpr com ctx value
let value = get None Fable.Any value eventName
let ctx, ident = putBindingInScope com ctx var value
let! body = transformExpr com ctx body
return Fable.Let([ident, value], body)

// TODO: Detect if it's ResizeArray and compile as FastIntegerForLoop?
| ForOf (PutArgInScope com ctx (newContext, ident), value, body) ->
let! value = transformExpr com ctx value
Expand Down
30 changes: 30 additions & 0 deletions tests/Main/DateTimeTests.fs
Original file line number Diff line number Diff line change
Expand Up @@ -543,4 +543,34 @@ let tests =
equal 10 !res
t.Stop()
}

testCaseAsync "Assigning an event to a variable works" <| fun () -> // See #1863
let createTimerAndObservable timerInterval =
// setup a timer
let timer = new System.Timers.Timer(float timerInterval)
timer.AutoReset <- true
// events are automatically IObservable
let observable = timer.Elapsed
// return an async task
let task = async {
timer.Start()
do! Async.Sleep 200
timer.Stop()
}
// return a async task and the observable
(task,observable)
// create the timer and the corresponding observable
let basicTimer2 , timerEventStream = createTimerAndObservable 50

let mutable acc = 1
// register that everytime something happens on the
// event stream, print the time.
timerEventStream |> Observable.subscribe (fun _ ->
acc <- acc + 1) |>ignore

async {
do! basicTimer2
printfn "%i" acc
acc > 2 |> equal true
}
]

0 comments on commit 566b4f3

Please sign in to comment.