Pattern Matching on a generic container of a Discriminated Union

Question

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?

Answer 1

Would this do what you want?

open System

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

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

let e = 
    { Id = Guid.NewGuid(); 
      ConversationId = Guid.NewGuid(); 
      Created = DateTimeOffset.MinValue; 
      Item = CaseA {Text = ""; Number = 1  } }

match e with
| { Item = CaseA item } as x -> sprintf "%O: %s: %O" x.Id item.Text item.Number 
| { Item = CaseB item } as x -> sprintf "%O: %s: %O" x.Id item.Text item.Version

x is the original value and 'item' is either a RecA or a RecB.

Answer 2

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.

Answer 3

To rephrase your question, if I understand correctly, you want to switch on the contents of the envelope, while still having access to the header of the envelope?

In this case, why not just extract the contents, and then pass both the contents and the header around as a pair?

A helper function to create the pair might look like this:

let extractContents envelope = 
    envelope.Item, envelope 

And then your formatting code would be changed to handle the header and contents:

let formatA header (contents:RecA) = 
    sprintf "%O: %s: %O" header.Id contents.Text contents.Number
let formatB header (contents:RecB) = 
    sprintf "%O: %s: %O" header.Id contents.Text contents.Version

With this in place, you can use pattern matching in the normal way:

let format envelope =
    match (extractContents envelope) with
    | CaseA recA, envA -> formatA envA recA
    | CaseB recB, envB -> formatB envB recB

Here's the complete code:

open System

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

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


let extractContents envelope = 
    envelope.Item, envelope 

let formatA header (contents:RecA) = 
    sprintf "%O: %s: %O" header.Id contents.Text contents.Number
let formatB header (contents:RecB) = 
    sprintf "%O: %s: %O" header.Id contents.Text contents.Version

let format envelope =
    match (extractContents envelope) with
    | CaseA recA, envA -> formatA envA recA
    | CaseB recB, envB -> formatB envB recB

If I was doing this a lot, I would probably create a separate record type for the header, which would make this even simpler.

let extractContents envelope = 
    envelope.Item, envelope.Header 

BTW I would have written mapEnvelope slightly more simply :)

let mapEnvelope f envelope =
    {envelope with Item = f envelope.Item}

Answer 4

So this was a little confusing at first, but here is a simpler version of what you have (this is obviously not perfect because of the partial match but I am trying to improve it):

open System

type Envelope<'a> = {
    Item : 'a }

type RecA = { Text : string; Number : int }
type RecB = { Text : string; Version : Version }
type MyDu = |A of RecA |B of RecB

let (|UnionA|_|) x = 
    match x.Item with
    |A(a) -> Some{Item=a}
    |B(b) -> None

let (|UnionB|_|) x = 
    match x.Item with
    |A(_) -> None
    |B(b) -> Some{Item=b}


let test (t:Envelope<MyDu>) =
    match t with
    |UnionA(t) -> () //A case - T is a recA
    |UnionB(t) -> () //B case - T is a recB

The general problem is that we want a function that returns both a Envelope<RecA> and Envelope<RecB> (which is not very simple).

EDIT

Turns out this is actually easy:

let (|UnionC|UnionD|) x =
    match x.Item with
    |A(a) -> UnionC({Item=a})
    |B(b) -> UnionD{Item=b}

let test (t:Envelope<MyDu>) =
    match t with
    |UnionC(t) -> () //A case - T is a recA
    |UnionD(t) -> () //B case - T is a recB;;