//[snippet:Core Definition] type HKT = interface end //[Struct] no F# 4.1 in ffsnip! type App<'F, 't when 'F :> HKT> = private App of payload : obj type App<'F, 't1, 't2 when 'F :> HKT> = App<'F, TCons<'t1, 't2>> and App<'F, 't1, 't2, 't3 when 'F :> HKT> = App<'F, TCons<'t1, 't2, 't3>> and App<'F, 't1, 't2, 't3, 't4 when 'F :> HKT> = App<'F, TCons<'t1, 't2, 't3, 't4>> and TCons<'T1, 'T2> = class end and TCons<'T1, 'T2, 'T3> = TCons, 'T3> and TCons<'T1, 'T2, 'T3, 'T4> = TCons, 'T4> [] module HKT = let inline pack (value : 'Fa) : App<'F, 'a> when 'F : (static member Assign : App<'F, 'a> * 'Fa -> unit) = App value let inline unpack (App value : App<'F, 'a>) : 'Fa when 'F : (static member Assign : App<'F, 'a> * 'Fa -> unit) = value :?> _ // active pattern variant useful for method definitions let inline (|Unpack|) app = unpack app //[/snippet] //[snippet:Pair Example] type Pair = interface HKT // method signature associates HKT encoding with underlying type // to be picked up by SRTP constraint solver static member Assign(_ : App, _ : 'a * 'b) = () let packed : App = HKT.pack ("foo", 42) let unpacked = HKT.unpack packed //[/snippet] //[snippet:Functor Example] type Functor<'F when 'F :> Functor<'F> and 'F : struct> = inherit HKT abstract Fmap : ('a -> 'b) -> App<'F, 'a> -> App<'F, 'b> let fmap f x : App<'F, 'b> when 'F :> Functor<'F> = Unchecked.defaultof<'F>.Fmap f x let incrementAndSquare xs = xs |> fmap (fun i -> i + 1) |> fmap (fun i -> i * i) [] type List = // associate App to 'a list static member Assign(_ : App, _ : 'a list) = () interface Functor with member __.Fmap f (HKT.Unpack xs) = HKT.pack (List.map f xs) let packedList = HKT.pack [1 .. 10] : App let packedList' = packedList |> incrementAndSquare |> fmap (fun i -> i.ToString()) let unpackedList' = HKT.unpack packedList' //[/snippet]