Dynamic Chart - Fable - f#

I have a project with model update view architecture using fable-elmish. And I have to download files every minute and read those files. How can I download in the update function and how can I read and parsing to Json?
I need to create dynamic charts using Fable too. Someone knows how?
I have part of my code here:
let update (msg : Msg) (model : Model) =
match msg with
| GetData ->
model,
Cmd.ofPromise
(fun () ->
promise {
let wc = new WebClient()
wc.DownloadData("https://www.quandl.com/api/v1/datasets/LBMA/SILVER.json", "SILVER.json")
wc.DownloadData("https://www.quandl.com/api/v1/datasets/LBMA/GOLD.json", "GOLD.json")
// Read 2 files
// Return 2 Json.Object
})
()
(fun silver gold -> GotData silver gold)
(fun e -> GotError e.Message)
| GotData silver gold ->
(Model.SilverData silver, Model.GoldData gold), // I think this doesn't work
Cmd.ofPromise
(fun () -> Promise.sleep 60000)
()
(fun () -> GetData)
(fun e -> GetData)

If you have a periodic event which should cause some action in your Elmish application I would use a subscription. The following code snippet shows a function which sets an interval that causes a command dispatch every 10 minutes.
let timer initial =
let sub dispatch =
window.setInterval(fun _ -> dispatch LoadDataSet; console.log("Timer triggered")
, 1000 * 60 * 10) |> ignore
Cmd.ofSub sub
You would use the Program.withSubscription function to add the subscription to your main dispatch loop.
I would use the Fable PowerPack package for its fetch and promise support to get the datasets. The following code would fetch the documents from your specified endpoints, parse them as values of the DataSet type and return them as a value of the SilverAndGold model type on the successful path of the promise.
type DataSet =
{ column_names : string list
data : (string * float * float * float) list }
type SilverAndGold =
{ Silver : DataSet
Gold : DataSet }
...
let fetchDataSets () = promise {
let! silverData = Fetch.fetchAs<DataSet> "https://www.quandl.com/api/v1/datasets/LBMA/SILVER.json" []
let! goldData = Fetch.fetchAs<DataSet> "https://www.quandl.com/api/v1/datasets/LBMA/GOLD.json" []
return { Silver = silverData; Gold = goldData }
}
In the update function of the Elmish app you can see how the promise execution is triggered. On every LoadDataSet message dispatched by our subscription we create a command of the promise which either results in a DataSetLoaded message containing the datasets or in an Error.
let update (msg:Msg) (model:Model) =
match msg with
| LoadDataSet ->
model, Cmd.ofPromise fetchDataSets () DataSetLoaded Error
| DataSetLoaded silverGold ->
// here you could process you silver and gold datasets
console.log silverGold
Some silverGold, Cmd.none
| Error e -> model, Cmd.none
We can use the Fable bindings for the Recharts library to plot our datasets. The following code shows how we transform and trim the datasets (rendering all datapoints would be quite taxing in the browser) and display them as line charts in the view function.
type ChartDataPoint =
{ Date : string
Usd : float
Gbp : float
Euro : float }
let toChartData (dataSet : DataSet) =
dataSet.data
|> List.map (fun (dt, usd, gbp, eur) ->
{ Date = dt; Usd = usd; Gbp = gbp; Euro = eur } )
|> Array.ofList
|> Array.take 1000
|> Array.rev
let priceChart (chartData : ChartDataPoint[]) =
lineChart
[ Chart.Data chartData
Chart.Width 600.
Chart.Height 500. ] [
xaxis [ Cartesian.DataKey "Date" ] []
yaxis [] []
tooltip [] []
legend [] []
line [ Cartesian.Type "monotone"; Cartesian.DataKey "Gbp" ] []
line [ Cartesian.Type "monotone"; Cartesian.DataKey "Euro" ] []
line [ Cartesian.Type "monotone"; Cartesian.DataKey "Usd" ] []
]
let view (model : SilverAndGold option ) dispatch =
div [ ] [
match model with
| Some sets ->
yield h2 [] [ str "Silver" ]
yield priceChart (toChartData sets.Silver)
yield h2 [] [ str "Gold" ]
yield priceChart (toChartData sets.Gold)
| None ->
yield h2 [] [ str "No data :("]
]
I cooked up a very little Elmish app which includes all these topics. You can find it here here and adapt it according to your needs.

