File Upload using Fable-Elmish - f#

I want to upload a file to my Fable-Elmish, end so that I can then send it to the server for processing. However, I can't find any documentation / samples to cover this. This is my update function:
let update msg model : Model * Cmd<Msg> =
match msg with
| QueryResults ->
{model with results = None}, Cmd.ofPromise getData "" FetchSuccess FetchFailure
| FetchSuccess data ->
{ model with results = Some data }, []
| FetchFailure ex ->
Browser.console.log (unbox ex.Message)
Browser.console.log "exception occured" |> ignore
model, []
| FileUploaded ->
Browser.console.log "file selected!" |> ignore
model, []
And this is the part of the view function containing the file upload:
R.input [
Type "file"
OnChange (fun x -> FileUploaded |> ignore)
] []
As far as I can tell, this should trigger the update and print out "file uploaded!" to the console, but nothing is happening.
If anyone could point me in the right direction here that would be great.

You're passing the FileUploaded message to ignore, which does just what its name says: ignore its arguments and do nothing. So that message won't actually go anywhere.
With Fable-Elmish, your view function takes an argument called dispatch, which is a function that will take a message and put it into the message queue (so that update will receive the message at some later time). Look at the TodoMVC sample, and especially the onEnter and viewModel functions, for details.
Basically, your OnChange (fun x -> FileUploaded |> ignore) line should have been OnChange (fun x -> FileUploaded |> dispatch) instead.

Related

Is there a way in F# to chain computation?

