【添削希望】処理の進捗を通知するコンピュテーション式

readme.md

コンピュテーション式といえばネットで拾った MaybeBuilder を訳も分からずコピペして使っているだけというレベルの私が、初めて自分でコンピュテーション式を作ってみました。何やら動いたけども、これで合ってるのか、もっといい方法があるのか、大変不安な状態なので恥を忍んでここにコードを晒してみます。もし添削して頂ける優しい方がいらっしゃるならば、何卒よろしくお願いいたします＞＜

やりたいこと

仕事柄、計算時間がかかる処理を作ることがちょくちょくあります。といっても何時間も計算機をぶん回すような計算はあまりなくて、数秒から数十秒程度の計算が殆ど、長くても数分でしょうか。この程度の計算時間でも計算処理の進捗状況が可視化されないとユーザーはイライラを感じますから、プログレスバーで大まかな進捗状況を可視化する必要が出てきます。

しかし当然ながら計算アルゴリズムを ProgressBar のような GUI 部品に依存させる設計は出来ませんから、処理の進捗を通知する部分をGUIから切り離す必要があります。今までは計算処理APIの引数にコールバック（のようなもの）を渡して進捗の通知を行ったりしていました。これをコンピュテーション式を使ってもっとカッコよく書きたい、というのが今回やりたいことです。

もう一つクリアしたい課題があります。とある計算処理Aは、それを単独で使用されることもあれば、別の計算処理Bの中で呼ばれることもあります。Aを単独で使用する場合はAの呼び出し終了時に進捗は100%で良いですが、処理Bから処理Aを呼び出している場合にはAだけで進捗を100%とするわけにはいきません。処理Bにおいて処理Aが占める割合を重み付けして進捗を通知する必要があります。こういう通知処理を書いていると割とコードが汚れてきて本来のアルゴリズムの見通しが悪くなるので、これをコンピュテーション式で改善できないのだろうか、と思っています。

（コンピュテーション式に拘っている訳ではなくて上記の問題を解決することが目的なので、別の解決方法があればそれでもOKです）

実現イメージ

• 非同期関数が Async<'a> を返すように、進捗通知機能付き関数は Progressive<'a> を返すようにしたい。
• コンピュテーション式の中では let! で中身が取り出せて、進捗通知はあまり意識しなくても良いようにしたい。

Program.fs

open ProgressiveSandbox
open System.Threading

// テスト用のコンソールに進捗を書き出すリスナークラス
type TestProgressListener () =
  let mutable value = 0.0
  interface IProgressListener with
    member this.Report step = value <- value + step; printfn "progress = %f" value
  
// コンピュテーション式
let progressive = ProgressiveBuilder()

let heavyFuncA () =
  Progressive.make (fun listener ->
    printfn "A"
    for i in 1..10 do Thread.Sleep 100; listener.Report (0.1)
    100)

let heavyFuncB a =
  Progressive.make (fun listener ->
    printfn "B"
    for i in 1..10 do Thread.Sleep 100; listener.Report (0.1)
    a / 2)

let heavyFuncC b =
  Progressive.make (fun listener ->
    printfn "C"
    for i in 1..10 do Thread.Sleep 100; listener.Report (0.1)
    b / 4)

let heavyFuncD () =
  progressive {
    // 重みの合計が 1.0 になるようにする
    let! a = 0.2 @@ heavyFuncA()
    let! b = 0.5 @@ (heavyFuncB a)
    let! c = 0.3 @@ (heavyFuncC b)
    return c
  }


[<EntryPoint>]
let main argv = 
  progressive {
    let! d = 0.7 @@ heavyFuncD ()
    let! e = 0.3 @@ heavyFuncB d
    return e
  }
  |> Progressive.run (TestProgressListener ())
  |> printfn "result = %d"

  0

Progressive.fs

namespace ProgressiveSandbox

// 進捗の通知を受け取るためのインターフェイス
type IProgressListener =
  abstract Report : double -> unit  // 進捗の増分を通知する


type Progressive<'a> = {
    Weight    : double                  // この処理の重み付け
    Function  : IProgressListener -> 'a // 計算処理関数
  } with
  // 重み付けのための演算子
  static member (@@) (weight : double, p : Progressive<'a>) =
    { p with Weight = weight * p.Weight }


module Progressive =

  type private WeightedListener (weight : double, listener : IProgressListener) =
    interface IProgressListener with
      member this.Report step = listener.Report (weight * step)

  // Progressive オブジェクトの構築
  let make (f : IProgressListener -> 'a) = { Weight = 1.0; Function = f }

  // 計算処理の実行
  let run listener (p : Progressive<'a>) =
    p.Function (WeightedListener (p.Weight, listener) :> _)

  let bind (f : 'a -> Progressive<'b>) (p : Progressive<'a>) =
    { Weight = 1.0; Function = fun listener -> run listener p |> f |> run listener }


type ProgressiveBuilder() =
  member this.Bind (p : Progressive<_>, f : _ -> Progressive<_>) = Progressive.bind f p
  member this.Return x = Progressive.make (fun _ -> x)