Railway oriented programming code from http://fsharpforfunandprofit.com/posts/recipe-part2/

gistfile1.fs

module CoreTypes = 

    type Result<'TSuccess,'TFailure> = 
        | Success of 'TSuccess
        | Failure of 'TFailure

    type Request = {name:string; email:string}

module BindExample1 = 

    open CoreTypes

    let validateInput input =
       if input.name = "" then Failure "Name must not be blank"
       else if input.email = "" then Failure "Email must not be blank"
       else Success input

    let bind switchFunction = 
        fun twoTrackInput -> 
            match twoTrackInput with
            | Success s -> switchFunction s
            | Failure f -> Failure f

    let bind2 switchFunction twoTrackInput = 
        match twoTrackInput with
        | Success s -> switchFunction s
        | Failure f -> Failure f

    let bind3 switchFunction = 
        function
        | Success s -> switchFunction s
        | Failure f -> Failure f


module ValidationExample = 

    open CoreTypes

    let validate1 input =
       if input.name = "" then Failure "Name must not be blank"
       else Success input

    let validate2 input =
       if input.name.Length > 50 then Failure "Name must not be longer than 50 chars"
       else Success input

    let validate3 input =
       if input.email = "" then Failure "Email must not be blank"
       else Success input

    let bind switchFunction twoTrackInput = 
        match twoTrackInput with
        | Success s -> switchFunction s
        | Failure f -> Failure f

    /// glue the three validation functions together
    let combinedValidation = 
        // convert from switch to two-track input
        let validate2' = bind validate2
        let validate3' = bind validate3
        // connect the two-tracks together
        validate1 >> validate2' >> validate3'

    /// glue the three validation functions together
    let combinedValidationInlined = 
        // connect the two-tracks together
        validate1 
        >> bind validate2 
        >> bind validate3

    /// create an infix operator
    let (>>=) twoTrackInput switchFunction = 
        bind switchFunction twoTrackInput 

    /// glue the three validation functions together using bind
    let combinedValidationWithPipe x = 
        x 
        |> validate1   // normal pipe because validate1 has a one-track input
                       // but validate1 results in a two track output...
        >>= validate2  // ... so use "bind pipe". Again the result is a two track output
        >>= validate3  // ... so use "bind pipe" again. 

    /// switch composition
    let (>=>) switch1 switch2 x = 
        match switch1 x with
        | Success s -> switch2 s
        | Failure f -> Failure f 

    /// glue the three validation functions together using switch composition
    let combinedValidationWithSwitchComposition = 
        validate1 
        >=> validate2 
        >=> validate3 

    module alternativeCompose = 

        let (>=>) switch1 switch2 = 
            switch1 >> (bind switch2)

module TestValidationExample = 

    open CoreTypes
    open ValidationExample

    // test 1
    let input1 = {name=""; email=""}
    combinedValidation input1 
    |> printfn "Result1=%A"
    // ==>  Result1=Failure "Name must not be blank"

    // test 2
    let input2 = {name="Alice"; email=""}
    combinedValidation input2 
    |> printfn "Result2=%A"
    // ==>  Result2=Failure "Email must not be blank"

    // test 3
    let input3 = {name="Alice"; email="good"}
    combinedValidation input3 
    |> printfn "Result3=%A"
    // ==>  Result3=Success {name = "Alice"; email = "good";}

module MapExample = 

    open CoreTypes
    open ValidationExample

    let canonicalizeEmail input =
       { input with email = input.email.Trim().ToLower() }

    // convert a normal function into a switch
    let switch f x = 
        f x |> Success

    let usecaseWithSwitch = 
        validate1 
        >=> validate2 
        >=> validate3 
        >=> switch canonicalizeEmail

    // convert a normal function into a two-track function
    let map f twoTrackInput = 
        match twoTrackInput with
        | Success s -> Success (f s)
        | Failure f -> Failure f

    let usecaseWithMap = 
        validate1 
        >=> validate2 
        >=> validate3 
        >> map canonicalizeEmail // normal composition

module TestMapExample = 
    open CoreTypes
    open MapExample

    let goodInput = {name="Alice"; email="UPPERCASE   "}
    usecaseWithSwitch goodInput
    |> printfn "Canonicalize Good Result = %A"

    let badInput = {name=""; email="UPPERCASE   "}
    usecaseWithSwitch badInput
    |> printfn "Canonicalize Bad Result = %A"

    //Canonicalize Good Result = Success {name = "Alice"; email = "uppercase";}
    //Canonicalize Bad Result = Failure "Name must not be blank"