I would like to create a chain of expressions and any of them can fail when the computation should just stop.
With Unix pipes it is usually like this:
bash-3.2$ echo && { echo 'a ok'; echo; } && { echo 'b ok'; echo; }
a ok
b ok
When something fails the pipeline stops:
echo && { echo 'a ok'; false; } && { echo 'b ok'; echo; }
a ok
I can handle Optionals but my problem is that I might want to do multiple things in each branch:
let someExternalOperation = callToAnAPI()
match someExternalOperation with
| None -> LogAndStop()
| Some x -> LogAndContinue()
Then I would like to keep going with other API calls and only stop if there is an error.
Is there something like that in F#?
Update1:
What I am trying to do is calling out to external APIs. Each call can fail. Would be nice to try to retry but not required.
You can use the F# Async and Result types together to represent the results of each API Call. You can then use the bind functions for those types to build a workflow in which you only continue processing when the previous calls were successful. In order to make that easier, you can wrap the Async<Result<_,_>> you would be working with for each api call in its own type and build a module around binding those results to orchestrate a chained computation. Here's a quick example of what that would look like:
First, we would lay out the type ApiCallResult to wrap Async and Result, and we would define ApiCallError to represent HTTP error responses or exceptions:
open System
open System.Net
open System.Net.Http
type ApiCallError =
| HttpError of (int * string)
| UnexpectedError of exn
type ApiCallResult<'a> = Async<Result<'a, ApiCallError>>
Next, we would create a module to work with ApiCallResult instances, allowing us to do things like bind, map, and return so that we can process the results of a computation and feed them into the next one.
module ApiCall =
let ``return`` x : ApiCallResult<_> =
async { return Ok x }
let private zero () : ApiCallResult<_> =
``return`` []
let bind<'a, 'b> (f: 'a -> ApiCallResult<'b>) (x: ApiCallResult<'a>) : ApiCallResult<'b> =
async {
let! result = x
match result with
| Ok value ->
return! f value
| Error error ->
return Error error
}
let map f x = x |> bind (f >> ``return``)
let combine<'a> (acc: ApiCallResult<'a list>) (cur: ApiCallResult<'a>) =
acc |> bind (fun values -> cur |> map (fun value -> value :: values))
let join results =
results |> Seq.fold (combine) (zero ())
Then, you would have a module to simply do your API calls, however that works in your real scenario. Here's one that just handles GETs with query parameters, but you could make this more sophisticated:
module Api =
let call (baseUrl: Uri) (queryString: string) : ApiCallResult<string> =
async {
try
use client = new HttpClient()
let url =
let builder = UriBuilder(baseUrl)
builder.Query <- queryString
builder.Uri
printfn "Calling API: %O" url
let! response = client.GetAsync(url) |> Async.AwaitTask
let! content = response.Content.ReadAsStringAsync() |> Async.AwaitTask
if response.IsSuccessStatusCode then
let! content = response.Content.ReadAsStringAsync() |> Async.AwaitTask
return Ok content
else
return Error <| HttpError (response.StatusCode |> int, content)
with ex ->
return Error <| UnexpectedError ex
}
let getQueryParam name value =
value |> WebUtility.UrlEncode |> sprintf "%s=%s" name
Finally, you would have your actual business workflow logic, where you call multiple APIs and feed the results of one into another. In the below example, anywhere you see callMathApi, it is making a call to an external REST API that may fail, and by using the ApiCall module to bind the results of the API call, it only proceeds to the next API call if the previous call was successful. You can declare an operator like >>= to eliminate some of the noise in the code when binding computations together:
module MathWorkflow =
let private (>>=) x f = ApiCall.bind f x
let private apiUrl = Uri "http://api.mathjs.org/v4/" // REST API for mathematical expressions
let private callMathApi expression =
expression |> Api.getQueryParam "expr" |> Api.call apiUrl
let average values =
values
|> List.map (sprintf "%d")
|> String.concat "+"
|> callMathApi
>>= fun sum ->
sprintf "%s/%d" sum values.Length
|> callMathApi
let averageOfSquares values =
values
|> List.map (fun value -> sprintf "%d*%d" value value)
|> List.map callMathApi
|> ApiCall.join
|> ApiCall.map (List.map int)
>>= average
This example uses the Mathjs.org API to compute the average of a list of integers (making one API call to compute the sum, then another to divide by the number of elements), and also allows you to compute the average of the squares of a list of values, by calling the API asynchronously for each element in the list to square it, then joining the results together and computing the average. You can use these functions as follows (I added a printfn to the actual API call so it logs the HTTP requests):
Calling average:
MathWorkflow.average [1;2;3;4;5] |> Async.RunSynchronously
Outputs:
Calling API: http://api.mathjs.org/v4/?expr=1%2B2%2B3%2B4%2B5
Calling API: http://api.mathjs.org/v4/?expr=15%2F5
[<Struct>]
val it : Result<string,ApiCallError> = Ok "3"
Calling averageOfSquares:
MathWorkflow.averageOfSquares [2;4;6;8;10] |> Async.RunSynchronously
Outputs:
Calling API: http://api.mathjs.org/v4/?expr=2*2
Calling API: http://api.mathjs.org/v4/?expr=4*4
Calling API: http://api.mathjs.org/v4/?expr=6*6
Calling API: http://api.mathjs.org/v4/?expr=8*8
Calling API: http://api.mathjs.org/v4/?expr=10*10
Calling API: http://api.mathjs.org/v4/?expr=100%2B64%2B36%2B16%2B4
Calling API: http://api.mathjs.org/v4/?expr=220%2F5
[<Struct>]
val it : Result<string,ApiCallError> = Ok "44"
Ultimately, you may want to implement a custom Computation Builder to allow you to use a computation expression with the let! syntax, instead of explicitly writing the calls to ApiCall.bind everywhere. This is fairly simple, since you already do all the real work in the ApiCall module, and you just need to make a class with the appropriate Bind/Return members:
type ApiCallBuilder () =
member __.Bind (x, f) = ApiCall.bind f x
member __.Return x = ApiCall.``return`` x
member __.ReturnFrom x = x
member __.Zero () = ApiCall.``return`` ()
let apiCall = ApiCallBuilder()
With the ApiCallBuilder, you could rewrite the functions in the MathWorkflow module like this, making them a little easier to read and compose:
let average values =
apiCall {
let! sum =
values
|> List.map (sprintf "%d")
|> String.concat "+"
|> callMathApi
return!
sprintf "%s/%d" sum values.Length
|> callMathApi
}
let averageOfSquares values =
apiCall {
let! squares =
values
|> List.map (fun value -> sprintf "%d*%d" value value)
|> List.map callMathApi
|> ApiCall.join
return! squares |> List.map int |> average
}
These work as you described in the question, where each API call is made independently and the results feed into the next call, but if one call fails the computation is stopped and the error is returned. For example, if you change the URL used in the example calls here to the v3 API ("http://api.mathjs.org/v3/") without changing anything else, you get the following:
Calling API: http://api.mathjs.org/v3/?expr=2*2
[<Struct>]
val it : Result<string,ApiCallError> =
Error
(HttpError
(404,
"<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<title>Error</title>
</head>
<body>
<pre>Cannot GET /v3/</pre>
</body>
</html>
"))

Why isn't my actor receiving a message?

Issue:
I am struggling to understand why my Reporter actor is not receiving messages based on the following statement that's in my Generator actor:
reporter <! Message input
My reporter actor is the following:
let reporterActor (mailbox:Actor<_>) =
let rec loop() = actor { let! msg = mailbox.Receive()
match msg |> box :?> Command with
| Start -> ()
| Message v -> printf "%s" v
| Exit -> mailbox.Context.System.Terminate() |> ignore }
loop() |> ignore
Basically, a console is launched that accepts input from the user. My Generator actor forwards that input to my Reporter actor. However, the code above never gets executed.
The code is the following:
module Main
open System
open Akka.FSharp
open Akka.Actor
open Actors
type Command =
| Message of string
| Start | Exit
let reporterActor (mailbox:Actor<_>) =
let rec loop() = actor { let! msg = mailbox.Receive()
match msg |> box :?> Command with
| Start -> ()
| Message v -> printf "%s" v
| Exit -> mailbox.Context.System.Terminate() |> ignore }
loop() |> ignore
let generatorActor (reporter:IActorRef) (mailbox:Actor<_>) message =
let handle input = match input with
| "exit" -> mailbox.Context.System.Terminate |> ignore
| _ -> reporter <! Message input
handle (Console.ReadLine().ToLower())
[<EntryPoint>]
let main argv =
let system = System.create "system" (Configuration.load())
let reporterActor = spawn system "reporterActor" (actorOf(reporterActor))
let generatorActor = spawn system "generatorActor" (actorOf2(generatorActor reporterActor))
generatorActor <! Start
system.AwaitTermination ()
0
Update:
I learned that I could trigger my Reporter actor by replacing the mailbox parameter with an arbitrary message parameter:
let reporterActor message =
match message |> box :?> Command with
| Start -> ()
| Message v -> printf "Reporting: %s" v
| Exit -> failwith "Kill this!"
I still don't understand when I should use a mailbox parameter versus when I should rely on a message parameter.
The difference is in how actorOf and actorOf2 work.
actorOf in conjunction with spawn creates an actor as a child of the root of the system which will handle messages with the function 'Message -> unit that was passed to it.
actorOf2 in in conjunction with spawn creates an actor as a child of the actor that you passed in and the child will handle the messages with the function 'Message -> unit that was passed.
Your original function signature for reporter actor was:
Actor<'Message> -> unit
and you used spawn system "reporterActor" (actorOf(reporterActor))
In this case you were saying that the message type that the new actor that was created would receive would be of type Actor<'Message> . This compiled because actorof just expects a function that takes a 'Message, and a 'Message is generic therefore Actor<'Message> satisfied the 'Message parameter.
When you updated the signature of reporterActor you change the signature to 'Message -> unit which is what actorOf is actually intended to accept.
In short generics allowed your code to compile since 'Message isn't really restricted, nor should it really be.
From: http://getakka.net/docs/FSharp%20API
actorOf (fn : 'Message -> unit) (mailbox : Actor<'Message>) :
Cont<'Message, 'Returned> - uses a function, which takes a message as
the only parameter. Mailbox parameter is injected by spawning
functions.
actorOf2 (fn : Actor<'Message> -> 'Message -> unit) (mailbox :
Actor<'Message>) : Cont<'Message, 'Returned> - uses a function, which
takes both the message and an Actor instance as the parameters.
Mailbox parameter is injected by spawning functions. Example:
> let handleMessage (mailbox: Actor<'a>) msg =
> match msg with
> | Some x -> printf "%A" x
> | None -> ()
>
> let aref = spawn system "my-actor" (actorOf2 handleMessage) let
> blackHole = spawn system "black-hole" (actorOf (fun msg -> ()))
spawn (actorFactory : IActorRefFactory) (name : string) (f :
Actor<'Message> -> Cont<'Message, 'Returned>) : IActorRef - spawns an
actor using a specified actor computation expression. The actor can
only be used locally.
All of these functions may be used with either the actor system or the
actor itself. In the first case the spawned actor will be placed under
/user root guardian of the current actor system hierarchy. In the
second option the spawned actor will become a child of the actor used
as the actorFactory parameter of the spawning function.

Is that possible to create a class instance with webpart GET values

I created a "Game" class and i'm trying to use values from my webpart path to create an instance of it.
My instance need a playerName so i tried to create one with the name value
let g:game.Game = new game.Game()
let php =
request (fun r ->
match r.queryParam "playerName" with
| Choice1Of2 name -> new game.Game(1,name,"hyy")//OK (sprintf "playerName: %s" name)
| Choice2Of2 msg -> BAD_REQUEST msg)
let webPart =
choose [
path "/" >=> (OK "Home")
path "/elm/api/create.php" >=> php
]
startWebServer defaultConfig webPart
but it doesn't work because this expression is supposed to be HttpContext type and not Game type.
I'd like to create an instance and call class's methods depending on my path values.
first: you cant return 2 different types from your function
let php =
request (fun r ->
match r.queryParam "playerName" with
| Choice1Of2 name -> new game.Game(1,name,"hyy")
^^^^^^^^^^^
//should probably be a OK
//OK (sprintf "playerName: %s" name)
| Choice2Of2 msg -> BAD_REQUEST msg)
Then you also should Jsonify your Game object. So probably your code should look somehow like this
| Choice1Of2 name ->
new game.Game(1,name,"hyy")
|> toJson
|> OK
please substitute toJson with a call of your chosen Json library

How do I invoke a function value that serves as a parameter on a function?

How do I invoke a function value that serves as a parameter on a function?
Specifically, my goal is to leverage a parameter of a function in which the parameter is actually a function.
In my case, I am trying to implement an interface for logging data.
Here's my code:
let logToFile (filePath:string) (message:string) =
let file = new System.IO.StreamWriter(filePath)
file.WriteLine(message)
file.Close()
let makeInitialDeposit deposit =
let balance = deposit |> insert []
sprintf "Deposited: %f" balance
let logDeposit deposit (log:'medium ->'data -> unit) =
deposit |> makeInitialDeposit
|> log
Note the following function:
let logDeposit deposit (log:'medium ->'data -> unit) =
deposit |> makeInitialDeposit
|> log
I get a compile error on the log function:
This construct causes code to be less generic than indicated by the
type annotations. The type variable 'medium has been constrained to be
type 'string'.
I understand that makeInitialDeposit returns string.
However, that string type is mapped to the generic type 'data.
Hence, a generic can be of any type right?
I then tried supplying the medium (i.e. file) argument:
let logDeposit deposit (log:'medium ->'data -> unit) medium =
deposit |> makeInitialDeposit
|> log medium
Then my error got updated to:
This construct causes code to be less generic than indicated by the
type annotations. The type variable 'data has been constrained to be
type 'string'.
My Goal
Ultimately, I just want to have an interface called log and pass in an implementation of that interface (i.e. logToFile).
Any guidance on how I should interpret the compile error based on my initial interpretation?
Insert function dependencies
let getBalance coins =
coins |> List.fold (fun acc d -> match d with
| Nickel -> acc + 0.05
| Dime -> acc + 0.10
| Quarter -> acc + 0.25
| OneDollarBill -> acc + 1.00
| FiveDollarBill -> acc + 5.00) 0.00
let insert balance coin =
coin::balance |> getBalance
The issue is that you have defined log :'medium ->'data -> unit.
You then take the result of deposit |> makeInitialDeposit, which has type string and pipe it into the log function. The compiler, logically, then infers that 'medium = string.
If you accept a 'medium argument in your logDeposit function then you simply move that inference along a step, deposit |> makeInitialDeposit is still a string so now 'data = string.
I think you are struggling though because these functions don't well model your domain and your logging logic is bleeding out into the rest of your code.
Why does makeInitialDeposit return a string?
Why does getBalance return a float but insert accepts a Coin list as its balance argument?
I would start by making a logging function that accepts three arguments:
let logToFile (filePath:string) (formatf : 'data -> string) data =
use file = new System.IO.StreamWriter(filePath)
file.WriteLine(formatf data)
data
It has type filePath : string -> (formatf : 'data -> string) -> (data : 'data) -> data. It accepts a path to log to, a function that formats something of type 'data as a string and some 'data to log to the file. Finally, it returns the data argument you supplied unchanged. That means you can, in principle, insert logging of any arbitrary value in your code anywhere.
I then set up some functions in the domain like this:
let valueOf = function
| Nickel -> 0.05m
| Dime -> 0.10m
| Quarter -> 0.25m
| OneDollarBill -> 1.00m
| FiveDollarBill -> 5.00m
let totalValue coins =
coins |> List.fold (fun acc coin -> acc + valueOf coin) 0.0m
let insert coins coin = coin::coins // returns Coin list
let makeInitialDeposit deposit = insert [] deposit // returns Coin list
I can then use these functions, inserting logging at any arbitrary point:
let balance =
makeInitialDeposit OneDollarBill
|> logToFile "file.txt" (sprintf "Initial Deposit: %A")
|> totalValue
|> logToFile "file2.txt" (sprintf "Balance : $%M")
This approach lets you fit logging around your domain rather than building your domain around logging.
First off, it seems odd that you're passing in a string like "Deposited: 0.25" as your path name. What you probably wanted is to have message as your first parameter and filePath as your second parameter for logToFile. And accordingly for log to be 'data -> 'medium -> unit.
Getting that out of the way, the issue for your compiler error is that makeInitialDeposit returns a string and when you then pipe that result into log the constraint happens. One way to get it to work is to add another parameter to logDeposit to converts string to 'data like this:
let logDeposit deposit (log: 'data ->'medium-> unit) (stringConverter: string -> 'data) =
deposit |> makeInitialDeposit
|> stringConverter
|> log
With this something like let dummyLog (a:int) (b:string) = () will work assuming you pass in the appropriate converter from string to int.

Why is my MailboxProcessor hanging?

I can't work out why the following code is hanging at the call to GetTotal. I don't seem to be able to debug inside the MailboxProcessor, so it's hard to see what's going on.
module Aggregator
open System
type Message<'T, 'TState> =
| Aggregate of 'T
| GetTotal of AsyncReplyChannel<'TState>
type Aggregator<'T, 'TState>(initialState, f) =
let myAgent = new MailboxProcessor<Message<'T, 'TState>>(fun inbox ->
let rec loop agg =
async {
let! message = inbox.Receive()
match message with
| Aggregate x -> return! loop (f agg x)
| GetTotal replyChannel ->
replyChannel.Reply(agg)
return! loop agg
}
loop initialState
)
member m.Aggregate x = myAgent.Post(Aggregate(x))
member m.GetTotal = myAgent.PostAndReply(fun replyChannel -> GetTotal(replyChannel))
let myAggregator = new Aggregator<int, int>(0, (+))
myAggregator.Aggregate(3)
myAggregator.Aggregate(4)
myAggregator.Aggregate(5)
let totalSoFar = myAggregator.GetTotal
printfn "%d" totalSoFar
Console.ReadLine() |> ignore
It seems to work fine when using an identical MailboxProcessor directly, rather than wrapping in the Aggregator class.
The problem is that you did not start the agent. You can either call Start after you create the agent:
let myAgent = (...)
do myAgent.Start()
Alternatively, you can create the agent using MailboxProcessor<'T>.Start instead of calling the constructor (I usually prefer this option, because it looks more functional):
let myAgent = MailboxProcessor<Message<'T, 'TState>>.Start(fun inbox -> (...) )
I suppose that you couldn't debug the agent, because the code inside agent wasn't actually running. I tried adding printfn "Msg: %A" message right after the call to Receive inside the agent (to print incoming messages for debugging) and I noticed that, after calling Aggregate, no messages were actually received by the agent... (It only blocked after calling GetTotal, which avaits reply)
As a side-note, I would probably turn GetTotal into a method, so you'd call GetTotal(). Properties are re-evaluated each time you access them, so your code does the same thing, but best practices don't recommend using properties that do complex work.
You forgot to start the mailbox:
open System
type Message<'T, 'TState> =
| Aggregate of 'T
| GetTotal of AsyncReplyChannel<'TState>
type Aggregator<'T, 'TState>(initialState, f) =
let myAgent = new MailboxProcessor<Message<'T, 'TState>>(fun inbox ->
let rec loop agg =
async {
let! message = inbox.Receive()
match message with
| Aggregate x -> return! loop (f agg x)
| GetTotal replyChannel ->
replyChannel.Reply(agg)
return! loop agg
}
loop initialState
)
member m.Aggregate x = myAgent.Post(Aggregate(x))
member m.GetTotal = myAgent.PostAndReply(fun replyChannel -> GetTotal(replyChannel))
member m.Start() = myAgent.Start()
let myAggregator = new Aggregator<int, int>(0, (+))
myAggregator.Start()
myAggregator.Aggregate(3)
myAggregator.Aggregate(4)
myAggregator.Aggregate(5)
let totalSoFar = myAggregator.GetTotal
printfn "%d" totalSoFar
Console.ReadLine() |> ignore

Resources