/r/dailyprogrammer 2015-04-29 in F#

Program.fs

open System
open System.IO
open Newtonsoft.Json

let printfln fmt = Printf.kprintf (fun s -> printf "%s%s" s Environment.NewLine) fmt

type Node = Question of (string * Node ref * Node ref) | Animal of string | Empty with
    member this.AsImmutable : INode =
        match this with
        | Question (question, yes, no) -> IQuestion (question, (!yes).AsImmutable, (!no).AsImmutable)
        | Animal (name) -> IAnimal (name)
        | Empty -> IEmpty

and INode = IQuestion of (string * INode * INode) | IAnimal of string | IEmpty with
    member this.AsMutable : Node =
        match this with
        | IQuestion (question, yes, no) -> Question (question, ref yes.AsMutable, ref no.AsMutable)
        | IAnimal (name) -> Animal (name)
        | IEmpty -> Empty

type AnimalGame (fileName) =
    let loadTree () = 
        if File.Exists fileName then
            (JsonConvert.DeserializeObject<INode> (File.ReadAllText fileName)).AsMutable
        else 
            Empty

    let tree : Node ref = ref <| loadTree ()

    let saveTree () =
        File.WriteAllText (fileName, (!tree).AsImmutable |> JsonConvert.SerializeObject)

    let rec askYN question =
        printf "%s " question
        let input = Char.ToLower (Console.ReadKey ()).KeyChar
        printfln ""
        match input with
        | 'y' -> true
        | 'n' -> false
        | _   -> 
            printfln "Please answer \"y\" or \"n\"."
            askYN question

    let askString question : string =
        printf "%s " question
        Console.ReadLine ()

    let askNewAnimal toBeReplaced =
        let name = askString "What is the name of your animal?"
        let question = askString (sprintf "What is a unique question that answers yes for %s?" name)
        toBeReplaced := Question (question, ref <| Animal name, ref !toBeReplaced)
        printfln "Thank you for teaching me."

    let ask next =
        match !next with
        | Question (question, yes, no) ->
            if askYN question then Some(yes) else Some(no)
        | Animal (name) ->
            if askYN (sprintf "I think your animal is a %s. Am I correct?" name) then
                printfln "Yay!"
                None
            else
                printfln "Oh. Please help me learn."
                askNewAnimal next
                None
        | Empty ->
           printfln "I have no idea. Please tell me."
           askNewAnimal next
           None

    member this.Run () =
        let mutable cont = askYN "Welcome to Animal Guess. Please think of an animal and type \"y\" to proceed."
        while cont do
            printfln ""
            let mutable currentNode = tree
            let mutable foundAnswer = false
            while not foundAnswer do
                let result = ask currentNode
                match result with 
                | Some(node) -> currentNode <- node
                | None -> foundAnswer <- true
            saveTree ()
            cont <- askYN "Do you want to continue?"
        printfln "Bye."
        
[<EntryPoint>]
let main argv = 
    (AnimalGame ("db.json")).Run ()
    0