SampleDsl.fs

// Learn more about F# at http://fsharp.org

open System

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
        "home"
        "Hello! I am your first bot. How are you?"
        [
            exactMatch "Fine" "sayGreetings"
            exactMatch "Sad" "cheerUp"
        ]

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

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



let rec devRun graph =
    let rec devRunLoop graph nodeId =

        match graph |> List.tryFind (fun node -> node.id = nodeId) with
            | Some currentNode ->
                printf "%s\n\n" currentNode.content

                let mutable haveMatchers = false
                for responseMatcher in currentNode.responseMatchers do
                    match responseMatcher with
                    | ExactMatch m ->
                        haveMatchers <- true
                        printf "  > %s\n" m.option
                    | _ -> ()
                
                if haveMatchers
                    then
                        let userResponse = Console.ReadLine()
                        for responseMatcher in currentNode.responseMatchers do
                            match responseMatcher with
                            | FallToNode f -> devRunLoop graph f.nodeId
                            | ExactMatch m when m.option = userResponse-> devRunLoop graph m.nodeId
                            | _ -> ()
                    else
                        for responseMatcher in currentNode.responseMatchers do
                        match responseMatcher with
                            | FallToNode f -> devRunLoop graph f.nodeId
                            | _ -> ()

                printf "I can't understand you! Please, repeat!"

            | None -> raise (InvalidOperationException("I dont play this game anymore!"))
        ()

    let firstNodeId = graph |> List.head |> fun n -> n.id
    devRunLoop graph firstNodeId


let main argv =
    devRun [homeNode; sayGreetingsNode; cheerUpNode]
    0 // return an integer exit code


main [||] |> ignore