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 = tasks |> List.head |> Some, tasks |> List.tail

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

                match currentTask with
                | Some task ->
                    yield task.cancel ^->. (nextTasks |> takeFirst)
                    let waitTime = task.wakeTime - DateTime.Now
                    yield
                        (if TimeSpan.Compare (waitTime, TimeSpan.Zero) <= 0 then
                            Alt.always ()
                        else
                            (timeOut waitTime))
                        ^=>. (task.fire *<= () >>-. (nextTasks |> takeFirst))
                | None -> ()
            })
            >>= (fun (currTask, nextTasks) -> loop currentTask nextTasks)
        loop None [] |> Job.startIgnore >>-. { incomingTasks = incomingTasks }

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