Overloading and TypeClasses

overloaded_overload.fs

//////////////////////////////////////////////////////////////////////////////////////////
// first try, trying to generalize over overloading, nope, cant generalize over 
// two overloads

    let inline backend<'M, 'C, 'VM when 'C : (new : unit -> 'C)
                                   and 'C : (member Get : unit -> 'M seq)
                                   and 'C : (member Get : int Nullable -> 'M seq)
                                   and 'C : (member Get :'M Selector -> 'M seq)> () = 
        let getGet0 ( controller : ^C ) () =
            (^C : (member Get : unit -> 'M seq) ( controller, () ) )
        let getGet1 ( controller : ^C ) id =
            (^C : (member Get : int Nullable -> 'M seq) ( controller, id ) )            
        let getGet2 ( controller : ^C ) selector =
            (^C : (member Get : 'M Selector -> 'M seq) ( controller, selector ) )
        let c = new 'C ()
        let get0 = ( c |> getGet0 ) >> Seq.cast<obj>
        let get1 = ( c |> getGet1 ) >> Seq.cast<obj>
        let get2 = ( c |> getGet2 ) >> Seq.cast<obj>
        let vm = cloneObject<'VM> >> toObj
        let m = typeof<'M>
        ( m, ( get0, get1, get2 ), vm )

//////////////////////////////////////////////////////////////////////////////////////////
// perhaps "oring" is supported, nope, no "or" support

    let inline backend<'M, 'C, 'VM when 'C : (new : unit -> 'C)
                                   and ( 'C : (member Get : unit -> 'M seq)
                                   or 'C : (member Get : int Nullable -> 'M seq)
                                   or 'C : (member Get :'M Selector -> 'M seq) )> () = 
        let getGet0 ( controller : ^C ) () =
            (^C : (member Get : unit -> 'M seq) ( controller, () ) )
        let getGet1 ( controller : ^C ) id =
            (^C : (member Get : int Nullable -> 'M seq) ( controller, id ) )            
        let getGet2 ( controller : ^C ) selector =
            (^C : (member Get : 'M Selector -> 'M seq) ( controller, selector ) )
        let c = new 'C ()
        let get0 = ( c |> getGet0 ) >> Seq.cast<obj>
        let get1 = ( c |> getGet1 ) >> Seq.cast<obj>
        let get2 = ( c |> getGet2 ) >> Seq.cast<obj>
        let vm = cloneObject<'VM> >> toObj
        let m = typeof<'M>
        ( m, ( get0, get1, get2 ), vm )

//////////////////////////////////////////////////////////////////////////////////////////
// well reflection then

    let reflectMethod<'C, 'P, 'M, 'R> () =
        let isReturnType = (typeof<'R>).IsAssignableFrom
        typeof<'C>.GetMethods () 
        |> Seq.filter ( fun mi -> 
            let m = mi.GetParameters ()
            isReturnType mi.ReturnType &&
            ( m.Length = 0 && typeof<'P> = typeof<unit> ||
              m.Length = 1 && m.[0].ParameterType.GenericOrSelf = typeof<'P>.GenericOrSelf ) )
        |> Seq.tryHead
        |> whenSome ( fun mi ( i : 'C ) ( p : 'P ) ->
            let m = mi.GetParameters ()
            let v = p |> box |> unTypedCloneObject m.[0].ParameterType
            mi.Invoke ( i, [| v |] ) :?> 'R )

    let backend<'M, 'C, 'VM, 'P> () =
        let a () = Activator.CreateInstance<'C> ()
        let m = typeof<'M>
        let c = reflectMethod<'C, 'P, 'M, 'M seq> ()
        let vm = unbox >> cloneObject<'VM> >> box
        let ctl = c |> whenSome ( fun c -> unbox >> c ( a () ) >> Seq.map vm )
        Backend ( m, ctl )
        
//////////////////////////////////////////////////////////////////////////////////////////
// lets try it splitted

let inline backend0<'M, 'C when 'C : (member Get : unit -> 'M seq)> () = 
    let getGet0 () ( controller : ^C ) =
        (^C : (member Get : unit -> 'M seq) ( controller ) )
    getGet0

let inline backend1<'M, 'C when 'C : (member Get : int Nullable -> 'M seq)> () = 
    let getGet1 id ( controller : ^C ) =
        (^C : (member Get : int Nullable -> 'M seq) ( controller, id ) )            
    getGet1

let inline backend2<'M, 'C when 'C : (member Get :'M Data -> 'M seq)> () = 
    let getGet2 selector ( controller : ^C ) =
        (^C : (member Get : 'M Data -> 'M seq) ( controller, selector ) )
    getGet2
    
type UserViewModel = { id : int }

backend0<UserModel, UserController> () |> flip <| new UserController () <| ()
backend1<UserModel, UserController> () |> flip <| new UserController () <| Nullable 1
backend2<UserModel, UserController> () |> flip <| new UserController () <| AllData
 
let inline backend controller input =
    match box input with
    | :? ('M Data     ) as i -> backend2<'M, 'C2> () i
    | :? (int Nullable) as i -> backend1<'M, 'C1> () i
    | _                      -> backend0<'M, 'C0> () ()
    |> controller