Related

Updating ProgressBar.Value in FsXaml and ElmishWPF

I am trying to update ProgressBar.Value in FsXaml. In C#, I used the below-mentioned code. I haven't tried to implement the C# approach in F# as using a public field (myCaller) does not seem to me as being a functional approach (let alone the fact that I do not know if it is at all possible to use this C# approach in F#).
//C# code
namespace Special_technical_dictionary_CSharp_4._011
{
//...some usings
class ExcelData
{
//...some code
public void WritingIntoDat()
{
//...some code
using (bw = new BinaryWriter(new FileStream(...some params...)))
{
while ((currrowIndex < (lastrowIndex + 1)))
{
//...some code
Form1.myCaller.updateProgressBarValue(100 * currrowIndex);
currrowIndex += 1;
}
bw.Close();
}
//...some code
}
}
}
namespace Special_technical_dictionary_CSharp_4._011
{
//...some usings
public partial class Form1 : Form
{
//...some code
public static Form1 myCaller;
public Form1()
{
InitializeComponent();
myCaller = this;
}
//...some code
public void updateProgressBarValue(int valueV)
=> progressBar.Value = (progressBar.Value == progressBar.Maximum) ? valueV : 0;
//...some code
}
}
My question is: What is the best (or at least good) functional approach in F# (FsXaml/code behind) for updating ProgressBar.Value?
EDIT1:
Irrelevant code and text deleted. Those not interested in Elmish.WPF please wait until an answer related to FsXaml appears.
EDIT2:
Elmish.WPF
I tried to deal with the ProgressBar issue using Bent Tranberg's comments & answer and his excellent example code. My adaptation works for a for-loop, but not for List.map(i)/iter(i), which are collection functions I actually need the progress bar for. Here is the simplified code:
File: MainWindow.fs
//F# code
module Elmish.MainWindow
type ProgressIndicator = Idle | InProgress of percent: int
type Model =
{
ProgressIndicatorLeft: ProgressIndicator
ProgressIndicatorRight: ProgressIndicator
}
let initialModel =
{
ProgressIndicatorLeft = Idle
ProgressIndicatorRight = Idle
}
let init() = initialModel, Cmd.none
type Msg =
| UpdateStatusLeft of progress: int
| WorkIsCompleteLeft
| UpdateStatusRight of progress: int
| WorkIsCompleteRight
| TestButtonLeftEvent
| TestButtonRightEvent
// FOR TESTING PURPOSES ONLY
let private longRunningOperationLeft dispatch = //simulating long running operation
async
{
for i in 1..100 do
do! Async.Sleep 20
dispatch (UpdateStatusLeft i) //THIS WORKS
dispatch WorkIsCompleteLeft
}
// FOR TESTING PURPOSES ONLY
let private longRunningOperationRight dispatch = //simulating long running operation
async //NOT WORKING
{
[1..10000]
|> List.mapi(fun i item ->
[1..100] |> List.reduce (*) |> ignore
dispatch(UpdateStatusRight i)
)
dispatch WorkIsCompleteRight
}
let update (msg: Msg) (m: Model) : Model * Cmd<Msg> =
match msg with
| UpdateStatusLeft progress -> { m with ProgressIndicatorLeft = InProgress progress; ProgressBackgroundLeft = Brushes.White }, Cmd.none
| WorkIsCompleteLeft -> { m with ProgressIndicatorLeft = Idle; ProgressBackgroundLeft = Brushes.LightSkyBlue }, Cmd.none
| UpdateStatusRight progress -> { m with ProgressIndicatorRight = InProgress progress; ProgressBackgroundRight = Brushes.White }, Cmd.none
| WorkIsCompleteRight -> { m with ProgressIndicatorRight = Idle; ProgressBackgroundRight = Brushes.LightSkyBlue }, Cmd.none
| TestButtonLeftEvent ->
let incrementDelayedCmd (dispatch: Msg -> unit) : unit = //THIS WORKS
let delayedDispatch = longRunningOperationLeft dispatch
Async.StartImmediate delayedDispatch
{ m with ProgressIndicatorLeft = InProgress 0 }, Cmd.ofSub incrementDelayedCmd
| TestButtonRightEvent ->
let incrementDelayedCmd (dispatch: Msg -> unit) : unit = //NOT WORKING
let delayedDispatch = longRunningOperationRight dispatch
Async.StartImmediate delayedDispatch
{ m with ProgressIndicatorRight = InProgress 0 }, Cmd.ofSub incrementDelayedCmd
let bindings(): Binding<Model,Msg> list =
[
"ProgressLeftBackg" |> Binding.oneWay(fun m -> m.ProgressBackgroundLeft)
"ProgressRightBackg" |> Binding.oneWay(fun m -> m.ProgressBackgroundRight)
"ProgressLeft" |> Binding.oneWay(fun m -> match m.ProgressIndicatorLeft with Idle -> 0.0 | InProgress v -> float v)
"ProgressRight" |> Binding.oneWay(fun m -> match m.ProgressIndicatorRight with Idle -> 0.0 | InProgress v -> float v)
"TestButtonLeft" |> Binding.cmdIf(TestButtonLeftEvent, fun m -> match m.ProgressIndicatorLeft with Idle -> true | _ -> false)
"TestButtonRight" |> Binding.cmdIf(TestButtonRightEvent, fun m -> match m.ProgressIndicatorRight with Idle -> true | _ -> false)
]
Even if binding the "i" index with the progress bar value had worked for collection functions in the MainWindow, it won't solve the problem. In a real life situation, the collection functions intended to work with the progress bar value are in other files "above" the main window file. Like this:
file: MainLogicRight.fs
//F# code
module MainLogicRight
let textBoxString3 low high path =
//some code
let myArray() =
Directory.EnumerateDirectories(path, "*", SearchOption.TopDirectoryOnly)
|> Option.ofObj
|> optionToArraySort "..." "..."
|> Array.collect
(fun item ->
let arr =
let p = prefix + "*"
Directory.EnumerateDirectories(item, p)
|> Option.ofObj
|> optionToArraySort "..." "..."
|> Array.Parallel.mapi(fun i item ->
let arr = Directory.EnumerateFiles(item, "*.jpg", SearchOption.TopDirectoryOnly)
|> Option.ofObj
|> optionToArraySort "..." "..."
arr.Length
)
arr
)
I understand that it is (probably) not possible to bind the pb value with a non-indexed function such as Array.collect. But what is important - how to bind the pb value with the "i" index in List/Array.mapi/iteri (Array.Parallel.mapi in this case) ?
EDIT3:
Based on the last answer by Bent, the now-irrelevant texts and comments of mine were deleted.
An example based on the answers is here.
This answer explains how, in Elmish.WPF, progress updates to the user interface can be done from an async.
I have created an example on GitHub that demoes this. The example also demoes another way to call async functions and receive results. And it also demoes how to use mkProgram instead of mkSimple. The demo can be used as a starting template for your Elmish.WPF applications.
This snippet from the demo show the essential code involved in updating a user interface from an async.
Both techniques are based on code from the Elmish Book. You will find a lot of code there that is useful also in Elmish.WPF.
I haven't tried to update a progress bar here, only a status text box, but from this you'll very easily figure out what to do to update anything.
| UpdateStatusText statusText ->
{ m with StatusText = statusText }, Cmd.none
| RunWithProgress ->
let incrementDelayedCmd (dispatch: Msg -> unit) : unit =
let delayedDispatch = async {
do! Async.Sleep 1000
dispatch (UpdateStatusText "One")
do! Async.Sleep 1000
dispatch (UpdateStatusText "Two")
do! Async.Sleep 1000
dispatch (UpdateStatusText "Three")
}
Async.StartImmediate delayedDispatch
{ m with StatusText = "Started progress." }, Cmd.ofSub incrementDelayedCmd
UPDATE:
I have now updated the demo project on GitHub so that it demoes updates of a progress bar (and status text) from the async. These are snippets of the essential pieces.
Declaration of the two messages dispatched from the async.
| UpdateStatus of statusText:string * progress:int
| WorkIsComplete // This message could carry a result from the work done.
Handling of the two messages.
| UpdateStatus (statusText, progress) ->
{ m with StatusText = statusText; Progress = progress }, Cmd.none
| WorkIsComplete ->
{ m with StatusText = "Work was completed."; Progress = 0 }, Cmd.none
| RunWithProgress ->
let incrementDelayedCmd (dispatch: Msg -> unit) : unit =
let delayedDispatch = async {
do! Async.Sleep 1000
dispatch (UpdateStatus ("Early work", 30))
do! Async.Sleep 1000
dispatch (UpdateStatus ("Still working", 60))
do! Async.Sleep 1000
dispatch (UpdateStatus ("Late work", 90))
do! Async.Sleep 1000
dispatch WorkIsComplete
}
Async.StartImmediate delayedDispatch
{ m with StatusText = "Started progress." }, Cmd.ofSub incrementDelayedCmd
The field Progress is declared as an int.
Progress: int
The property Value of ProgressBar is a float, so a cast to float is needed in the binding.
"Progress" |> Binding.oneWay (fun m -> float m.Progress)
Of course we can declare Progress in the model as a float, but I wanted to take this opportunity to point out that the model doesn't have to align with the data types of the properties of the components. We can of course map in whatever way we want in the bindings.
One final note on the dispatcher. This is accessible through Cmd.ofSub, and also through WkProgram.Subscribe. More about that on another occasion maybe, but note this now: Sending messages with the dispatcher is thread safe. This means you can send progress messages (or any message) to the model also from async functions that run within your top level async function, or e.g. from a timer event, or anywhere really.
FINAL UPDATE : The demo on GitHub is now slightly more advanced than shown here, but the principle is still the same, so I won't bother to update the source in this answer. Anybody interested in this will most probably need the complete demo source anyway, unless you're already well into Elmish.WPF
The last part of the question, added later, is answered here.
When doing lengthy and/or CPU-intensive work, then this should be done as shown in the longRunningOperationLeft function below. This also shows how functions elsewhere, that should not be dependent on the GUI, can be written in such a way that progress updates can be sent to the GUI.
The longRunningOperationRight shown below is doing it the wrong way, blocking the GUI.
My expertise on async and task stuff is not very good, but I think the top-level async functions (such as longRunningOperationLeft) called from Elmish are running on the same thread as the Elmish loop, and this is why they should not be blocked with anything lengthy or CPU-intensive. Instead, that kind of blocking work needs to go into a child computation (such as workToDo). The role of longRunningOperationLeft is to await work, but not do work itself, lest it blocks the GUI.
I don't know whether List.mapi can have an async operation inside it. I suspect not. Anyhow, I suspect that won't be needed for your real-life case.
UPDATE by Mira: You are right. Not needed in my real-life case. Adding reportProgress i (like in your code) inside List/array.mapi is enough.
let private lengthyWork () =
[1..20_000_000] |> List.reduce ( * ) |> ignore
let private workToDo reportProgress = async {
reportProgress 0
lengthyWork ()
reportProgress 25
lengthyWork ()
reportProgress 50
lengthyWork ()
reportProgress 75
lengthyWork ()
reportProgress 100
return 7
}
// This is good.
let private longRunningOperationLeft dispatch = async {
let reportProgress progress = dispatch (UpdateStatusLeft progress)
let! hardWork = Async.StartChild (workToDo reportProgress)
do! Async.Sleep 1000 // Can do some async work here too, while waiting for hardWork to finish.
let! result = hardWork
dispatch WorkIsCompleteLeft
}
// This is not good. Blocking GUI.
let private longRunningOperationRight dispatch = async {
dispatch (UpdateStatusRight 0)
lengthyWork ()
dispatch (UpdateStatusRight 25)
lengthyWork ()
dispatch (UpdateStatusRight 50)
lengthyWork ()
dispatch (UpdateStatusRight 75)
lengthyWork ()
dispatch (UpdateStatusRight 100)
dispatch WorkIsCompleteRight
}

