Imagine you have a need to take one type, which may or may not be a discriminated union, and see if it “fits” inside of another type.  A typical case might be whether one discriminated union case would be a possible case for a different discriminated union.  That is, could the structure of type A fit into the structure of type B.  For lack of a better word, I am calling this “structural similarity”.

Lets start with some test cases:

module UnionTypeStructuralComparisonTest
open StructuralTypeSimilarity
open NUnit.Framework

type FooBar =
 | Salami of int
 | Foo of int * int
 | Bar of string

type FizzBuz =
 | Toast of int
 | Zap of int * int
 | Bang of string

type BigOption =
 | Crap of int * int
 | Bang of string
 | Kaboom of decimal

type Compound =
 | Frazzle of FizzBuz * FooBar
 | Crapola of double

[<TestFixture>]
type PersonalInsultTestCase() =

 [<Test>]
 member this.BangCanGoInFooBar() =
 let bang = Bang("I like cheese")
 Assert.IsTrue(bang =~= typeof<FizzBuz>)
 Assert.IsTrue(bang =~= typeof<FooBar>)
 Assert.IsTrue(bang =~= typeof<BigOption>)

 [<Test>]
 member this.KaboomDecimalDoesNotFitInFizzBuz() =
 let kaboom = Kaboom(45m)
 Assert.IsFalse(kaboom =~= typeof<FizzBuz>)

 [<Test>]
 member this.SomeStringCanBeFooBar() =
 let someString = "I like beer"
 Assert.IsTrue(someString =~= typeof<FooBar>)

 [<Test>]
 member this.SomeFoobarCanBeString() =
 let someFoobar = Bar("I like beer")
 Assert.IsTrue(someFoobar =~= typeof<string>)

 [<Test>]
 member this.SomeFoobarTypeCanBeString() =
 Assert.IsTrue(typeof<FooBar> =~= typeof<string>)

 [<Test>]
 member this.CompoundUnionTest() =
 let someCompound = Frazzle(Toast(4),Salami(2))
 Assert.IsTrue(someCompound =~= typeof<FooBar>)

To make this work, we are going to need to implement our =~= operator, and then do some FSharp type-fu in order to compare the structure:

module StructuralTypeSimilarity

open System
open Microsoft.FSharp.Reflection
open NLPParserCore

let isACase (testUnionType:Type) =
 testUnionType
 |> FSharpType.GetUnionCases
 |> Array.exists(fun u -> u.Name = testUnionType.Name)
let caseToTuple (case:UnionCaseInfo) =
 let fields = case.GetFields()
 if fields.Length > 1 then
 fields
 |> Array.map( fun pi -> pi.PropertyType )
 |> FSharpType.MakeTupleType
 else
 fields.[0].PropertyType 

let rec UnionTypeSourceSimilarToTargetSimpleType (testUnionType:Type) (targetType:Type) =
 if (testUnionType |> FSharpType.IsUnion)
   && (not (targetType |> FSharpType.IsUnion)) then
 if testUnionType |> isACase then
 let unionType = testUnionType
  |> FSharpType.GetUnionCases
  |> Array.find(fun u -> u.Name = testUnionType.Name)
 let myCaseType = caseToTuple unionType
 myCaseType =~= targetType
 else
 testUnionType
 |> FSharpType.GetUnionCases
 |> Array.map( fun case -> (case |> caseToTuple) =~= targetType )
 |> Array.exists( fun result -> result )
 else
 raise( new InvalidOperationException() )

and UnionTypeSourceSimilarToUnionTypeTarget (testUnionType:Type) (targetUnionType:Type) =
 if (testUnionType |> FSharpType.IsUnion)
  && (targetUnionType |> FSharpType.IsUnion) then
 if testUnionType |> isACase then
 targetUnionType
 |> FSharpType.GetUnionCases
 |> Array.map( fun u -> u |> caseToTuple )
 |> Array.map( fun targetTuple -> testUnionType =~= targetTuple )
 |> Array.exists( fun result -> result )
 else
 testUnionType
 |> FSharpType.GetUnionCases
 |> Array.map( fun case -> (case |> caseToTuple) =~= targetUnionType )
 |> Array.exists( fun result -> result )
 else
 raise( new InvalidOperationException() )

and SimpleTypeSourceSimilarToUnionTypeTarget (testSimpleType:Type) (targetUnionType:Type) =
 if (not (testSimpleType |> FSharpType.IsUnion))
  && (targetUnionType |> FSharpType.IsUnion) then
 targetUnionType
 |> FSharpType.GetUnionCases
 |> Array.map( fun u -> u |> caseToTuple )
 |> Array.map( fun targetTuple -> testSimpleType =~= targetTuple )
 |> Array.exists( fun result -> result )
 else
 raise( new InvalidOperationException() )

and SimpleTypeSourceSimilarToSimpleTypeTarget (testSimpleType:Type) (targetSimpleType:Type) =
 if (testSimpleType |> FSharpType.IsTuple) && (targetSimpleType |> FSharpType.IsTuple) then
 let testTupleTypes = testSimpleType |> FSharpType.GetTupleElements
 let targetTupleTypes = targetSimpleType |> FSharpType.GetTupleElements
 if testTupleTypes.Length = targetTupleTypes.Length then
 let matches = Array.zip testTupleTypes targetTupleTypes
 |> Array.map( fun(test,target) -> test =~= target )
 not (matches |> Array.exists( fun result -> not result ))
 else
 false
 else
 testSimpleType = targetSimpleType

and (=~=) (testObject:obj) (targetType:Type) =
 let objIsType (o:obj) =
 match o with
 | :? Type -> true
 | _ -> false

 let resolveToType (o:obj) =
 match objIsType o with
 | true -> o :?> Type
 | false -> o.GetType()
 let testObjectIsAType = testObject |> objIsType
 let testObjectTypeIsUnion =
 match testObjectIsAType with
 | true -> testObject |> resolveToType |> FSharpType.IsUnion
 | false -> false
 let targetTypeIsAUnion = targetType |> FSharpType.IsUnion 

 let resolvedType = testObject |> resolveToType

 match testObjectIsAType,testObjectTypeIsUnion,targetTypeIsAUnion with
 | false, _, _ -> resolvedType =~= targetType
 | true,true,false -> UnionTypeSourceSimilarToTargetSimpleType resolvedType targetType
 | true,false,false -> SimpleTypeSourceSimilarToSimpleTypeTarget resolvedType targetType
 | true,true,true -> UnionTypeSourceSimilarToUnionTypeTarget resolvedType targetType
 | true,false,true -> SimpleTypeSourceSimilarToUnionTypeTarget resolvedType targetType

Getting this to work seemed harder than it should.  While my tests pass, I am sure there are both cases I have not yet covered, and probably some simpler ways I could accomplish some of the same goals.

While this is a work in progress, if anyone has any thoughts for simpler ways to do something like this, I am all ears.