Chessie compiled to JS using Fable.

fable-chessie.fs

/// Contains error propagation functions and a computation expression builder for Railway-oriented programming.
namespace Chessie.ErrorHandling

open System

/// Represents the result of a computation.
type Result<'TSuccess, 'TMessage> = 
    /// Represents the result of a successful computation.
    | Ok of 'TSuccess * 'TMessage list
    /// Represents the result of a failed computation.
    | Bad of 'TMessage list

    /// Creates a Failure result with the given messages.
    static member FailWith(messages:'TMessage seq) : Result<'TSuccess, 'TMessage> = Result<'TSuccess, 'TMessage>.Bad(messages |> Seq.toList)

    /// Creates a Failure result with the given message.
    static member FailWith(message:'TMessage) : Result<'TSuccess, 'TMessage> = Result<'TSuccess, 'TMessage>.Bad([message])
    
    /// Creates a Success result with the given value.
    static member Succeed(value:'TSuccess) : Result<'TSuccess, 'TMessage> = Result<'TSuccess, 'TMessage>.Ok(value,[])

    /// Creates a Success result with the given value and the given message.
    static member Succeed(value:'TSuccess,message:'TMessage) : Result<'TSuccess, 'TMessage> = Result<'TSuccess, 'TMessage>.Ok(value,[message])

    /// Creates a Success result with the given value and the given message.
    static member Succeed(value:'TSuccess,messages:'TMessage seq) : Result<'TSuccess, 'TMessage> = Result<'TSuccess, 'TMessage>.Ok(value,messages |> Seq.toList)

    /// Executes the given function on a given success or captures the failure
    static member Try(func: Func<_>) : Result<'TSuccess,exn> =        
        try
            Ok(func.Invoke(),[])
        with
        | exn -> Bad[exn]

    /// Converts the result into a string.
    override this.ToString() =
        match this with
        | Ok(v,msgs) -> sprintf "OK: %A - %s" v (String.Join("\r\n", msgs |> Seq.map (fun x -> x.ToString())))
        | Bad(msgs) -> sprintf "Error: %s" (String.Join("\r\n", msgs |> Seq.map (fun x -> x.ToString())))    

/// Basic combinators and operators for error handling.
[<AutoOpen>]
module Trial =  
    /// Wraps a value in a Success
    let inline ok<'TSuccess,'TMessage> (x:'TSuccess) : Result<'TSuccess,'TMessage> = Ok(x, [])

    /// Wraps a value in a Success
    let inline pass<'TSuccess,'TMessage> (x:'TSuccess) : Result<'TSuccess,'TMessage> = Ok(x, [])

    /// Wraps a value in a Success and adds a message
    let inline warn<'TSuccess,'TMessage> (msg:'TMessage) (x:'TSuccess) : Result<'TSuccess,'TMessage> = Ok(x,[msg])

    /// Wraps a message in a Failure
    let inline fail<'TSuccess,'Message> (msg:'Message) : Result<'TSuccess,'Message> = Bad([ msg ])

    /// Executes the given function on a given success or captures the exception in a failure
    let inline Catch f x = Result<_,_>.Try(fun () -> f x)

    /// Returns true if the result was not successful.
    let inline failed result = 
        match result with
        | Bad _ -> true
        | _ -> false

    /// Takes a Result and maps it with fSuccess if it is a Success otherwise it maps it with fFailure.
    let inline either fSuccess fFailure trialResult = 
        match trialResult with
        | Ok(x, msgs) -> fSuccess (x, msgs)
        | Bad(msgs) -> fFailure (msgs)

    /// If the given result is a Success the wrapped value will be returned. 
    ///Otherwise the function throws an exception with Failure message of the result.
    let inline returnOrFail result = 
        let inline raiseExn msgs = 
            msgs
            |> Seq.map (sprintf "%O")
            |> String.concat (Environment.NewLine + "\t")
            |> failwith
        either fst raiseExn result

    /// Appends the given messages with the messages in the given result.
    let inline mergeMessages msgs result = 
        let inline fSuccess (x, msgs2) = Ok(x, msgs @ msgs2)
        let inline fFailure errs = Bad(errs @ msgs)
        either fSuccess fFailure result

    /// If the result is a Success it executes the given function on the value.
    /// Otherwise the exisiting failure is propagated.
    let inline bind f result = 
        let inline fSuccess (x, msgs) = f x |> mergeMessages msgs
        let inline fFailure (msgs) = Bad msgs
        either fSuccess fFailure result

   /// Flattens a nested result given the Failure types are equal
    let inline flatten (result : Result<Result<_,_>,_>) =
        result |> bind id

    /// If the result is a Success it executes the given function on the value. 
    /// Otherwise the exisiting failure is propagated.
    /// This is the infix operator version of ErrorHandling.bind
    let inline (>>=) result f = bind f result

    /// If the wrapped function is a success and the given result is a success the function is applied on the value. 
    /// Otherwise the exisiting error messages are propagated.
    let inline apply wrappedFunction result = 
        match wrappedFunction, result with
        | Ok(f, msgs1), Ok(x, msgs2) -> Ok(f x, msgs1 @ msgs2)
        | Bad errs, Ok(_, _msgs) -> Bad(errs)
        | Ok(_, _msgs), Bad errs -> Bad(errs)
        | Bad errs1, Bad errs2 -> Bad(errs1 @ errs2)

    /// If the wrapped function is a success and the given result is a success the function is applied on the value. 
    /// Otherwise the exisiting error messages are propagated.
    /// This is the infix operator version of ErrorHandling.apply
    let inline (<*>) wrappedFunction result = apply wrappedFunction result

    /// Lifts a function into a Result container and applies it on the given result.
    let inline lift f result = apply (ok f) result

    /// Maps a function over the existing error messages in case of failure. In case of success, the message type will be changed and warnings will be discarded.
    let inline mapFailure f result =
        match result with
        | Ok (v,_) -> ok v
        | Bad errs -> Bad (f errs)

    /// Lifts a function into a Result and applies it on the given result.
    /// This is the infix operator version of ErrorHandling.lift
    let inline (<!>) f result = lift f result

    /// Promote a function to a monad/applicative, scanning the monadic/applicative arguments from left to right.
    let inline lift2 f a b = f <!> a <*> b

    /// If the result is a Success it executes the given success function on the value and the messages.
    /// If the result is a Failure it executes the given failure function on the messages.
    /// Result is propagated unchanged.
    let inline eitherTee fSuccess fFailure result =
        let inline tee f x = f x; x;
        tee (either fSuccess fFailure) result

    /// If the result is a Success it executes the given function on the value and the messages.
    /// Result is propagated unchanged.
    let inline successTee f result = 
        eitherTee f ignore result

    /// If the result is a Failure it executes the given function on the messages.
    /// Result is propagated unchanged.
    let inline failureTee f result = 
        eitherTee ignore f result

    /// Collects a sequence of Results and accumulates their values.
    /// If the sequence contains an error the error will be propagated.
    let inline collect xs = 
        Seq.fold (fun result next -> 
            match result, next with
            | Ok(rs, m1), Ok(r, m2) -> Ok(r :: rs, m1 @ m2)
            | Ok(_, m1), Bad(m2) | Bad(m1), Ok(_, m2) -> Bad(m1 @ m2)
            | Bad(m1), Bad(m2) -> Bad(m1 @ m2)) (ok []) xs
        |> lift List.rev

    /// Converts an option into a Result.
    let inline failIfNone message result = 
        match result with
        | Some x -> ok x
        | None -> fail message

    /// Converts a Choice into a Result.
    let inline ofChoice choice =
        match choice with
        | Choice1Of2 v -> ok v
        | Choice2Of2 v -> fail v

    /// Categorizes a result based on its state and the presence of extra messages
    let inline (|Pass|Warn|Fail|) result =
      match result with
      | Ok  (value, []  ) -> Pass  value
      | Ok  (value, msgs) -> Warn (value,msgs)
      | Bad        msgs  -> Fail        msgs

    let inline failOnWarnings result =
      match result with
      | Warn (_,msgs) -> Bad msgs
      | _             -> result 

    /// Builder type for error handling computation expressions.
    type TrialBuilder() = 
        member __.Zero() = ok()
        member __.Bind(m, f) = bind f m
        member __.Return(x) = ok x
        member __.ReturnFrom(x) = x
        member __.Combine (a, b) = bind b a
        member __.Delay f = f
        member __.Run f = f ()
        member __.TryWith (body, handler) =
            try
                body()
            with
            | e -> handler e
        member __.TryFinally (body, compensation) =
            try
                body()
            finally
                compensation()
        member x.Using(d:#IDisposable, body) =
            let result = fun () -> body d
            x.TryFinally (result, fun () ->
                match d with
                | null -> ()
                | d -> d.Dispose())
        member x.While (guard, body) =
            if not <| guard () then
                x.Zero()
            else
                bind (fun () -> x.While(guard, body)) (body())
        member x.For(s:seq<_>, body) =
            x.Using(s.GetEnumerator(), fun enum ->
                x.While(enum.MoveNext,
                    x.Delay(fun () -> body enum.Current)))

    /// Wraps computations in an error handling computation expression.
    let trial = TrialBuilder()

/// Represents the result of an async computation
[<NoComparison;NoEquality>]
type AsyncResult<'a, 'b> = 
    | AR of Async<Result<'a, 'b>>

/// Useful functions for combining error handling computations with async computations.
[<AutoOpen>]
module AsyncExtensions = 
    /// Useful functions for combining error handling computations with async computations.
    [<RequireQualifiedAccess>]
    module Async = 
        /// Creates an async computation that return the given value
        let singleton value = value |> async.Return

        /// Creates an async computation that runs a computation and
        /// when it generates a result run a binding function on the said result
        let bind f x = async.Bind(x, f)

        /// Creates an async computation that runs a mapping function on the result of an async computation
        let map f x = x |> bind (f >> singleton)

        /// Creates an async computation from an asyncTrial computation
        let ofAsyncResult (AR x) = x

/// Basic support for async error handling computation
[<AutoOpen>]
module AsyncTrial = 
    /// Builder type for error handling in async computation expressions.
    type AsyncTrialBuilder() = 
        member __.Return value : AsyncResult<'a, 'b> = 
            value
            |> ok
            |> Async.singleton
            |> AR
        
        member __.ReturnFrom(asyncResult : AsyncResult<'a, 'b>) = asyncResult
        member this.Zero() : AsyncResult<unit, 'b> = this.Return()
        member __.Delay(generator : unit -> AsyncResult<'a, 'b>) : AsyncResult<'a, 'b> = 
            async.Delay(generator >> Async.ofAsyncResult) |> AR
        
        member __.Bind(asyncResult : AsyncResult<'a, 'c>, binder : 'a -> AsyncResult<'b, 'c>) : AsyncResult<'b, 'c> = 
            let fSuccess (value, msgs) = 
                value |> (binder
                          >> Async.ofAsyncResult
                          >> Async.map (mergeMessages msgs))
            
            let fFailure errs = 
                errs
                |> Bad
                |> Async.singleton
            
            asyncResult
            |> Async.ofAsyncResult
            |> Async.bind (either fSuccess fFailure)
            |> AR
        
        member this.Bind(result : Result<'a, 'c>, binder : 'a -> AsyncResult<'b, 'c>) : AsyncResult<'b, 'c> = 
            this.Bind(result
                      |> Async.singleton
                      |> AR, binder)
        
        member __.Bind(async : Async<'a>, binder : 'a -> AsyncResult<'b, 'c>) : AsyncResult<'b, 'c> = 
            async
            |> Async.bind (binder >> Async.ofAsyncResult)
            |> AR
        
        member __.TryWith(asyncResult : AsyncResult<'a, 'b>, catchHandler : exn -> AsyncResult<'a, 'b>) : AsyncResult<'a, 'b> = 
            async.TryWith(asyncResult |> Async.ofAsyncResult, (catchHandler >> Async.ofAsyncResult)) |> AR
        member __.TryFinally(asyncResult : AsyncResult<'a, 'b>, compensation : unit -> unit) : AsyncResult<'a, 'b> = 
            async.TryFinally(asyncResult |> Async.ofAsyncResult, compensation) |> AR
        member __.Using(resource : 'T when 'T :> System.IDisposable, binder : 'T -> AsyncResult<'a, 'b>) : AsyncResult<'a, 'b> = 
            async.Using(resource, (binder >> Async.ofAsyncResult)) |> AR
    
    // Wraps async computations in an error handling computation expression.
    let asyncTrial = AsyncTrialBuilder()

fable-chessie.js

import { setType } from "fable-core/Symbol";
import _Symbol from "fable-core/Symbol";
import { toString, compareUnions, equalsUnions, makeGeneric, GenericParam } from "fable-core/Util";
import { append, ofArray } from "fable-core/List";
import List from "fable-core/List";
import { getEnumerator, map as map_1, toList } from "fable-core/Seq";
import { join, fsFormat } from "fable-core/String";
import Async_1 from "fable-core/Async";
import { singleton as singleton_1 } from "fable-core/AsyncBuilder";
export class Result {
  constructor(tag, a, b) {
    this.size = arguments.length - 1 | 0;
    this.tag = tag | 0;
    this.a = a;
    this.b = b;
  }

  [_Symbol.reflection]() {
    return {
      type: "Chessie.ErrorHandling.Result",
      interfaces: ["FSharpUnion", "System.IEquatable", "System.IComparable"],
      cases: [["Ok", GenericParam("TSuccess"), makeGeneric(List, {
        T: GenericParam("TMessage")
      })], ["Bad", makeGeneric(List, {
        T: GenericParam("TMessage")
      })]]
    };
  }

  Equals(other) {
    return equalsUnions(this, other);
  }

  CompareTo(other) {
    return compareUnions(this, other) | 0;
  }

  static FailWith_0(messages) {
    return new Result(1, toList(messages));
  }

  static FailWith_1(message) {
    return new Result(1, ofArray([message]));
  }

  static Succeed_0(value) {
    return new Result(0, value, new List());
  }

  static Succeed_1(value, message) {
    return new Result(0, value, ofArray([message]));
  }

  static Succeed_2(value, messages) {
    return new Result(0, value, toList(messages));
  }

  static Try(func) {
    try {
      return new Result(0, func(), new List());
    } catch (exn) {
      return new Result(1, ofArray([exn]));
    }
  }

  ToString() {
    if (this.tag === 1) {
      return fsFormat("Error: %s")(x => x)(join("\r\n", map_1(x => toString(x), this.a)));
    } else {
      return fsFormat("OK: %A - %s")(x => x)(this.a, join("\r\n", map_1(x_1 => toString(x_1), this.b)));
    }
  }

}
setType("Chessie.ErrorHandling.Result", Result);
export const Trial = function (__exports) {
  const TrialBuilder = __exports.TrialBuilder = class TrialBuilder {
    [_Symbol.reflection]() {
      return {
        type: "Chessie.ErrorHandling.Trial.TrialBuilder",
        properties: {}
      };
    }

    constructor() {}

    Zero() {
      return new Result(0, null, new List());
    }

    Bind(m, f) {
      if (m.tag === 1) {
        return (msgs => new Result(1, msgs))()(m.a);
      } else {
        return (tupledArg => (result => result.tag === 1 ? (errs => new Result(1, append(errs, tupledArg[1])))()(result.a) : (tupledArg_1 => new Result(0, tupledArg_1[0], append(tupledArg[1], tupledArg_1[1])))()([result.a, result.b]))(f(tupledArg[0])))([m.a, m.b]);
      }
    }

    Return(x) {
      return new Result(0, x, new List());
    }

    ReturnFrom(x) {
      return x;
    }

    Combine(a, b) {
      if (a.tag === 1) {
        return (msgs => new Result(1, msgs))()(a.a);
      } else {
        return (tupledArg => (result => result.tag === 1 ? (errs => new Result(1, append(errs, tupledArg[1])))()(result.a) : (tupledArg_1 => new Result(0, tupledArg_1[0], append(tupledArg[1], tupledArg_1[1])))()([result.a, result.b]))(b(tupledArg[0])))([a.a, a.b]);
      }
    }

    Delay(f) {
      return f;
    }

    Run(f) {
      return f();
    }

    TryWith(body, handler) {
      try {
        return body();
      } catch (e) {
        return handler(e);
      }
    }

    TryFinally(body, compensation) {
      try {
        return body();
      } finally {
        compensation();
      }
    }

    Using(d, body) {
      const result = () => {
        return body(d);
      };

      return this.TryFinally(result, () => {
        if (d == null) {} else {
          d.Dispose();
        }
      });
    }

    While(guard, body) {
      if (!guard()) {
        return this.Zero();
      } else if (body().tag === 1) {
        return (msgs => new Result(1, msgs))()(body().a);
      } else {
        return (tupledArg => (result => result.tag === 1 ? (errs => new Result(1, append(errs, tupledArg[1])))()(result.a) : (tupledArg_1 => new Result(0, null, append(tupledArg[1], tupledArg_1[1])))()([null, result.b]))((() => this.While(guard, body))()))([null, body().b]);
      }
    }

    For(s, body) {
      return this.Using(getEnumerator(s), _enum => this.While(() => _enum.MoveNext(), this.Delay(() => body(_enum.get_Current))));
    }

  };
  setType("Chessie.ErrorHandling.Trial.TrialBuilder", TrialBuilder);
  const trial = __exports.trial = new TrialBuilder();
  return __exports;
}({});
export class AsyncResult {
  constructor(tag, a) {
    this.size = arguments.length - 1 | 0;
    this.tag = tag | 0;
    this.a = a;
  }

  [_Symbol.reflection]() {
    return {
      type: "Chessie.ErrorHandling.AsyncResult",
      interfaces: ["FSharpUnion"],
      cases: [["AR", Async_1]]
    };
  }

}
setType("Chessie.ErrorHandling.AsyncResult", AsyncResult);
export const AsyncExtensions = function (__exports) {
  const Async = __exports.Async = function (__exports) {
    const singleton = __exports.singleton = function singleton(value) {
      return function (arg00) {
        return singleton_1.Return(arg00);
      }(value);
    };

    const bind = __exports.bind = function bind(f, x) {
      return singleton_1.Bind(x, f);
    };

    const map = __exports.map = function map(f, x) {
      return bind($var1 => function (value) {
        return singleton(value);
      }(f($var1)), x);
    };

    const ofAsyncResult = __exports.ofAsyncResult = function ofAsyncResult(_arg1) {
      return _arg1.a;
    };

    return __exports;
  }({});

  return __exports;
}({});
export const AsyncTrial = function (__exports) {
  const AsyncTrialBuilder = __exports.AsyncTrialBuilder = class AsyncTrialBuilder {
    [_Symbol.reflection]() {
      return {
        type: "Chessie.ErrorHandling.AsyncTrial.AsyncTrialBuilder",
        properties: {}
      };
    }

    constructor() {}

    Return(value) {
      return new AsyncResult(0, AsyncExtensions.Async.singleton(new Result(0, value, new List())));
    }

    ReturnFrom(asyncResult) {
      return asyncResult;
    }

    Zero() {
      return this.Return();
    }

    Delay(generator) {
      return new AsyncResult(0, singleton_1.Delay($var2 => (arg00_ => AsyncExtensions.Async.ofAsyncResult(arg00_))(generator($var2))));
    }

    Bind_0(asyncResult, binder) {
      const fSuccess = tupledArg => {
        return ($var4 => (() => {
          const f = result => {
            if (result.tag === 1) {
              return (errs => new Result(1, append(errs, tupledArg[1])))()(result.a);
            } else {
              return (tupledArg_1 => new Result(0, tupledArg_1[0], append(tupledArg[1], tupledArg_1[1])))()([result.a, result.b]);
            }
          };

          return x => AsyncExtensions.Async.map(f, x);
        })()(($var3 => (arg00_ => AsyncExtensions.Async.ofAsyncResult(arg00_))(binder($var3)))($var4)))(tupledArg[0]);
      };

      const fFailure = errs_1 => {
        return AsyncExtensions.Async.singleton(new Result(1, errs_1));
      };

      return new AsyncResult(0, AsyncExtensions.Async.bind((() => {
        const fFailure_1 = fFailure;
        return trialResult => trialResult.tag === 1 ? fFailure_1(trialResult.a) : fSuccess([trialResult.a, trialResult.b]);
      })(), AsyncExtensions.Async.ofAsyncResult(asyncResult)));
    }

    Bind_1(result, binder) {
      return this.Bind_0(new AsyncResult(0, AsyncExtensions.Async.singleton(result)), binder);
    }

    Bind_2(async, binder) {
      return new AsyncResult(0, AsyncExtensions.Async.bind($var5 => (arg00_ => AsyncExtensions.Async.ofAsyncResult(arg00_))(binder($var5)), async));
    }

    TryWith(asyncResult, catchHandler) {
      return new AsyncResult(0, singleton_1.TryWith(AsyncExtensions.Async.ofAsyncResult(asyncResult), $var6 => (arg00_ => AsyncExtensions.Async.ofAsyncResult(arg00_))(catchHandler($var6))));
    }

    TryFinally(asyncResult, compensation) {
      return new AsyncResult(0, singleton_1.TryFinally(AsyncExtensions.Async.ofAsyncResult(asyncResult), compensation));
    }

    Using(resource, binder) {
      return new AsyncResult(0, singleton_1.Using(resource, $var7 => (arg00_ => AsyncExtensions.Async.ofAsyncResult(arg00_))(binder($var7))));
    }

  };
  setType("Chessie.ErrorHandling.AsyncTrial.AsyncTrialBuilder", AsyncTrialBuilder);
  const asyncTrial = __exports.asyncTrial = new AsyncTrialBuilder();
  return __exports;
}({});