FsCheck lazy generators

I have issues with generation of data within my tests.
testProperty "calculate Operation against different operations should increase major" <| fun operationIdApi operationIdClient summaryApi summaryClient descriptionApi descriptionClient ->
( notAllEqual [
fun () -> assessEquality <| StringEquals(operationIdApi, operationIdClient)
fun () -> assessEquality <| StringEquals(summaryApi , summaryClient)
fun () -> assessEquality <| StringEquals(descriptionApi, descriptionClient)
]) ==> lazy (
let operationClient = createOpenApiOperation operationIdClient summaryClient descriptionClient
let operationAPI = createOpenApiOperation operationIdApi summaryApi descriptionApi
let actual = calculate operationAPI operationClient
Expect.equal actual (Fact.Semver.IncreaseMajor) "return IncreaseMajor"
)
The code that is actually tested is :
semver {
if operationAPI.OperationId<> operationClient.OperationId then yield! IncreaseMajor
if operationAPI.Summary <> operationClient.Summary then yield! IncreaseMajor
}
The test should fail when the data produced is same OperationId, same summary and different description.
But it does not and it led me to create my own generator or at least try to do so:
I wanted my test to be written like this :
testProperty "calculate Operation against different operations should increase major" <| fun (operationId:ElementSet<string>) (summary:ElementSet<string>) ->
Therefore I create a type accordingly:
type ElementSet<'a> =
| Same of 'a
| Different
and a generator for this type :
let setGen<'a> =
Gen.oneof [
gen {
let! v = Arb.generate<'a>
return Same(v)
}
gen { return Different}
]
type ElementSetGenerator =
static member ElementSet() =
Arb.fromGen setGen<'a>
do Arb.register<ElementSetGenerator>() |> ignore
I was then trying to extract the data to construct my object :
let createOpenApiOperation operationId summary=
let pi = OpenApiOperation(OperationId=operationId.Get, Summary=summary.Get)
pi
The Get method did not exist yet so I was about to implement it by adding a member to my ElementSet<'a>:
type ElementSet<'a> =
| Same of 'a
| Different
with member this.Get =
match this with
| Same s -> s
| Different -> Arb.generate<'a>// some random generation here
And this is where I am stuck. I would love to get some randomness here when I extract data. I wonder if this is the correct way to do so, or if I should have answered the problem earlier?
Thanks for your inputs.
I think I found it, the answer was to handle it at the beginning :
let setGen<'a when 'a:equality> =
Gen.oneof [
gen {
let! v = Arb.generate<'a>
return Same(v)
}
gen {
let! x,y =
Arb.generate<'a>
|> Gen.two
|> Gen.filter (fun (a,b)-> a <> b)
return Different(x,y)
}
]
and then to use two getter to access the values :
type ElementSet<'a> when 'a:equality=
| Same of 'a
| Different of 'a*'a
with member this.Fst = match this with | Same s -> s | Different (a, b)-> a
member this.Snd = match this with | Same s -> s | Different (a, b)-> b
this way I can access values within my test:
testProperty "calculate Operation against different operations should increase major" <| fun (operationId:ElementSet<NonWhiteSpaceString>) (summary:ElementSet<NonWhiteSpaceString>) (description:ElementSet<NonWhiteSpaceString>) ->
let operationClient = createOpenApiOperation operationId.Fst summary.Fst description.Fst
let operationAPI = createOpenApiOperation operationId.Snd summary.Snd description.Snd
let actual = calculate operationAPI operationClient
Expect.equal actual (Fact.Semver.IncreaseMajor) "return IncreaseMajor"
for the record I then have the creation of my stub as follows :
let createOpenApiOperation (operationId:NonWhiteSpaceString) (summary:NonWhiteSpaceString) (description:NonWhiteSpaceString)=
let pi = OpenApiOperation(OperationId=operationId.Get, Summary=summary.Get, Description=description.Get)
pi

Unable to embed document fragment into a WebSharper page trough a `Var<Doc>`

I am quite new to using WebSharper and I might be doing things the wrong way.
My goal is to be able to update the contents of my page as a result of user actions by updating a Var<Doc> variable representing a portion of the page to be updated. I'd be happy to know if I could update a Var<Doc> from server-side code and have it reflect in the user's browser.
Below is a quick example:
let TestPage ctx =
let clientPart = Var.Create <| Doc.Empty
clientPart .Value <- div [] [ text "This content is dynamically inserted" ]
Templating.Main ctx EndPoint.Home "Home" [
h1 [] [text "Below is a dynamically inserted content:"]
div [] [ client <# clientPart .View |> Doc.EmbedView #> ]
]
The error I receive is:
System.Exception: Error during RPC JSON conversion ---> System.Exception: Failed to look up translated field name for write' in type WebSharper.UI.Elt with fields: docNode, elt, rvUpdates, updates
The WebSharper 4 documentation regarding Views also states:
It will only be run while the resulting View is included in the document using one of these methods:
Doc.BindView
Doc.EmbedView
textView
and etc.
A similar error is produced if I try this instead:
type SomeTemplate = Template<"SomeTemplate.html">
clientDoc.Value <- SomeTemplate().Doc()
In the above code, Templating.Main is the same as in the default WebSharper project:
module Templating =
...
let Main ctx action (title: string) (body: Doc list) =
let t = MainTemplate().Title(title).MenuBar(MenuBar ctx action).With("Body", body)
let doc : Doc = t.Doc()
doc |> Content.Page
Here is an example calling an RPC on the server side and storing it into a client Var<>:
module ServerFunctions =
let mutable ServerState = ("Zero", 0)
let [< Rpc >] addToState n = async {
let state, counter = ServerState
let newCounter = counter + n
let newState = if newCounter = 0 then "Zero" else "NonZero"
ServerState <- newState, newCounter
return newState
}
[< JavaScript >]
module ClientFunctions =
open WebSharper
open WebSharper.UI
open WebSharper.UI.Html
open ServerFunctions
let zeroState = Var.Create "do not know"
let clientDoc() =
div [] [
h1 [] [ text "State of zero on server:" ]
h2 [] [ text zeroState.V ]
Doc.Button "increment" [] (fun () -> async { let! state = addToState 1
zeroState.Set state
} |> Async.Start)
Doc.Button "decrement" [] (fun () -> async { let! state = addToState -1
zeroState.Set state
} |> Async.Start)
]
module Server =
open global.Owin
open Microsoft.Owin.Hosting
open Microsoft.Owin.StaticFiles
open Microsoft.Owin.FileSystems
open WebSharper.Owin
open WebSharper.UI.Server
open WebSharper.UI.Html
type EndPointServer =
| [< EndPoint "/" >] Hello
| About
let url = "http://localhost:9006/"
let rootdir = #"..\website"
let site() = WebSharper.Application.MultiPage(fun context (s:EndPointServer) ->
printfn "Serving page: %A" s
Content.Page(
Title= ( sprintf "Test %A" s)
, Body = [ h1 [] [ text <| sprintf "%A" s ]
Html.client <# ClientFunctions.clientDoc() #> ])
)

How to get the selected options of a multiselect in Elm?

I've seen what is required for a getting the selected index of a single select but I'm interested in getting all of the selected options from a multi select. I haven't been able to work out how to do this.
I've attempted the following but I suspect the Json decoder is failing. I'm not 100% sure of that though, because the decoding happens in the virtual dom code and any errors there are thrown away.
type Msg
= SetMultipleInts (List Int)
-- I'm not seeing the SetMultipleInts message when I click on the multiselect
view model =
div []
[ select (onSelect SetMultipleInts) (List.map myOption [1..4]) ]
myOption : Int -> Html Msg
myOption id =
option [ value (toString id) ] [ text <| "Option " ++ (toString id) ]
-- I'm not seeing anything happen in the onchange
onMultiSelect : (List Int -> msg) -> List (Html.Attribute msg)
onMultiSelect msg =
[ on "change" (Json.map msg targetSelectedOptions), multiple True ]
targetSelectedOptions : Json.Decoder (List Int)
targetSelectedOptions =
Json.at [ "target", "selectedOptions" ] (Json.list (Json.at [ "value" ] Json.int))
Can I do this without having to use ports?
The decoder fails because event.target.selectedOptions is not a
javascript array. When you cannot use Json.Decode.list, you
can use Json.Decode.keyValuePairs.
Here is the example how you can use it.
You may want to change extractValues below depending
on how you want to react to empty selection and such.
targetSelectedOptions : Json.Decoder (List String)
targetSelectedOptions =
let
maybeValues =
Json.at [ "target", "selectedOptions" ]
<| Json.keyValuePairs
<| Json.maybe ("value" := Json.string)
extractValues mv =
Ok (List.filterMap snd mv)
in Json.customDecoder maybeValues extractValues
In case someone need a multiselect in Elm, I rewrote a fully working example in Elm 0.19:
https://ellie-app.com/g7WrS9cV4zVa1
module Main exposing (main)
import Browser
import Html exposing (..)
import Html.Attributes
import Html.Events
import Json.Decode
type alias Model =
{ value : List ( String, Maybe String ) }
init : Model
init =
{ value = [] }
type Msg
= SetMultipleInts (List ( String, Maybe String ))
update : Msg -> Model -> Model
update msg model =
case msg of
SetMultipleInts value ->
{ model | value = value }
view : Model -> Html Msg
view model =
div []
[ select
[ Html.Events.on "change"
(Json.Decode.map SetMultipleInts targetSelectedOptions)
, Html.Attributes.multiple True
]
(List.map myOption (List.range 1 4))
, div []
[ text <|
Debug.toString
(model
|> .value
|> List.map Tuple.second
|> List.filterMap identity
)
]
]
targetSelectedOptions : Json.Decode.Decoder (List ( String, Maybe String ))
targetSelectedOptions =
Json.Decode.at [ "target", "selectedOptions" ] <|
Json.Decode.keyValuePairs <|
Json.Decode.maybe (Json.Decode.at [ "value" ] Json.Decode.string)
myOption : Int -> Html Msg
myOption id =
option [ Html.Attributes.value (String.fromInt id) ]
[ text <| "Option " ++ String.fromInt id ]
main : Program () Model Msg
main =
Browser.sandbox
{ init = init
, view = view
, update = update
}

Parse sequence of tokens into hierarchical type in F#

I processed some HTML to extract various information from a website (no proper API exists there), and generated a list of tokens using an F# discriminated union. I have simplified my code to the essence:
type tokens =
| A of string
| B of int
| C of string
let input = [A "1"; B 2; C "2.1"; C "2.2"; B 3; C "3.1"]
// how to transform the input to the following ???
let desiredOutput = [A "1", [[ B 2, [ C "2.1"; C "2.2" ]]; [B 3, [ C "3.1" ]]]]
This roughly corresponds to parsing the grammar: g -> A b* ; b -> B c* ; c-> C
The key thing is my token list is flat, but I want to work with the hierarchy implied by the grammar.
Perhaps there is another representation of my desiredOutput which would be better; what I really want to do is process exactly one A followed by a zero or more sequence of Bs, which happen to contain zero or more Cs.
I've looked at parser combinators articles, e.g. about FParsec, but I couldn't find a good solution that allows me to start from a list of tokens rather than a stream of characters. I'm familiar with imperative techniques for parsing, but I don't know what is idiomatic F#.
Progress made due to Answer
Thanks to the answer from Vandroiy, I was able to write the following to move forward a hobby project I am working on to learn idiomatic F# (and also to scrape quiz websites).
// transform flat data scraped from a Quiz website into a hierarchical data structure
type ScrapedQuiz =
| Title of string
| Description of string
| Blurb of string * picture: string
| QuizId of string
| Question of num:string * text:string * picture : string
| Answer of text:string
| Error of exn
let input =
[Title "Example Quiz Scraped from a website";
Description "What the Quiz is about";
Blurb ("more details","and a URL for a picture");
Question ("#1", "How good is F#", "URL to picture of new F# logo");
Answer ("we likes it");
Answer ("we very likes it");
Question ("#2", "How useful is Stack Overflow", "URL to picture of Stack Overflow logo");
Answer ("very good today");
Answer ("lobsters");
]
type Quiz =
{ Title : string
Description : string
Blurb : string * PictureURL
Questions : Quest list }
and Quest =
{ Number : string
Text : string
Pic : PictureURL
Answers : string list}
and PictureURL = string
let errorMessage = "unexpected input format"
let parseList reader input =
let rec run acc inp =
match reader inp with
| Some(o, inp') -> run (o :: acc) inp'
| None -> List.rev acc, inp
run [] input
let readAnswer = function Answer(a) :: t -> Some(a, t) | _ -> None
let readDescription =
function Description(a) :: t -> (a, t) | _ -> failwith errorMessage
let readBlurb = function Blurb(a,b) :: t -> ((a,b),t) | _ -> failwith errorMessage
let readQuests = function
| Question(n,txt,pic) :: t ->
let answers, input' = parseList readAnswer t
Some( { Number=n; Text=txt; Pic=pic; Answers = answers}, input')
| _ -> None
let readQuiz = function
| Title(s) :: t ->
let d, input' = readDescription t
let b, input'' = readBlurb input'
let qs, input''' = parseList readQuests input''
Some( { Title = s; Description = d; Blurb = b; Questions = qs}, input''')
| _ -> None
match readQuiz input with
| Some(a, []) -> a
| _ -> failwith errorMessage
I could not have written this yesterday; neither the target data type, nor the parsing code. I see room for improvement, but I think I have started to meet my goal of not writing C# in F#.
Indeed, it might help to first find a good representation.
Original output format
I presume the suggested output form, in standard printing, would be:
[(A "1", [(B 2, [C "2.1"; C "2.2"]); (B 3, [C "3.1"])])]
(This differs from the one in the question in the amount of list levels.) The code I used to get there is ugly. In part, this is because it abstracts at an awkward position, constraining input and output types very far without giving them a well-defined type. I'm posting it for the sake of completeness, but I recommend to skip over it.
let rec readBranch checkOne readInner acc = function
| h :: t when checkOne h ->
let dat, inp' = readInner t
readBranch checkOne readInner ((h, dat) :: acc) inp'
| l -> List.rev acc, l
let rec readCs acc = function
| C(s) :: t -> readCs (C(s) :: acc) t
| l -> List.rev acc, l
let readBs = readBranch (function B _ -> true | _ -> false) (readCs []) []
let readAs = readBranch (function A _ -> true | _ -> false) readBs []
input |> readAs |> fst
Surely, other people can do this more sensibly, but I doubt it would tackle the main problem: we're just projecting one weird data structure to the next. If it is difficult to read or formulate a parser's output format, there is probably something going wrong.
Strongly typed output
Rather than focus on how we are parsing, I prefer to first pay attention to what we are parsing into. These A B C things don't mean anything to me. Let's say they represent objects:
type Bravo =
{ ID : int
Charlies : string list }
type Alpha =
{ Name : string
Bravos : Bravo list }
There are two places where sequences of objects of the same type are parsed. Let's create a helper that repeatedly uses a specific parser to read a list of objects:
/// Parses objects into a list. reader takes an input and returns either
/// Some(parsed item, new input state), or None if the list is finished.
/// Returns a list of parsed objects and the remaining input.
let parseList reader input =
let rec run acc inp =
match reader inp with
| Some(o, inp') -> run (o :: acc) inp'
| None -> List.rev acc, inp
run [] input
Note that this is quite generic in the type of input. This helper could be used with strings, sequences, or whatever.
Now, we add concrete parsers. The following functions have the signature used in reader in the helper; they either return the parsed object and the remaining input, or None if parsing wasn't possible.
let readC = function C(s) :: t -> Some(s, t) | _ -> None
let readB = function
| B(i) :: t ->
let charlies, input' = parseList readC t
Some( { ID = i; Charlies = charlies }, input' )
| _ -> None
let readA = function
| A(s) :: t ->
let bravos, input' = parseList readB t
Some( { Name = s; Bravos = bravos }, input' )
| _ -> None
The code for reading Alphas and Bravos is practically a duplicate. If that happens in production code, I would recommend again to check whether the data structure is optimal, and only look at improving the algorithm afterwards.
We request to read one A into one Alpha, which was the goal after all:
match readA input with
| Some(a, []) -> a
| _ -> failwith "Unexpected input format"
There may be many better ways to do the parsing, especially when knowing more about the exact problem. The important fact is not how the parser works, but what the output looks like, which will be the focus when actual work is done in the program. The second version's output should be much easier to navigate in both code and debugger:
val it : Alpha =
{ Name = "1";
Bravos = [ { ID = 2; Charlies = ["2.1"; "2.2"] }
{ ID = 3; Charlies = ["3.1"] } ] }
One could take this a step further and replace the tokenized data structure with DOM (Document Object Model). Then, the first step would be to read HTML into DOM using a standard parsing library. In a second step, the concrete parsers would construct objects, using the DOM representation as input, calling one another top-down.
To work with structured hierarchy, you have to create matching structure of types. Something like
type
RootType = Level1 list
and
Level1 =
| A of string
| B of Level2 list
| C of string
and
Level2 =
{ b: int; c: string list }

Resources