EditorSample.fs

module Elmish.SimpleInput
open System

(**
Minimal application showing how to use Elmish
You can find more info about Emish architecture and samples at https://elmish.github.io/
*)

open Fable.Core.JsInterop
open Fable.Helpers.React
open Fable.Helpers.React.Props
open Elmish
open Elmish.React

// Dialog

type DialogGraph = Node list

and Node = { id:string; content:string; responseMatchers:ResponseMatcher list }
and ResponseMatcher = ExactMatch of ExactMatch | FallToNode of FallToNode
and ExactMatch = {option:string; nodeId:string}
and FallToNode = {nodeId:string}

let node id content matchers = {id=id; content=content;responseMatchers=matchers}

let exactMatch option nodeId = ExactMatch {option=option;nodeId=nodeId}
let goTo nodeId = FallToNode {nodeId=nodeId}

let homeNode =
    node
        "askUserMood"
        "Hello! I am your first bot. How are you?"
        [
            exactMatch "Fine" "sayGreetings"
            exactMatch "Sad" "cheerUp"
            exactMatch "Send nudes bro" "nudes"
        ]

let sayGreetingsNode =
    node
        "sayGreetings"
        "Congratulations! You have a good mood!"
        [
            exactMatch "Ok" "askUserMood"
        ]

let cheerUpNode =
    node
        "cheerUp"
        "Oh, don't be sad, wetbread!"
        [goTo "End"]



// MODEL

type Model =
    { Value : string }

type Msg =
    | ChangeValue of string

let init () = { Value = "" }, Cmd.none

// UPDATE

let update (msg:Msg) (model:Model) =
    match msg with
    | ChangeValue newValue ->
        { Value = newValue }, Cmd.none

// VIEW (rendered with React)

let nodeStyle =
    Style [
        Height 64
        Width 64
        Padding 15
        TextAlign "center"
        Margin 5
        VerticalAlign "middle"
        BackgroundColor "lightgreen"
        FontSize "12"
        Cursor "pointer"
        BoxShadow "0 0 3px black"
    ]

let dialogGraph =
    let drawnNodes = System.Collections.Generic.HashSet<string>()
    let rec buildDialogGraph nodeId graph nodes =
        match graph |> List.tryFind (fun node -> node.id = nodeId) with
            | Some node ->
                if (drawnNodes.Contains node.id)
                    then nodes
                    else 
                        drawnNodes.Add node.id |> ignore
                        let mapMatcher m =
                            match m with
                            | ExactMatch exactMatcher -> 
                                let transitionText = div [] [  ]
                                div 
                                    []
                                    (buildDialogGraph 
                                        exactMatcher.nodeId 
                                        graph 
                                        (List.concat [[transitionText]; nodes; ])
                                    )
                            | FallToNode fallToNode -> 
                                div 
                                    [] 
                                    []

                        let currentNodeRepresentation = div [ nodeStyle ] [ str node.id]
                        let nextNodes = node.responseMatchers |> List.map mapMatcher
                        List.concat [[currentNodeRepresentation]; nextNodes; nodes; ]
            | None -> nodes
    div 
        []
        (buildDialogGraph "askUserMood" [homeNode; sayGreetingsNode; cheerUpNode] [])

let generateMermaidFlowchart =
    let drawnNodes = System.Collections.Generic.HashSet<string>()
    let rec buildDialogGraph nodeId graph nodes =
        match graph |> List.tryFind (fun node -> node.id = nodeId) with
            | Some node ->
                if (drawnNodes.Contains node.id)
                    then nodes
                    else 
                        drawnNodes.Add node.id |> ignore
                        let mapMatcher m =
                            match m with
                            | ExactMatch exactMatcher ->
                                let result = sprintf "%s[%s]-- %s -->%s\n" node.id node.content exactMatcher.option exactMatcher.nodeId
                                result + buildDialogGraph exactMatcher.nodeId graph nodes
                            | FallToNode fallToNode -> 
                                let result = sprintf "%s[%s]-->%s\n" node.id node.content fallToNode.nodeId
                                result + buildDialogGraph fallToNode.nodeId graph nodes
                        let connections = node.responseMatchers |> List.map mapMatcher |> List.reduce (fun a b -> a + "\n" + b)
                        (sprintf "%s[%s]\n" node.id node.content) + connections
            | None -> nodes
    let result = buildDialogGraph "askUserMood" [homeNode; sayGreetingsNode; cheerUpNode] ""
    
    result

let mermaidGraph = str ("graph TD\n\t" + generateMermaidFlowchart)
let mermaidStyles = 
    Style [
        Width 512
    ]
let view model dispatch =
    div [ Class "main-container" ]
        [
            div
                [ mermaidStyles; Class "mermaid"]
                [ 
                    mermaidGraph
                ]
            // mermaidGraph
        ]

// App
Program.mkProgram init update view
|> Program.withConsoleTrace
|> Program.withReactSynchronous "elmish-app"
|> Program.run

<html>

<head>
    <meta http-equiv='Content-Type' content='text/html; charset=utf-8'>
    <script src="__HOST__/libs/react.production.min.js"></script>
    <script src="__HOST__/libs/react-dom.production.min.js"></script>
    <script src="https://unpkg.com/[email protected]/dist/mermaid.min.js"></script>

</head>

<body class="app-container">
    <div id="elmish-app" class="elmish-app"></div>
</body>

</html>