module TeeExample = 

    open CoreTypes
    open ValidationExample
    open MapExample

    let tee f x = 
        f x |> ignore
        x

    let updateDatabase input =
       ()   // dummy dead-end function for now

    // version using switch
    let usecaseWithSwitch = 
        validate1 
        >=> validate2 
        >=> validate3 
        >=> switch canonicalizeEmail
        >=> switch (tee updateDatabase)

    // version using map
    let usecaseWithMap = 
        validate1 
        >> bind validate2 
        >> bind validate3 
        >> map canonicalizeEmail
        >> map (tee updateDatabase)

module ExceptionExample = 

    open CoreTypes
    open ValidationExample
    open MapExample
    open TeeExample

    let tryCatch f x =
        try
            f x |> Success
        with
        | ex -> Failure ex.Message

    let usecase = 
        validate1 
        >=> validate2 
        >=> validate3 
        >=> switch canonicalizeEmail
        >=> tryCatch (tee updateDatabase)

module DoubleMapExample = 

    open CoreTypes
    open ValidationExample
    open MapExample
    open TeeExample
    open ExceptionExample

    let doubleMap successFunc failureFunc twoTrackInput =
        match twoTrackInput with
        | Success s -> Success (successFunc s)
        | Failure f -> Failure (failureFunc f)

    // redefine map in terms of doubleMap
    let map successFunc =
        doubleMap successFunc id

    let log twoTrackInput = 
        let success x = printfn "DEBUG. Success so far: %A" x; x
        let failure x = printfn "ERROR. %A" x; x
        doubleMap success failure twoTrackInput 

    let usecase = 
        validate1 
        >=> validate2 
        >=> validate3 
        >=> switch canonicalizeEmail
        >=> tryCatch (tee updateDatabase)
        >> log

module TestDoubleMapExample =
    open CoreTypes
    open DoubleMapExample 

    let goodInput = {name="Alice"; email="good"}
    usecase goodInput
    |> printfn "Good Result = %A"
    
    let badInput = {name=""; email=""}
    usecase badInput 
    |> printfn "Bad Result = %A"

    // DEBUG. Success so far: {name = "Alice"; email = "good";}
    // Good Result = Success {name = "Alice"; email = "good";}
    //
    // ERROR. "Name must not be blank"
    // Bad Result = Failure "Name must not be blank"


module ParallelExample = 

    open CoreTypes
    open ValidationExample
    open MapExample
    open TeeExample
    open ExceptionExample

    /// add switches
    let plusXXX switch1 switch2 x = 
        match (switch1 x),(switch2 x) with
        | Success s1,Success s2 -> Success (s1 + s2)
        | Failure f1,Success _  -> Failure f1
        | Success _ ,Failure f2 -> Failure f2
        | Failure f1,Failure f2 -> Failure (f1 + f2)

    let plus addSuccess addFailure switch1 switch2 x = 
        match (switch1 x),(switch2 x) with
        | Success s1,Success s2 -> Success (addSuccess s1 s2)
        | Failure f1,Success _  -> Failure f1
        | Success _ ,Failure f2 -> Failure f2
        | Failure f1,Failure f2 -> Failure (addFailure f1 f2)

    // create a "plus" function for validation functions
    let (&&&) = 
        let addSuccess r1 r2 = r1 // return first
        let addFailure s1 s2 = s1 + "; " + s2  // concat
        plus addSuccess addFailure 

    let combinedValidation = 
        validate1 
        &&& validate2 
        &&& validate3 

    let usecase = 
        combinedValidation 
        >=> switch canonicalizeEmail
        >=> tryCatch (tee updateDatabase)


module TestParallelExample = 

    open CoreTypes
    open ParallelExample

    // test 1
    let input1 = {name=""; email=""}
    combinedValidation input1 
    |> printfn "Result1=%A"
    // ==>  Result1=Failure "Name must not be blank; Email must not be blank"

    // test 2
    let input2 = {name="Alice"; email=""}
    combinedValidation input2 
    |> printfn "Result2=%A"
    // ==>  Result2=Failure "Email must not be blank"

    // test 3
    let input3 = {name="Alice"; email="good"}
    combinedValidation input3 
    |> printfn "Result3=%A"
    // ==>  Result3=Success {name = "Alice"; email = "good";}

    // test 4
    let input4 = {name="Alice"; email="UPPERCASE   "}
    usecase input4
    |> printfn "Result4=%A"
    // ==>  Result4=Success {name = "Alice"; email = "uppercase";}

