Advertisement
Guest User

Untitled

a guest
May 25th, 2015
273
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.91 KB | None | 0 0
  1. // First, the validation type (applicative only):
  2. type Validation<'e, 't> =
  3. | ErrorCollection of 'e list
  4. | Validated of 't
  5.  
  6. let (<*>) (f : Validation<'e, 'a -> 'b>) (v : Validation<'e, 'a>) : Validation<'e, 'b> =
  7. match f, v with
  8. | ErrorCollection e1, ErrorCollection e2 -> ErrorCollection (List.append e1 e2)
  9. | ErrorCollection e1, _ -> ErrorCollection e1
  10. | _, ErrorCollection e2 -> ErrorCollection e2
  11. | Validated f, Validated v -> Validated (f v)
  12.  
  13. let validationError e = ErrorCollection [e]
  14. let valid x = Validated x
  15.  
  16. let validate f v = Validated f <*> v
  17. let (<^>) = validate // dubious :)
  18.  
  19. // Next, the either-like type (monadic):
  20. type Result<'e, 't> = // todo: write a short-circuiting computation expression for this
  21. | Failure of 'e
  22. | Success of 't
  23.  
  24. // Can convert from validation to result:
  25. let fromValidation = function
  26. | ErrorCollection e -> Failure e
  27. | Validated v -> Success v
  28.  
  29. // Some example functions:
  30. type ValidationErrors = BadServer | BadAddress
  31.  
  32. let getServer input : Validation<ValidationErrors, string> = validationError BadServer
  33. let getAddress input : Validation<ValidationErrors, string> = validationError BadAddress
  34.  
  35. type ServerAndAddress = { server: string ; address: string }
  36. let getServerAndAddress input = (fun s a -> {server = s ; address = a}) <^> (getServer input) <*> (getAddress input)
  37.  
  38. // With hypothetical computation expression:
  39. ////let myFunc input = result {
  40. //// // can write it inline:
  41. //// let! (server, address) = (fun s a -> s, a) <^> (getServer input) <*> (getAddress input) |> fromValidation
  42. ////
  43. //// // or:
  44. //// let! serverAndAddress = fromValidation (getServerAndAddress input)
  45. ////
  46. //// return true
  47. //// }
  48.  
  49. [<EntryPoint>]
  50. let main argv =
  51.  
  52. match getServerAndAddress () with
  53. | ErrorCollection errs -> printfn "Failed: %A" errs
  54. | Validated v -> printfn "Success: %A" v
  55.  
  56. 0 // return an integer exit code
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement