Blog.GuestList.Lens.ResultLens.fs

type ValidationResult<'a> = Result<'a, ErrorsByTag>
type ResultLens<'a, 'b> = ('a -> ValidationResult<'b>) * ('b -> 'a -> ValidationResult<'a>)

module Compose =
  type ResultLens =
    | ResultLens with
        static member (>=>) (ResultLens, (g2, s2) : ResultLens<'b, 'c>) =
          fun ((g1, s1) : ResultLens<'a,'b>) ->
            (fun a -> g1 a >>= fun b -> g2 b),
            (fun c a -> g1 a >>= fun b -> s2 c b >>= fun b -> s1 b a) : ResultLens<'a,'c>

  let result l o = (ResultLens >=> o) l

module Optic =
  type Get =
    | Get with
        static member (^..) (Get, (g, _) : ResultLens<'a, 'b>) =
          fun (a : 'a) -> g a

  let inline get optic target =  (Get ^.. optic) target

  type Set =
    | Set with
        static member (^==) (Set, (_, s) : ResultLens<'a, 'b>) =
          fun (b : 'b) -> s b

  let inline set optic value = (Set ^== optic) value

  type Map =
    | Map with
        static member (^%%) (Map, (g, s) : ResultLens<'a, 'b>) =
          fun (f : 'b -> 'b) ->
            (fun a -> g a >>= fun b -> s (f b) a)

  let inline map optic f = (Map ^%% optic) f

[<AutoOpen>]
module Operators =
  let inline (>=>) l o = Compose.result l o
  let inline (^..) target optic = Optic.get optic target
  let inline (^==) value optic = Optic.set optic value
  let inline (^%%) f optic = Optic.map optic f