ProgressBuilder.fs

open System
open System.Threading


// 進捗を通知する処理を組み立てるビルダーのベースになります
type ProgressBaseBuilder () =
  // calculation は時間のかかる計算で、第１引数は進捗があった時のコールバックです
  member this.Bind((weight, calculation), remaining) = 
    calculation
      (fun rate -> rate * weight |> this.report) // 進捗率 x 重み の進捗があったことを通知します
    |> remaining // 計算結果を渡します
  member this.Return x = x 
  member this.Delay x = x // こう書くとコンピュテーション式全体が遅延評価になります
  member val report = ignore with get, set // 進捗を通知する関数を後の２個のビルダーで違うものにできるようにします


/// 全体のビルダーです、進捗を通知するためのイベントをコンストラクタ引数で受け取ります
type ProgressBuilder (listener:_ Event) =
  inherit ProgressBaseBuilder()
  member this.Run f = 
    let sum = ref 0. // 進捗率の合計値です
    this.report <- fun rate -> // 受け取った進捗率を合計値に加算し、進捗率の合計値を通知します
      sum := !sum + rate
      listener.Trigger !sum
    f ()
let progress listener = ProgressBuilder listener


/// 子のビルダーです
/// このビルダーで構築されるものは[進捗を通知するための関数を第１引数とする、時間のかかる計算をする関数」です
type ProgressChildBuilder () =
  inherit ProgressBaseBuilder()
  member this.Run f = fun report -> 
    this.report <- report
    f ()
let child = ProgressChildBuilder()


// 時間のかかる関数です、report は進捗率を通知するためのコールバックです
let heavyFuncA report =
  printfn "heavyFuncA started.."
  for i in 1..10 do Thread.Sleep 10; report 0.1
  100

let heavyFuncB a report =
  printfn "heavyFuncB started.."
  for i in 1..10 do Thread.Sleep 10; report 0.1
  a / 2

let heavyFuncC b report =
  printfn "heavyFuncC started.."
  for i in 1..10 do Thread.Sleep 10; report 0.1
  b / 4


// usage
/// 進捗の通知を受け取るイベントです
let listener = Event<float>()

// 進捗があったら出力します
listener.Publish.Add <| fun rate ->
  printfn "%.1f %%.." (rate * 100.)

// 進捗を通知する時間のかかる計算を組み立てます
let result =
  progress listener {
  let! d = 0.7, child {
    printfn "heavyFuncD started.."
    let! a = 0.2, heavyFuncA
    let! b = 0.5, heavyFuncB a
    let! c = 0.3, heavyFuncC b
    return c }
  let! e = 0.3, heavyFuncB d
  return e }

// 結果を出力します
printfn "result = %d" result


// heavyFuncD started..
// heavyFuncA started..
// 1.4 %..
// 2.8 %..
// 4.2 %..
// 5.6 %..
// 7.0 %..
// 8.4 %..
// 9.8 %..
// 11.2 %..
// 12.6 %..
// 14.0 %..
// heavyFuncB started..
// 17.5 %..
// 21.0 %..
// 24.5 %..
// 28.0 %..
// 31.5 %..
// 35.0 %..
// 38.5 %..
// 42.0 %..
// 45.5 %..
// 49.0 %..
// heavyFuncC started..
// 51.1 %..
// 53.2 %..
// 55.3 %..
// 57.4 %..
// 59.5 %..
// 61.6 %..
// 63.7 %..
// 65.8 %..
// 67.9 %..
// 70.0 %..
// heavyFuncB started..
// 73.0 %..
// 76.0 %..
// 79.0 %..
// 82.0 %..
// 85.0 %..
// 88.0 %..
// 91.0 %..
// 94.0 %..
// 97.0 %..
// 100.0 %..
// result = 6