Doing applicative validation in a CE before F# 5

trial.fsx

open System

type Trial<'Value, 'Error> =
    | Pass of 'Value
    | Fail of 'Error list

[<RequireQualifiedAccess>]
module Trial =
    let map2 merge trial1 trial2 =
        match (trial1, trial2) with
        | (Pass value1, Pass value2) -> Pass (merge value1 value2)
        | (Pass _     , Fail fails )
        | (Fail fails , Pass _     ) -> Fail fails
        | (Fail fails1, Fail fails2) -> Fail (fails1 @ fails2)

    module Control =
        [<Sealed>]
        type TrialBuilder() =
            member _.Delay(generator: unit -> Trial<_, _>) = generator

            member _.Run(generator: unit -> Trial<_, _>) = generator ()

            member _.Yield(value) = Pass value

            member _.YieldFrom(trial: Trial<'Value, 'Error>) = trial

            member _.For(trial, body) =
                match trial with
                | Fail fails -> Fail fails
                | Pass value -> body value

            [<CustomOperation("from", IsLikeZip = true)>]
            member _.Lift(trial1, trial2, merge: unit -> _ -> _) =
                map2 merge trial1 trial2

            [<CustomOperation("also", IsLikeZip = true)>]
            member _.Merge(trial1, trial2, merge) =
                map2 merge trial1 trial2

            member _.TryWith(body, handler) : Trial<_, _> =
                try body () with x -> handler x

            member _.TryFinally(body, handler) : Trial<_, _> =
                try body () finally handler ()

            member _.Using(resource : IDisposable, body) : Trial<_, _> =
                try body resource finally resource.Dispose()

            member me.While(guard, body) =
                if not (guard ()) then
                    body ()
                else
                    match body () with
                    | Fail fails -> Fail fails
                    | Pass _     -> me.While(guard, body)

        let trial = TrialBuilder()

module Example =
  open Trial.Control

  exception DefinitelyNotGood
  exception VeryBad

  let ``Do It!`` () =
    let t1 = Pass 40
    let t2 = Fail [ DefinitelyNotGood ]
    let t3 = Pass 2
    let t4 = Fail [ VeryBad ]

    let result = trial {
      from v1 in t1
      also v2 in t2
      also v3 in t3
      also v4 in t4
      yield v1 + v2 + v3 + v4
    }

    printfn "%A" result // Fail [ DefinitelyNotGood; VeryBad ])

  ``Do It!``()