xmas.fs

module xmas

open Fez.Core

let greet who =
    sprintf "Hi %s" who

type Tid = Tid

// this is simply to create an atom
[<ErlangTerm>]
type EtsName = | Good_bad

[<ErlangTerm>]
type EtsOption =
    | Named_table
    | Protected

[<ErlangTerm>]
type EtsInsertRrt = | True

[<ModCall("ets", "new")>]
let etsNew (name: EtsName) (options: EtsOption list) = Tid

[<ErlangTerm>]
type GoodBadRecord = | T of string * bool

[<ModCall("ets", "insert")>]
let etsInsert (tab: Tid) (o: GoodBadRecord) = True

[<ModCall("ets", "lookup")>]
let etsLookup (tab: Tid) (key: string) : GoodBadRecord list  = []

[<ModCall("random", "uniform")>]
let randomUniform (n: int) : int = 1

let randBool () =
    match randomUniform 2 with
    | 1 -> true
    | _ -> false

let seed () =
    let t = etsNew Good_bad [Named_table; Protected]
    let insert name good =
        let True = etsInsert t (T(name, good))
        ()
    randBool() |> insert "Karl"
    randBool() |> insert "Michael"
    randBool() |> insert "Diana"
    randBool() |> insert "Gerhard"
    randBool() |> insert "Jean-Sebastién"
    randBool() |> insert "Luke"
    randBool() |> insert "Daniil"
    randBool() |> insert "Dan"
    randBool() |> insert "Arnaud"
    t

type WishlistData =
    { Name : string
      Pid : Pid
      Stuff : string list }

type Wishlist = Wishlist of WishlistData

type MaybePresent =
    | Present of string
    | Nothing


let lookup t who =
    match etsLookup t who with
    | [x] -> Some x
    | _ -> None

let rec fcLoop t =
    match receive<Wishlist>() with
    | Wishlist { Stuff = [] } ->
        printfn "an empty wishlist - how strange..."
        fcLoop t
    | Wishlist { Name = key
                 Pid = pid
                 Stuff = stuff } ->
        match lookup t key with
        | None ->
            printfn "curious - I have no record of this person..."
            fcLoop t
        | Some (T(_, true)) ->
            printfn "%s has been good and will get a present" key
            pid <! (Present <| List.head stuff)
            fcLoop t
        | Some (T(_, false)) ->
            printfn "%s has NOT been good and will get nothing" key
            pid <! Nothing
            fcLoop t

let spawnFc () =
     fun () -> seed() |> fcLoop
     |> spawn

let waitForPresent () =
    match receive<MaybePresent>() with
    | Present thing ->
        printfn "yay I got a %s" thing
    | Nothing ->
        printfn ":((((("

let sendWishList fc who stuff =
    let w = Wishlist { Name = who
                       Pid = self()
                       Stuff = stuff}
    fc <! w
    waitForPresent ()