F# SRTP Example

srtp.fsx

// SRTP: Statically Resolved Type Parameters
// https://docs.microsoft.com/en-us/dotnet/fsharp/language-reference/generics/statically-resolved-type-parameters

// SRTP Allows for pulling members out of types that where the member is named and typed the same
// In this example SRTP will be used to pull out the 'First: string' and 'Last: string' members
// from different types

// One example of SRTP in the F# Base Class Library is the (+) operator. 
// You'll see that it has this type signature:

(*
    val inline ( + ):
        x: ^T1 (requires static member ( + ) ) ->
        y: ^T2 (requires static member ( + ) )
        -> ^T3
*)

// Notice the " ^ " symbol to define the generic class instead of " ' "

// Members can come from either record or class definitions
type PersonRecord = { 
    First: string
    Last: string
}

// Even if the other type has extra members such as the 'Middle" member in this case
type PersonClass(first: string, middle: string, last: string) =
    member val First = first
    member val Middle = middle
    member val Last = last

let personRecord = { First = "Person"; Last = "Record"}
let personClass = PersonClass("Person", "Of", "Class")

// The person parameter has the type ^Person. 
// The definition of printPersonRegularParameter looks like this:
(* 
    val inline printPersonRegularParameter:
        person: ^Person (requires member First and member Last )
            -> unit
*)

// Notice that in the (+) signature the 'static member' was required, but our ^Person type
// Just needs a regular 'member'

let inline printPersonRegularParameter person = 
    // Notice the value is being pulled out of person with pattern matching
    let first = (^Person : (member First: string) person)
    let last = (^Person : (member Last: string) person) 
    printfn $"Person is: {first} {last}"

printPersonRegularParameter personRecord
printPersonRegularParameter personClass

// Because our 'PersonRecord' and 'PersonClass' are both going to be used in printPersonRegularParameter
// We also need to apply the 'inline' keyword to the function 
// This will create two versions of our function in the compiled code,
// one that takes the 'PersonRecord', and one that takes the 'PersonClass'.
// Without 'inline' this would create one function that takes in either the the 
// 'PersonRecord' or 'PersonClass' type (which ever is used in the function first), 
// and won't compile when we try to use the other type
(*
    ex.
    
    let printPersonRegularParameter person = ... (srtp definition from above, just without inline in the signature) ...
    printPersonRegularParameter personRecord  // Compiler warning: 
                                              // This construct causes code to be less generic 
                                              // than indicated by the type annotations. The type variable 
                                              // 'Person has been constrained to be type 'PersonRecord'.
    printPersonRegularParameter personClass   // Compiler error:
                                              // This expression was expected to have type
                                              //     'PersonRecord'    
                                              //  but here has type
                                              //     'PersonClass'
*)

// Because pulling values is done with pattern matching we can create 
// an active pattern to tidy up the pattern matching
let inline (|FirstName|) o =
    // ^FirstName could just as easily be ^T or ^a as long as it's using the '^' symbol
    (^FirstName: (member First: string) o)

let inline (|LastName|) o =
    (^LastName: (member Last: string) o)

(* Active Patterns can be composed together with the '&' symbol
   This is still looking for a single parameter defined as 
   having the First:string and Last:string members. *)

// Same signature as printPersonRegularParameter
let inline printPersonActivePatterns (FirstName first & LastName last) = 
    printfn $"Person is: {first} {last}"

printPersonActivePatterns personRecord
printPersonActivePatterns personClass

// And we could define another active pattern that combines our previous active patterns
// We'll just put return first and last in a tuple
let inline (|Person|) (FirstName first & LastName last) = first, last

// Same signature as printPersonRegularParameter and printPersonActivePatterns
// We can pull the tuple apart with further pattern matching
let inline printPersonCombinedActivePattern (Person (first, last)) = 
    printfn $"Person is: {first} {last}"

printPersonCombinedActivePattern personRecord
printPersonCombinedActivePattern personClass

srtp.fsx printed console output.txt

Person is: Person Record
Person is: Person Class
Person is: Person Record
Person is: Person Class
Person is: Person Record
Person is: Person Class

srtp.fsx type definitions.txt

type PersonRecord =
{
    First: string
    Last: string
}

type PersonClass =
  new: first: string * middle: string * last: string -> PersonClass
  member First: string
  member Last: string
  member Middle: string

val personRecord: PersonRecord = { First = "Person"
                                   Last = "Record" }

val personClass: PersonClass

val inline printPersonRegularParameter:
  person:  ^Person -> unit
    when  ^Person: (member get_First:  ^Person -> string) and
          ^Person: (member get_Last:  ^Person -> string)

val inline (|FirstName|) :
  o:  ^FirstName -> string
    when  ^FirstName: (member get_First:  ^FirstName -> string)

val inline (|LastName|) :
  o:  ^LastName -> string
    when  ^LastName: (member get_Last:  ^LastName -> string)

val inline printPersonActivePatterns:
   ^a -> unit
    when  ^a: (member get_Last:  ^a -> string) and
          ^a: (member get_First:  ^a -> string)

val inline (|Person|) :
   ^a -> string * string
    when  ^a: (member get_Last:  ^a -> string) and
          ^a: (member get_First:  ^a -> string)

val inline printPersonCombinedActivePattern:
   ^a -> unit
    when  ^a: (member get_Last:  ^a -> string) and
          ^a: (member get_First:  ^a -> string)