open System
open Hopac
open Hopac.Infixes


let rec until (cancel: Alt<'c>) (s: 's) (j: Alt<'c> -> 's -> Alt<'s>) =
    (cancel ^-> fun x -> x, s)
    <|>
    (j cancel s ^=> fun s -> until cancel s j)

let printDelay msg =
    Job.delay <| fun _ ->
        printfn "before timeout"
        timeOutMillis 200
    >>- fun _ -> printfn "after, msg: %d" msg; msg + 1

type Timer = { incomingTasks: Ch<DateTime * Alt<unit> * IVar<Alt<unit>>> }

module Timer =
    type Task = {
        wakeTime:   DateTime
        cancel:     Alt<unit>
        fire:       IVar<unit>
    }

    let takeFirst tasks =
        match tasks with
        | [] -> None, []
        | xs -> xs |> List.head |> Some, xs |> List.tail

    let create () = { incomingTasks = Ch () }

    let loop timer cancel =
        fun (currentTask, nextTasks) ->
            Alt.choose (seq {
                yield cancel ^=>. Job.abort ()
                match currentTask with
                | Some task ->
                    yield task.cancel ^-> (fun _ -> nextTasks |> takeFirst)
                    let waitTime = task.wakeTime - DateTime.Now
                    yield
                        (if TimeSpan.Compare (waitTime, TimeSpan.Zero) <= 0 then
                            Alt.always ()
                        else
                            (timeOut waitTime))
                        ^=>. (task.fire *<= () >>- (fun _ -> printfn "fired!!!") >>-. (nextTasks |> takeFirst))
                | None -> ()

                yield Ch.take timer.incomingTasks ^=> (fun (wakeTime, cancel, res) ->
                    let fire = IVar ()
                    let newTask = { wakeTime = wakeTime; cancel = cancel; fire = fire }
                    res *<= (fire |> IVar.read) >>- fun _ ->
                        currentTask |> Option.fold (fun l x -> x::l) (newTask::nextTasks)
                        |> List.sortBy (fun task -> task.wakeTime)
                        |> takeFirst)
            })

    //let start timer =
    //    loop timer |> Job.iterate (None, [])

    let submit wakeTime cancel timer =
        let res = IVar ()
        timer.incomingTasks *<+ (wakeTime, cancel, res)
        >>=. res >>=* id

    let submitNack wakeTime timer =
        Alt.withNackFun (fun nack -> timer |> submit wakeTime nack)


[<EntryPoint>]
let main argv =

    // let cancel = IVar<string> ()
    // // let x = printDelay |> until cancel 10 |> startIgnore
    // let promiseJob = printDelay |> until cancel 0 |> Promise.start >>= Promise.read >>- (fun r -> Console.WriteLine (r)) |> startIgnore
    // // let r = promiseJob |> startIgnore
    // Console.ReadLine () |> ignore
    // cancel *<= "asdf" |> run
    // Console.ReadLine () |> ignore

    printfn "Start: %A" (DateTime.Now.ToLongTimeString ())
    let timerStop = IVar<unit> ()
    let timer = Timer.create ()
    let a = timer |> Timer.loop
    let b = until timerStop (None, [])
    a |> b |> startIgnore
    let now = DateTime.Now
    let wakeTime1 = now + (TimeSpan.FromSeconds 0.5)
    let wakeTime2 = now + (TimeSpan.FromSeconds 1.2)
    let wakeTime3 = now + (TimeSpan.FromSeconds 1.5)
    let stopTime = now + (TimeSpan.FromSeconds 1.0)
    (timer |> Timer.submitNack wakeTime1) ^-> (fun _ -> printfn "EVENT1 %A" (DateTime.Now.ToLongTimeString ()); 1)
    <|> (timeOutMillis 1500 ^-> fun _ -> printfn "Timeout %A" (DateTime.Now.ToLongTimeString ()); 2)
    |> startIgnore
    (timer |> Timer.submitNack wakeTime2) ^-> (fun _ -> printfn "EVENT2 %A" (DateTime.Now.ToLongTimeString ()); 1)
    |> startIgnore
    (timer |> Timer.submitNack wakeTime3) ^-> (fun _ -> printfn "EVENT3 %A" (DateTime.Now.ToLongTimeString ()); 1)
    |> startIgnore

    (timer |> Timer.submitNack stopTime) ^=> fun _ -> printfn "timer stop %A" (DateTime.Now.ToLongTimeString ()); timerStop *<= ()
    |> startIgnore

    Console.ReadLine () |> ignore


    0