|
| 1 | +module FSharpx.Tests.ValidationResultExample |
| 2 | + |
| 3 | +// ported from original in Scalaz: https://gist.github.com/970717 |
| 4 | +// copy of ValidationExample adjusted for Validation.Result |
| 5 | + |
| 6 | +open FSharpx.Result |
| 7 | +open NUnit.Framework |
| 8 | +open FsUnitTyped |
| 9 | + |
| 10 | +open FSharpx.Collections |
| 11 | +open FSharpx.Validation.Result |
| 12 | + |
| 13 | +// First let's define a domain. |
| 14 | + |
| 15 | +type Sobriety = Sober | Tipsy | Drunk | Paralytic | Unconscious |
| 16 | + |
| 17 | +type Gender = Male | Female |
| 18 | + |
| 19 | +type Person = { |
| 20 | + Gender: Gender |
| 21 | + Age: int |
| 22 | + Clothes: string Set |
| 23 | + Sobriety: Sobriety |
| 24 | +} |
| 25 | + |
| 26 | +// Let's define the checks that *all* nightclubs make! |
| 27 | +module Club = |
| 28 | + let checkAge (p: Person) = |
| 29 | + if p.Age < 18 then |
| 30 | + Error "Too young!" |
| 31 | + elif p.Age > 40 then |
| 32 | + Error "Too old!" |
| 33 | + else |
| 34 | + Ok p |
| 35 | + |
| 36 | + let checkClothes (p: Person) = |
| 37 | + if p.Gender = Male && not (p.Clothes.Contains "Tie") then |
| 38 | + Error "Smarten up!" |
| 39 | + elif p.Gender = Female && p.Clothes.Contains "Trainers" then |
| 40 | + Error "Wear high heels" |
| 41 | + else |
| 42 | + Ok p |
| 43 | + |
| 44 | + let checkSobriety (p: Person) = |
| 45 | + match p.Sobriety with |
| 46 | + | Drunk | Paralytic | Unconscious -> Error "Sober up!" |
| 47 | + | _ -> Ok p |
| 48 | + |
| 49 | +// Now let's compose some validation checks |
| 50 | + |
| 51 | +module ClubbedToDeath = |
| 52 | + open Club |
| 53 | + // PERFORM THE CHECKS USING Monadic "computation expression" SUGAR |
| 54 | + let either = ResultBuilder() |
| 55 | + let costToEnter p = |
| 56 | + either { |
| 57 | + let! a = checkAge p |
| 58 | + let! b = checkClothes a |
| 59 | + let! c = checkSobriety b |
| 60 | + return |
| 61 | + match c.Gender with |
| 62 | + | Female -> 0m |
| 63 | + | Male -> 5m |
| 64 | + } |
| 65 | + |
| 66 | + // or composing functions: |
| 67 | + |
| 68 | + let costToEnter2 = |
| 69 | + let costByGender (p: Person) = |
| 70 | + match p.Gender with |
| 71 | + | Female -> 0m |
| 72 | + | Male -> 5m |
| 73 | + let checkAll = checkAge >=> checkClothes >=> checkSobriety // kleisli composition |
| 74 | + checkAll >> Result.map costByGender |
| 75 | + |
| 76 | +// Now let's see these in action |
| 77 | + |
| 78 | +let Ken = { Person.Gender = Male; Age = 28; Clothes = set ["Tie"; "Shirt"]; Sobriety = Tipsy } |
| 79 | +let Dave = { Person.Gender = Male; Age = 41; Clothes = set ["Tie"; "Jeans"]; Sobriety = Sober } |
| 80 | +let Ruby = { Person.Gender = Female; Age = 25; Clothes = set ["High heels"]; Sobriety = Tipsy } |
| 81 | + |
| 82 | +// let's go clubbing! |
| 83 | + |
| 84 | +[<Test>] |
| 85 | +let part1() = |
| 86 | + ClubbedToDeath.costToEnter Dave |> shouldEqual (Error "Too old!") |
| 87 | + ClubbedToDeath.costToEnter Ken |> shouldEqual (Ok 5m) |
| 88 | + ClubbedToDeath.costToEnter Ruby |> shouldEqual (Ok 0m) |
| 89 | + ClubbedToDeath.costToEnter { Ruby with Age = 17 } |> shouldEqual (Error "Too young!") |
| 90 | + ClubbedToDeath.costToEnter { Ken with Sobriety = Unconscious } |> shouldEqual (Error "Sober up!") |
| 91 | + |
| 92 | +(** |
| 93 | + * The thing to note here is how the Validations can be composed together in a computation expression. |
| 94 | + * The type system is making sure that failures flow through your computation in a safe manner. |
| 95 | + *) |
| 96 | + |
| 97 | +(** |
| 98 | + * Part Two : Club Tropicana |
| 99 | + * |
| 100 | + * Part One showed monadic composition, which from the perspective of Validation is *fail-fast*. |
| 101 | + * That is, any failed check shortcircuits subsequent checks. This nicely models nightclubs in the |
| 102 | + * real world, as anyone who has dashed home for a pair of smart shoes and returned, only to be |
| 103 | + * told that your tie does not pass muster, will attest. |
| 104 | + * |
| 105 | + * But what about an ideal nightclub? One that tells you *everything* that is wrong with you. |
| 106 | + * |
| 107 | + * Applicative functors to the rescue! |
| 108 | + * |
| 109 | + *) |
| 110 | + |
| 111 | +module ClubTropicana = |
| 112 | + open Club |
| 113 | + let failToList x = Result.mapError NonEmptyList.singleton x |
| 114 | + let costByGender (p: Person) = |
| 115 | + match p.Gender with |
| 116 | + | Female -> 0m |
| 117 | + | Male -> 7.5m |
| 118 | + |
| 119 | + //PERFORM THE CHECKS USING applicative functors, accumulating failure via a monoid |
| 120 | + |
| 121 | + let costToEnter p = |
| 122 | + costByGender <!> (checkAge p |> failToList) *> (checkClothes p |> failToList) *> (checkSobriety p |> failToList) |
| 123 | + |
| 124 | + |
| 125 | +// And the use? Dave tried the second nightclub after a few more drinks in the pub |
| 126 | +[<Test>] |
| 127 | +let part2() = |
| 128 | + ClubTropicana.costToEnter { Dave with Sobriety = Paralytic } |
| 129 | + |> shouldEqual (Error (NonEmptyList.create "Too old!" ["Sober up!"])) |
| 130 | + |
| 131 | + ClubTropicana.costToEnter Ruby |> shouldEqual (Ok 0m) |
| 132 | + |
| 133 | +(** |
| 134 | + * |
| 135 | + * So, what have we done? Well, with a *tiny change* (and no changes to the individual checks themselves), |
| 136 | + * we have completely changed the behaviour to accumulate all errors, rather than halting at the first sign |
| 137 | + * of trouble. Imagine trying to do this using exceptions, with ten checks. |
| 138 | + * |
| 139 | + *) |
| 140 | + |
| 141 | +(** |
| 142 | + * |
| 143 | + * Part Three : Gay bar |
| 144 | + * |
| 145 | + * And for those wondering how to do this with a *very long list* of checks. |
| 146 | + * |
| 147 | + *) |
| 148 | + |
| 149 | +module GayBar = |
| 150 | + open Club |
| 151 | + let checkGender (p: Person) = |
| 152 | + match p.Gender with |
| 153 | + | Male -> Ok p |
| 154 | + | _ -> Error "Men only" |
| 155 | + |
| 156 | + let costToEnter p = |
| 157 | + [checkAge; checkClothes; checkSobriety; checkGender] |
| 158 | + |> mapM (fun check -> check p |> Result.mapError NonEmptyList.singleton) |
| 159 | + |> Result.map (function x::_ -> decimal x.Age + 1.5m | [] -> failwith "costToEnter") |
| 160 | + |
| 161 | +[<Test>] |
| 162 | +let part3() = |
| 163 | + GayBar.costToEnter { Person.Gender = Male; Age = 59; Clothes = set ["Jeans"]; Sobriety = Paralytic } |
| 164 | + |> shouldEqual (Error (NonEmptyList.create "Too old!" ["Smarten up!"; "Sober up!"])) |
| 165 | + |
| 166 | + GayBar.costToEnter { Person.Gender = Male; Age = 25; Clothes = set ["Tie"]; Sobriety = Sober } |> shouldEqual (Ok 26.5m) |
| 167 | + |
0 commit comments