Consistent encoding for higher kinds

[gusty]

I propose to explore the possibility of using a consistent encoding for types that are normally represented with Higher Kinds in languages that support them.

Right now we use normally its wrapped value type, for example:

• ReaderT<'R,'M,'T> is represented asReaderT<'R,'M<'T>>`
• StateT<'S,'M,'T> is represented asStateT<'S,'M<'T*'S>>`

sometimes we get closer, by repeating the 'T parameter:

• Free<'Functor,'t> as Free<'``functor<'t>``,'t>

The problem is that we don't have "curried" versions of our monads, but we could use some techniques from type defunctionalization in order to get closer to it.

The first part of this exploration is to transform our current monad transformers to this encoding, back and forth and compare sample code that's hard to compile or that it doesn't compile at all, with this transformed version.

If this proves a better encoding, we could eventually include part of the transformation helpers with F#+ to allow the user to take advantage of it.

Then we could also attempt to rewrite or types based directly on this encoding as opposed to the wrapped-value based one. This could be an interesting re-design for F#+ V2.

One immediate advantage is that it will allow us to reason about the types, but I suspect type inference will also be able to benefit from this better reasoning.

Enough writing, let's continue with code:

#r @"C:\Users\YourWindowUser\.nuget\packages\fsharpplus\1.0.0\lib\net45\FSharpPlus.dll"

open FSharpPlus
open FSharpPlus.Data

/// It means a type parameter goes here but right now is not applied
type __ = Hole

let inline opaqueId x = Unchecked.defaultof<_>; x

[<Struct>]
type App<'f,'x> (value: obj) =
    member inline _.getValue () = value

type App<'f,'x,'y> = App<App<'f,'x>,'y>

