4
\$\begingroup\$

I have put together this f# code in an attempt to solve the following problem

  • Given a mapping operation that may not be able to return a value
  • Cease mapping over the remaining items of a sequence if the mapping operation fails
  • Append the error to items already mapped and return early

This cannot be achieved with the inbuilt Seq.map and I could not locate any other existing implementations

type OptionFunction<'a, 'b> = 'a -> 'b option
type ResultFunction<'a, 'b, 'c> = 'a -> Result<'b, 'c>

type MaybeProjection<'a,'b,'c> =
    | OptionProjection of OptionFunction<'a,'b>
    | ResultProjection of ResultFunction<'a,'b,'c>

type OptionResultBuilder<'e>() = 
    member _.Return(x) = Result.Ok x
    member _.Bind(m,f) = 
             let r = match m with
                        | Some a -> Ok a
                        | None -> Error Unchecked.defaultof<'e>
             Result.bind f r
    member _.Bind(m,f) = Result.bind f m
    
let orb = OptionResultBuilder()

let mapTillFail mapper s = 
    let rec inner sq =
        seq {
            let mapped = orb {
                let! head = Seq.tryHead sq
                match mapper with
                | OptionProjection a -> 
                    let! m = a head
                    return m
                | ResultProjection a -> 
                    let! m = a head
                    return m
                }                    
                                
            match mapped with
                | Error _ as err-> yield err
                | Ok _ -> 
                    yield mapped
                    yield! sq |> Seq.skip 1 |> inner
        }
    inner s

//code to test it, not part of the implementation
let r = Seq.empty
let s = seq{1..10}

let op = OptionProjection (fun x -> if x < 5 then Some x else None)
let rp = ResultProjection (fun x -> if x < 5 then Ok x else Error "if >= 5")

r|> mapTillFail op
s|> mapTillFail op
r|> mapTillFail rp
s|> mapTillFail rp

The inbuilt Option and Result types are a natural fit, and I wanted to be able to use a mapping function that returned either of these types.

Despite several attempts to refactor the duplicate statements inside the match mapper with, I just could not not work out how to satisfy the compiler. Every attempt results in the compiler complaining that it can't find a suitable overload for Bind. Suggestions ?

Beyond that I'm largely happy with it for my purposes. But I welcome any other improvements, or comments on issues like performance (at this stage I've not stress tested it).

\$\endgroup\$

1 Answer 1

2
\$\begingroup\$

I can't say, I have the full understanding of computation expressions, so here are some comments that may go in another direction than your purpose with the post:

sq |> Seq.skip 1

can be replaced with

sq |> Seq.tail

I'm not sure, I like that the function returns [ Error null ] for an empty sequence, but that again may be needed in the context? I would expect an empty sequence to return - an empty sequence.


I don't understand the Projection layer, but that may be dictated by the original context.

You could define the type at the function level:

type MaybeFunction<'a, 'b, 'c> = 
    | OptionFunction of ('a -> 'b option)
    | ResultFunction of ('a -> Result<'b, 'c>)

and then create the functions as:

let mbopFunction = OptionFunction (fun x -> if x < 5 then Some x else None)
let mbrsFunction = ResultFunction (fun x -> if x < 5 then Ok x else Error "if >= 5")

Your main function will then looks like:

let mapTillFail mapper s = 
    let rec inner sq =
        seq {
            let mapped = orb {
                let! head = Seq.tryHead sq
                match mapper with
                | OptionFunction a -> 
                  let! m = a head
                  return m
                | ResultFunction a -> 
                    let! m = a head
                    return m
                }                    
                                
            match mapped with
                | Error _ as err-> yield err
                | Ok _ -> 
                    yield mapped
                    yield! sq |> Seq.tail |> inner
        }
    inner s

which tells that your monad can handle that level without modifications.

Maybe it would be fair to call these function Projections as well as that is what they do?


That said, you can go without the computation expression:

let mapTillFail projection data = 

    let test x =
        let result = 
            match projection with
            | OptionProjection a -> 
                match a x with
                | Some d -> Ok d
                | None -> Error Unchecked.defaultof<'c>
            | ResultProjection a -> a x
        result

    let rec inner lst =
        seq {
            match lst |> Seq.isEmpty with
            | true -> yield Error Unchecked.defaultof<'c>
            | _ ->
                match test (lst |> Seq.head) with
                | Error e -> yield Error e
                | Ok o ->
                    yield Ok o
                    yield! inner (lst |> Seq.tail)
        }

    inner data

Another alternative is to extent the MaybeProjection or MaybeFunction with a member called calculate:

type MaybeFunction<'a, 'b, 'c> = 
    | OptionFunction of ('a -> 'b option)
    | ResultFunction of ('a -> Result<'b, 'c>)
with
member this.Calculate (a) =
    match this with
    | OptionFunction f -> 
        match f a with
        | Some d -> Ok d
        | None -> Error Unchecked.defaultof<'c>
    | ResultFunction f -> f a

used as:

module Seq = 
    let mapTillFail (func: MaybeFunction<'a, 'b, 'c>) data =       
        
        let rec inner lst =
            seq {
                match lst |> Seq.isEmpty with
                | true -> ()
                | _ ->
                    match func.Calculate (lst |> Seq.head) with
                    | Error e -> yield Error e
                    | Ok o ->
                        yield Ok o
                        yield! inner (lst |> Seq.tail)
            }

        inner data

Here I've made an extension to Seq so you can call it like any other Seq functions:

printfn "%A" ((r |> Seq.mapTillFail mbopFunction) |> Seq.toList)
printfn "%A" ((s |> Seq.mapTillFail mbopFunction) |> Seq.toList)
printfn "%A" ((r |> Seq.mapTillFail mbrsFunction) |> Seq.toList)
printfn "%A" ((s |> Seq.mapTillFail mbrsFunction) |> Seq.toList)
\$\endgroup\$
2
  • \$\begingroup\$ Wow you review of my code is fantastic, I'm really grateful for your efforts. I've learnt quite a few things already. You were right about returning an empty list that is what should be expected, did not think that through from my end. Impressed that that it could be done without the computation expression too. I had a hammer and all I was seeing was nails...did not think outside the box. I like Calculate member approach very clever, I would never have thought of that. I've updated my version to yours and added it to my lib. Again a huge thanks! \$\endgroup\$ Jun 21, 2020 at 23:06
  • \$\begingroup\$ @OrdinaryOrange: My pleasure - I'm glad it's useful. \$\endgroup\$
    – user73941
    Jun 24, 2020 at 17:01

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.