typeclasses.fs

module TypeClasses

open System


let inline (|HasId|) x = (^a : (member Id : 'Id)x) // define type class
let inline getId (HasId x) = x // call type class instance
let inline (|HasShow|) x = (^a : (static member Show : ^a -> string)x) // define type class
let inline show (HasShow x) = x // call type class instance
let inline (|HasMap|) f x = (^x : (static member Map : ('a -> 'b) * ^x -> ^z) f, x) // define type class
let inline map f (HasMap f x) = x // call type class instance
// ========================================================
type User = { Id: Guid; UserName: string; } // define type
type Stack<'T> = Empty | Node of 'T * Stack<'T> // define type

// ========================================================
type User with static member Show (x: User) = x.ToString() // implement type class

type Stack<'a> with // implement type class
    static member Map (f, x) =
        match x with
        | Empty -> Empty
        | Node (x, xs) -> Node (f x, Stack.Map(f, xs))

// test usage
let user = { Id = Guid.NewGuid(); UserName = "User"; }
let userShow = show user // { Id = c3af72cf-d7fb-41fe-9e64-f4c15b316920 UserName = "User" } 
let userId = getId user // c3af72cf-d7fb-41fe-9e64-f4c15b316920
let stack = Node(9, Node(10, Empty)) // stack of int
let mapStack = map (fun x -> x.ToString()) stack // stack of string
let inline mapToStr x = map show x // combine type classes, require Map and Show members