type Inj = Inj with
    static member ($) (Inj, x:option<'t>   ) = App<option<__>   , 't> x
    static member ($) (Inj, x:list<'t>     ) = App<list<__>     , 't> x
    static member ($) (Inj, x:Async<'t>    ) = App<Async<__>    , 't> x
    static member ($) (Inj, x:Result<'t,'E>) = App<Result<__,'E>, 't> x
    static member ($) (Inj, x:'R -> 't     ) = App<'R->__, 't> x
    static member ($) (Inj, x:('W * 't)    ) = App<('W * __), 't> x

type Prj = Prj with
    static member (?<-) (Prj, _:option<__>   , _:'t) = fun (x: App<option<__>   ,'t>) -> (unbox (x.getValue ()) : option<'t>   )
    static member (?<-) (Prj, _:list<__>     , _:'t) = fun (x: App<list<__>     ,'t>) -> (unbox (x.getValue ()) : list<'t>     )
    static member (?<-) (Prj, _: Async<__>   , _:'t) = fun (x: App<Async<__>    ,'t>) -> (unbox (x.getValue ()) : Async<'t>    )
    static member (?<-) (Prj, _:Result<__,'E>, _:'t) = fun (x: App<Result<__,'E>,'t>) -> (unbox (x.getValue ()) : Result<'t,'E>)
    static member (?<-) (Prj, _: 'R->__      , _:'t) = fun (x: App<('R -> __)   ,'t>) -> (unbox (x.getValue ()) : 'R->'t  )
    static member (?<-) (Prj, _: 'R* __      , _:'t) = fun (x: App<('R * __)    ,'t>) -> (unbox (x.getValue ()) : 'R * 't )

let inline inj x = Inj $ x
let inline prj (x: App<'F,'X>) = (?<-) Prj Unchecked.defaultof<'F> Unchecked.defaultof<'X> x : 'R


// Actually the above can be defined in a generic way, for every functor

let inline genInj x : App<'Inner,'t> =
    if opaqueId false then
        let (_:'Inner) = map (fun (_:'t) -> Hole) x
        ()
    App<'Inner,'t> x

// .. and a similar technique for genPrj


// we need another ResultT which accept the error parameter
type ResultT<'T,'E> = ResultT2
type WriterT<'R,'T> = WriterT2

type Inj with static member inline ($) (Inj, OptionT x:OptionT<'t>   ) = let (_: App<'M, option<'X>>)    = inj x in App<OptionT<__>,'M,'X> x
type Inj with static member inline ($) (Inj, ListT x:ListT<'t>       ) = let (_: App<'M, list<'X>>)      = inj x in App<ListT<__>,'M,'X> x
type Inj with static member inline ($) (Inj, ResultT x:ResultT<'t>   ) = let (_: App<'M, Result<'X,'E>>) = inj x in App<ResultT<__,'E>,'M,'X> x
type Inj with static member inline ($) (Inj, ReaderT x:ReaderT<'R,'t>) = let (_: App<'M, 'X>)            = inj (x Unchecked.defaultof<'R>) in App<ReaderT<'R,__>,'M,'X> x
type Inj with static member inline ($) (Inj, WriterT x:WriterT<'t>   ) = let (_: App<'M,'X*'R>)          = inj x in App<WriterT<'R,__>,'M,'X> x
type Inj with static member inline ($) (Inj, StateT  x:StateT<'S,'t> ) = let (_: App<'M,'X*'R>)          = inj (x Unchecked.defaultof<'S>) in App<StateT<'S,__>,'M,'X> x



type Prj with
    static member inline (?<-) (Prj, _: App<OptionT<__>,'M>, _:'t) = fun (x: App<OptionT<__>,'M,'t>) ->
        let _: 'Mt =
            if opaqueId false then
                prj Unchecked.defaultof<App<'M,option<'t>>>
            else Unchecked.defaultof<'Mt>
        OptionT (unbox (x.getValue ()) : 'Mt)

type Prj with
    static member inline (?<-) (Prj, _: App<ListT<__>,'M>, _:'t) = fun (x: App<ListT<__>,'M,'t>) ->
        let _: 'Mt =
            if opaqueId false then
                prj Unchecked.defaultof<App<'M,list<'t>>>
            else Unchecked.defaultof<'Mt>
        ListT (unbox (x.getValue ()) : 'Mt)

type Prj with
    static member inline (?<-) (Prj, _: App<ResultT<__,'E>,'M>, _:'t) = fun (x: App<ResultT<__,'E>,'M,'t>) ->
        let _: 'Mt =
            if opaqueId false then
                prj Unchecked.defaultof<App<'M,Result<'t,'E>>>
            else Unchecked.defaultof<'Mt>
        ResultT (unbox (x.getValue ()) : 'Mt)

type Prj with
    static member inline (?<-) (Prj, _: App<ReaderT<'R,__>,'M>, _:'t) = fun (x: App<ReaderT<'R,__>,'M,'t>) ->
        let _: 'Mt =
            if opaqueId false then
                prj Unchecked.defaultof<App<'M,'t>>
            else Unchecked.defaultof<'Mt>
        ReaderT (unbox (x.getValue ()) : 'R->'Mt)


type Prj with
    static member inline (?<-) (Prj, _: App<WriterT<'R,__>,'M>, _:'t) = fun (x: App<WriterT<'R,__>,'M,'t>) ->
        let _: 'Mt =
            if opaqueId false then
                prj Unchecked.defaultof<App<'M,'t*'R>>
            else Unchecked.defaultof<'Mt>
        WriterT (unbox (x.getValue ()) : 'Mt)


type Prj with
    static member inline (?<-) (Prj, _: App<StateT<'S,__>,'M>, _:'t) = fun (x: App<StateT<'S,__>,'M,'t>) ->
        let _: 'Mt =
            if opaqueId false then
                prj Unchecked.defaultof<App<'M,'t*'S>>
            else Unchecked.defaultof<'Mt>
        StateT (unbox (x.getValue ()) : 'S->'Mt)


// F#+ bindings, allows us to operate directly over the encoding
type App<'f,'x> with
    static member inline Return (x: 'T) = 
        let _:'R = 
            if opaqueId false then
                prj Unchecked.defaultof<App<'F,'U>>
            else Unchecked.defaultof<'R>
        (result x : 'R) |> inj : App<'F,'U>
    static member inline Map (x: App<'F,'T>, f: 'T -> 'U) = map f (prj x) |> inj : App<'F,'U>
    static member inline (>>=) (x: App<'F,'T>, f: 'T -> App<'F,'U>) = prj x >>= (f >> prj) |> inj : App<'F,'U>


// A dedicated computation expression that uses internally the translation
type BuilderApp () =
    member        __.ReturnFrom (expr) = expr
    member inline __.Return (x: 'T) = App<_,_>.Return x            : App<'Monad,'T>
    member inline __.Yield  (x: 'T) = App<_,_>.Return x            : App<'Monad,'T>
    member inline __.Bind (p: App<'Monad,'T>, rest: 'T -> App<'Monad,'U>) = App<_,_>.(>>=) (p,  rest) : App<'Monad,'U>
    // member __.BindReturn   (x : App<'Monad,'T>, f: 'T -> 'U)        : App<'Monad,'U>      = App<_,_>.Map (x, f)  <-- type inference gets worse

    member inline __.Zero () = App<_,_>.Return ()                                       : App<'Monad,unit>
    member inline __.Combine (a: App<'Monad,unit>, b) = App<_,_>.(>>=) (a, fun () -> b) : App<'Monad,'T>

    member inline _.Source (x: 't) =
                let _:'t = 
                    if opaqueId false then
                        prj Unchecked.defaultof<App<'Monad,'T>>
                    else Unchecked.defaultof<'t>
                inj x: App<'Monad,'T>
    member inline _.Run (x: App<'Monad,'T>) = prj x : 't

let appl = BuilderApp ()


// a mixed between both techniques: the CE translate back and forth but then relies on App F#+ bindings
type BuilderAppDerived () =
    inherit Builder ()

    member inline _.Source (x: 't) =
                let _:'t = 
                    if opaqueId false then
                        prj Unchecked.defaultof<App<'Monad,'T>>
                    else Unchecked.defaultof<'t>
                inj x: App<'Monad,'T>
    member inline _.Run (x: App<'Monad,'T>) = prj x : 't

let appd = new BuilderAppDerived ()


/// make it compile first
#nowarn ""

// now here's the test code


let x = monad {
    let! a = Some 1 |> inj
    let! b = Some 2 |> inj
    return a + b
    }

let y = appl {
    let! a = Some 1
    let! b = Some 2
    return a + b
    }


let a : OptionT<Async<option<_>>> = monad {
    let! a = result 1  
    let! b = result "2"
    let  c = int b
    return a + c }

let b : App<ResultT<__,string>,Async<__>,int> = monad {
    let! a = result 1  
    let! b = result "2"
    let  c = int b
    return a + c }

let c : ResultT<Async<Result<int,string>>> =
    monad {
        let! a = result 1  
        let! b = result "2"
        let  c = int b
        return a + c } |> prj

let d : OptionT<Async<option<int>>> =
    appl {
        let! a = result 1  
        let! b = result "2"
        let  c = int b
        return a + c }

let e : ResultT<Async<Result<int,string>>> =
    appd {
        let! a = result 1  
        let! b = result "2"
        let  c = int b
        return a + c }

let f : ReaderT<string, Async<int>> =
    appl {
        let! a = result 1  
        let! b = result "2"
        let  c = int b
        return a + c }

let g : StateT<string, Async<_ * string>> =
    monad {
        let! a = result 1  
        let! b = result "2"
        let  c = int b
        return a + c }

let h : StateT<string, Async<_ * string>> =
    appl {
        let! a = result 1  
        let! b = result "2"
        let  c = int b
        return a + c }

let i : App<StateT<string,__>,Async<__>,int> =
    monad {
        let! a = result 1  
        let! b = result "2"
        let  c = int b
        return a + c }

let j : App<StateT<string,__>,App<ResultT<__,string>,Async<__>>,int> =
    monad {
        let! a = result 1  
        let! b = result "2"
        let  c = int b
        return a + c }


// we can define type alias for monad transformers, to avoid having to write (and read) App< .. , .. >
type StateT<'State,'Monad,'T> = App<StateT<'State,__>,'Monad,'T>

// and we could define type alias for monad with holes
type Async = Async<__>
type Result<'e> = Result<__,'e>

let i' : StateT<string,Async,int> =
    monad {
        let! a = result 1  
        let! b = result "2"
        let  c = int b
        return a + c }


let k : StateT<string,Result<string>,int> =
    monad {
        let! a = result 1  
        let! b = result "2"
        let  c = int b
        return a + c }