module DynamicExample = 

    open CoreTypes
    open ValidationExample
    open MapExample
    open TeeExample
    open ExceptionExample
    open DoubleMapExample 

    type Config = {debug:bool}

    let debugLogger twoTrackInput = 
        let success x = printfn "DEBUG. Success so far: %A" x; x
        let failure = id // don't log here
        doubleMap success failure twoTrackInput 

    let injectableLogger config = 
        if config.debug then debugLogger else id

    let usecase config = 
        combinedValidation 
        >> map canonicalizeEmail
        >> injectableLogger config

module TestDynamicExample = 
    open CoreTypes
    open DynamicExample


    let input = {name="Alice"; email="good"}

    let releaseConfig = {debug=false}
    input 
    |> usecase releaseConfig 
    |> ignore
    
    // no output

    let debugConfig = {debug=true}
    input 
    |> usecase debugConfig 
    |> ignore

    // debug output
    // DEBUG. Success so far: {name = "Alice"; email = "good";}


module RailwayCombinatorModule = 

    // the two-track type
    type Result<'TSuccess,'TFailure> = 
        | Success of 'TSuccess
        | Failure of 'TFailure

//    let (|Success|Failure|) =
//        function 
//        | Choice1Of2 s -> Success s
//        | Choice2Of2 f -> Failure f

    // convert a single value into a two-track result
    let succeed x = 
        Success x

    // convert a single value into a two-track result
    let fail x = 
        Failure x

    // appy either a success function or failure function
    let either successFunc failureFunc twoTrackInput =
        match twoTrackInput with
        | Success s -> successFunc s
        | Failure f -> failureFunc f


    // convert a switch function into a two-track function
    let bind f = 
        either f fail

    // pipe a two-track value into a switch function 
    let (>>=) x f = 
        bind f x

    // compose two switches into another switch
    let (>=>) s1 s2 = 
        s1 >> bind s2

    // convert a one-track function into a switch
    let switch f = 
        f >> succeed

    // convert a one-track function into a two-track function
    let map f = 
        either (f >> succeed) fail

    // convert a dead-end function into a one-track function
    let tee f x = 
        f x; x 

    // convert a one-track function into a switch with exception handling
    let tryCatch f exnHandler x =
        try
            f x |> succeed
        with
        | ex -> exnHandler ex |> fail

    // convert two one-track functions into a two-track function
    let doubleMap successFunc failureFunc =
        either (successFunc >> succeed) (failureFunc >> fail)

    // add two switches in parallel
    let plus addSuccess addFailure switch1 switch2 x = 
        match (switch1 x),(switch2 x) with
        | Success s1,Success s2 -> Success (addSuccess s1 s2)
        | Failure f1,Success _  -> Failure f1
        | Success _ ,Failure f2 -> Failure f2
        | Failure f1,Failure f2 -> Failure (addFailure f1 f2)

module FinalExample = 

    open CoreTypes
    open RailwayCombinatorModule 

    let validate1 input =
       if input.name = "" then Failure "Name must not be blank"
       else Success input

    let validate2 input =
       if input.name.Length > 50 then Failure "Name must not be longer than 50 chars"
       else Success input

    let validate3 input =
       if input.email = "" then Failure "Email must not be blank"
       else Success input

    // create a "plus" function for validation functions
    let (&&&) = 
        let addSuccess r1 r2 = r1 // return first
        let addFailure s1 s2 = s1 + "; " + s2  // concat
        plus addSuccess addFailure 

    let combinedValidation = 
        validate1 
        &&& validate2 
        &&& validate3 

    let canonicalizeEmail input =
       { input with email = input.email.Trim().ToLower() }

    let updateDatabase input =
       ()   // dummy dead-end function for now

    // new function to handle exceptions
    let updateDatebaseStep = 
        tryCatch (tee updateDatabase) (fun ex -> ex.Message)
    
    let log twoTrackInput = 
        let success x = printfn "DEBUG. Success so far: %A" x; x
        let failure x = printfn "ERROR. %A" x; x
        doubleMap success failure twoTrackInput 
    
    let usecase = 
        combinedValidation 
        >> map canonicalizeEmail
        >> bind updateDatebaseStep
        >> log