F# Result型の便利関数とコンピュテーション式

AdacolaResultExtensions.fs

namespace Adacola.ResultExtensions

open System

module Result =
  let ofOption ifNone op =
    match op with
    | Some v -> Ok v
    | None -> Error ifNone

  let toOption r =
    match r with
    | Ok v -> Some v
    | Error _ -> None
  
  let get r =
    match r with
    | Ok v -> v
    | Error e -> sprintf "エラー値でした : %A" e |> invalidArg "r"

  let getOrRaise (r: Result<_, #exn>) =
    match r with
    | Ok v -> v
    | Error e -> raise e

  let tryWith (f: unit -> 'a) =
    try f() |> Ok with e -> Error e

  let toSeq sr = 
    match sr with
    | Ok os -> os |> Seq.map Ok
    | Error es -> es |> Seq.map Error


module Seq =
  let concatResult rs =
    (Ok(Seq.empty), rs) ||> Seq.fold (fun s r ->
      match s, r with
      | Ok os, Ok v -> seq { yield! os; yield v } |> Ok
      | Ok _, Error e -> Seq.singleton e |> Error
      | Error _, Ok _ -> s
      | Error es, Error e -> seq { yield! es; yield e } |> Error)

module List =
  let concatResult rs =
    (Ok [], rs) ||> List.fold (fun s r ->
      match s, r with
      | Ok os, Ok v -> v::os |> Ok
      | Ok _, Error e -> [e] |> Error
      | Error _, Ok _ -> s
      | Error es, Error e -> e::es |> Error)
    |> function
      | Ok os -> os |> List.rev |> Ok
      | Error es -> es |> List.rev |> Error

module Array =
  let concatResult (rs: Result<_, _>[]) =
    let result = Array.zeroCreate rs.Length
    (Ok result, rs |> Seq.indexed) ||> Seq.fold (fun s (i, r) ->
      match s, r with
      | Ok rs, Ok v -> rs.[i] <- v; Ok rs
      | Ok _, Error e ->
        let es = Array.zeroCreate (rs.Length - i)
        es.[0] <- e
        Error(es, 1)
      | Error _, Ok _ -> s
      | Error(es, count), Error e -> rs.[count] <- e; Error(es, count + 1))
    |> function
      | Error(es, count)  -> Array.sub es 0 count |> Error
      | Ok os -> Ok os

module Builder =
  type ResultBuilder() =
    member _.Return(x) = Ok x
    member _.ReturnFrom(m: Result<_, _>) = m
    member _.Bind(m, f) = Result.bind f m
    member _.Bind((m, error): (Option<'T> * 'E), f) = m |> Result.ofOption error |> Result.bind f
    member _.Zero() = None
    member _.Combine(m, f) = Result.bind f m
    member _.Delay(f: unit -> _) = f
    member _.Run(f) = f()
    member this.TryWith(m, h) =
        try this.ReturnFrom(m)
        with e -> h e
    member this.TryFinally(m, compensation) =
        try this.ReturnFrom(m)
        finally compensation()
    member this.Using(res:#IDisposable, body) =
        this.TryFinally(body res, fun () -> match res with null -> () | disp -> disp.Dispose())
    member this.While(guard, f) =
        if not (guard()) then Ok () else
        do f() |> ignore
        this.While(guard, f)
    member this.For(sequence:seq<_>, body) =
        this.Using(sequence.GetEnumerator(), fun enum -> __.While(enum.MoveNext, __.Delay(fun () -> body enum.Current)))

  let result = ResultBuilder()

  type TryResultBuilder() =
    member _.Return(x) = Ok x
    member _.ReturnFrom(m: Result<_, _>) = m
    member _.Bind(m, f) = Result.bind f m
    member _.Bind((m, error): (Option<'T> * 'E), f) = m |> Result.ofOption error |> Result.bind f
    member _.Zero() = None
    member _.Combine(m, f) = Result.bind f m
    member _.Delay(f: unit -> _) = f
    member _.Run(f) = try f() with e -> Error e
    member this.TryWith(m, h) =
        try this.ReturnFrom(m)
        with e -> h e
    member this.TryFinally(m, compensation) =
        try this.ReturnFrom(m)
        finally compensation()
    member this.Using(res:#IDisposable, body) =
        this.TryFinally(body res, fun () -> match res with null -> () | disp -> disp.Dispose())
    member this.While(guard, f) =
        if not (guard()) then Ok () else
        do f() |> ignore
        this.While(guard, f)
    member this.For(sequence:seq<_>, body) =
        this.Using(sequence.GetEnumerator(), fun enum -> __.While(enum.MoveNext, __.Delay(fun () -> body enum.Current)))

  let tryResult = TryResultBuilder()