Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Pattern Matching on a generic container of a Discriminated Union

I have this generic container of values:

open System

type Envelope<'a> = {
    Id : Guid
    ConversationId : Guid
    Created : DateTimeOffset
    Item : 'a }

I would like to be able to use Pattern Matching on the Item, while still retaining the envelope values.

Ideally, I would like to be able to do something like this:

let format x =
    match x with
    | Envelope (CaseA x) -> // x would be Envelope<RecA>
    | Envelope (CaseB x) -> // x would be Envelope<RecB>

However, this doesn't work, so I wonder if there's a way to do something like this?

Further details

Assume that I have these types:

type RecA = { Text : string; Number : int }
type RecB = { Text : string; Version : Version }

type MyDU = | CaseA of RecA | CaseB of RecB

I would like to be able to declare values of the type Envelope<MyDU> and still be able to match on the contained Item.

Perhaps this is going off on the wrong tangent, but I first attempted with a mapping function for envelopes:

let mapEnvelope f x =
    let y = f x.Item
    { Id = x.Id; ConversationId = x.ConversationId; Created = x.Created; Item = y }

This function has the signature ('a -> 'b) -> Envelope<'a> -> Envelope<'b>, so that looks like something we've seen before.

This enables me to define this Partial Active Pattern:

let (|Envelope|_|) (|ItemPattern|_|) x =
    match x.Item with
    | ItemPattern y -> x |> mapEnvelope (fun _ -> y) |> Some
    | _ -> None

and these auxiliary Partial Active Patterns:

let (|CaseA|_|) = function | CaseA x -> x |> Some | _ -> None
let (|CaseB|_|) = function | CaseB x -> x |> Some | _ -> None

With these building blocks, I can write a function like this one:

let formatA (x : Envelope<RecA>) = sprintf "%O: %s: %O" x.Id x.Item.Text x.Item.Number
let formatB (x : Envelope<RecB>) = sprintf "%O: %s: %O" x.Id x.Item.Text x.Item.Version
let format x =
    match x with
    | Envelope (|CaseA|_|) y -> y |> formatA
    | Envelope (|CaseB|_|) y -> y |> formatB
    | _ -> ""

Notice that in the first case, x is an Envelope<RecA>, which you can see because it's possible to read the value off x.Item.Number. Similarly, in the second case, x is Envelope<RecB>.

Also notice that each case requires access to x.Id from the envelope, which is the reason why I can't just match on x.Item to begin with.

This works, but has the following drawbacks:

  • I need to define a Partial Active Pattern like (|CaseA|_|) in order to decompose MyDU to CaseA, even though there's already a built-in pattern for that.
  • Even though I have a Discriminated Union, the compiler can't tell me if I've forgotten a case, because each of the patterns are Partial Active Patterns.

Is there a better way?

like image 262
Mark Seemann Avatar asked Mar 28 '14 08:03

Mark Seemann


1 Answers

This seems to be working:

let format x =
    match x.Item with
    | CaseA r  ->             
        let v = mapEnvelope (fun _ -> r) x 
        sprintf "%O: %s: %O" v.Id v.Item.Text v.Item.Number
    | CaseB r  -> 
        let v = mapEnvelope (fun _ -> r) x 
        sprintf "%O: %s: %O" v.Id v.Item.Text v.Item.Version

May be I didn't fully understand your question, but if you need in the end to call a function with an Envelope< RecA> you can since that's what v contains.

UPDATE

Here are some thoughts after understanding this was also your first attempt.

Ideally you would be able to use record syntax like this:

let v = {x with Item = r}

unfortunately it wont compile, because the generic parameter is of a different Type.

However you can mimic this expressions with named arguments, and playing with overloads you can make the compiler to decide the final type:

#nowarn "0049"
open System

type Envelope<'a> = 
    {Id :Guid; ConversationId :Guid; Created :DateTimeOffset; Item :'a}
    with
    member this.CloneWith(?Id, ?ConversationId, ?Created, ?Item) = {
            Id = defaultArg Id this.Id
            ConversationId = defaultArg ConversationId this.ConversationId
            Created = defaultArg Created this.Created
            Item = defaultArg Item this.Item}

    member this.CloneWith(Item, ?Id, ?ConversationId, ?Created) = {
            Id = defaultArg Id this.Id
            ConversationId = defaultArg ConversationId this.ConversationId
            Created = defaultArg Created this.Created
            Item = Item}

type RecA = { Text : string; Number : int }
type RecB = { Text : string; Version : Version }
type MyDU = | CaseA of RecA | CaseB of RecB

Now you can clone with a similar syntax and eventually change the generic type

let x = {
    Id = Guid.NewGuid()
    ConversationId = Guid.NewGuid()
    Created = DateTimeOffset.Now
    Item = CaseA  { Text = "";  Number = 0 }}

let a = x.CloneWith(Id = Guid.NewGuid())
let b = x.CloneWith(Id = Guid.NewGuid(), Item = CaseB {Text = ""; Version = null })
let c = x.CloneWith(Id = Guid.NewGuid(), Item =       {Text = ""; Version = null })

Then your match could be written like this:

let format x =
    match x.Item with
    | CaseA r  ->             
        let v =  x.CloneWith(Item = r)
        sprintf "%O: %s: %O" v.Id v.Item.Text v.Item.Number
    | CaseB r  -> 
        let v =  x.CloneWith(Item = r)
        sprintf "%O: %s: %O" v.Id v.Item.Text v.Item.Version

Of course you have to mention each field in the CloneWith method (in this case twice). But at the calling site the syntax is nicer. There might be solutions not mentioning all fields involving reflection.

like image 137
Gus Avatar answered Nov 16 '22 02:11

Gus