add part6

Author: tamizhvendan

fsharp/HopacSeries/Part6/paket.dependencies

@@ -0,0 +1,3 @@
+source https://www.nuget.org/api/v2
+framework: net461
+nuget Hopac

fsharp/HopacSeries/Part6/paket.lock

@@ -0,0 +1,6 @@
+RESTRICTION: == net461
+NUGET
+  remote: https://www.nuget.org/api/v2
+    FSharp.Core (4.3.4)
+    Hopac (0.3.23)
+      FSharp.Core (>= 3.1.2.5)

fsharp/HopacSeries/Part6/ticker.fsx

@@ -0,0 +1,28 @@
+#r "packages/Hopac/lib/net45/Hopac.Core.dll"
+#r "packages/Hopac/lib/net45/Hopac.Platform.dll"
+#r "packages/Hopac/lib/net45/Hopac.dll"
+
+open Hopac
+open Hopac.Infixes
+open System
+
+type Ticker (timeSpan : TimeSpan) =
+  let tickCh = Ch<DateTimeOffset>()
+  let cancelled = IVar()
+
+  let tick () =
+    Ch.give tickCh DateTimeOffset.Now
+
+  let rec loop () = 
+    let tickerLoop =
+      timeOut timeSpan
+      |> Alt.afterJob tick
+      |> Alt.afterJob loop
+    tickerLoop <|> IVar.read cancelled
+
+  do start (loop())
+  
+  member __.Stop() = 
+    IVar.tryFill cancelled () |> start
+  member __.C
+    with get() = tickCh

fsharp/HopacSeries/Part6/timebomb.fsx

@@ -0,0 +1,127 @@
+#load "ticker.fsx"
+open System
+open Ticker
+open Hopac
+
+type Reason =
+| Exploded
+| Defused
+
+type Status =
+| NotActivated
+| Alive
+| Dead of Reason
+
+
+type TimeBomb () = 
+
+  let reason = IVar<Reason>()
+  let activated = IVar()
+  let secondsRemainingCh = Ch<int>()
+  let inCh = Ch<char>()
+  let rec onTick (ticker : Ticker) secondsRemaining =
+    ticker.C
+    |> Alt.afterJob (fun _ -> Ch.send secondsRemainingCh secondsRemaining)
+    |> Alt.afterJob (fun _ -> onTick ticker (secondsRemaining - 1))
+
+  let startTicker seconds =
+    let ticker = new Ticker(TimeSpan.FromSeconds 1.)
+    onTick ticker (seconds - 1) |> start
+    ticker
+
+  let startTimeOut seconds =
+    let timeOutAlt = 
+      seconds 
+      |> float 
+      |> TimeSpan.FromSeconds 
+      |> timeOut
+    
+    timeOutAlt
+    |> Alt.afterJob (fun _ -> 
+        IVar.tryFill reason Exploded)
+    |> start
+
+  let rec inputLoop defuseChar =
+    inCh
+    |> Alt.afterJob (fun c -> 
+      if c = defuseChar then
+        IVar.tryFill reason Defused
+      else
+        inputLoop defuseChar :> Job<unit>
+    )
+  let activate seconds defuseChar =
+    let ticker = startTicker seconds
+    startTimeOut seconds
+    IVar.tryFill activated () |> start
+    inputLoop defuseChar |> start
+    IVar.read reason
+    |> Alt.afterFun (fun _ -> ticker.Stop())
+
+  member __.Status () =
+    let deadReasonAlt =
+      IVar.read reason
+      |> Alt.afterFun Dead
+
+    let activatedAlt =
+      IVar.read activated
+      |> Alt.afterFun (fun _ -> Alive)
+    
+    let notActivatedAlt =
+      Alt.always NotActivated
+
+    Alt.choose [
+      deadReasonAlt 
+      activatedAlt
+      notActivatedAlt
+    ] |> run
+
+  member this.Activate (seconds : int, defuseChar : char) =
+    match this.Status() with
+    | NotActivated -> 
+      activate seconds defuseChar |> start
+    | _ -> ()
+
+  member this.TryDefuse(defuseChar) =
+    match this.Status() with
+    | Alive -> 
+      Ch.give inCh defuseChar 
+      |> start
+    | _ -> ()
+
+  member __.SecondsRemainingCh
+    with get() = secondsRemainingCh
+
+  member __.DeadStatusAlt
+    with get() = IVar.read reason
+
+
+let printSecondsRemaining (t : TimeBomb) =
+  t.SecondsRemainingCh
+  |> Alt.afterFun (printfn "Seconds Remaining: %d")
+  |> Job.foreverServer |> start
+
+let simulateExplosion () =
+  let seconds = 5
+  let t = TimeBomb()
+  t.Status() |> printfn "Status: %A"
+  t.Activate(seconds, 'a')
+  printSecondsRemaining t
+  t.Status() |> printfn "Status: %A"
+  t.DeadStatusAlt
+  |> Alt.afterFun (printfn "Status: %A")
+  |> run
+
+let simulateDefusal char =
+  let seconds = 5
+  let t = TimeBomb()
+  t.Status() |> printfn "Status: %A"
+  t.Activate(seconds, 'a')
+  printSecondsRemaining t
+  t.Status() |> printfn "Status: %A"
+  
+  TimeSpan.FromSeconds 3.
+  |> timeOut 
+  |> Alt.afterFun (fun _ -> t.TryDefuse(char))
+  |> Alt.afterJob (fun _ -> t.DeadStatusAlt)
+  |> Alt.afterFun (printfn "Status: %A")
+  |> run