Skip to content

Instantly share code, notes, and snippets.

@psfblair
Last active August 29, 2015 14:04
Show Gist options
  • Select an option

  • Save psfblair/25e5e96a653cc7394941 to your computer and use it in GitHub Desktop.

Select an option

Save psfblair/25e5e96a653cc7394941 to your computer and use it in GitHub Desktop.
Emulating higher-kinded types in F#, maybe...?
type Functor<'A, 'T> = abstract member Map : ('T -> 'U) -> Functor<'A, 'U>
type ListFunctor<'T>(wrappedList: list<'T>) =
member this.Wrapped = wrappedList
interface Functor<list<obj>, 'T> with
member this.Map (mappingFunction: 'T -> 'U) : Functor<list<obj>, 'U> =
let result = List.map mappingFunction wrappedList
new ListFunctor<'U>(result) :> Functor<list<obj>, 'U>
type OptionFunctor<'T>(wrappedOption: option<'T>) =
member this.Wrapped = wrappedOption
interface Functor<option<obj>, 'T> with
member this.Map (mappingFunction: 'T -> 'U) : Functor<option<obj>, 'U> =
let result = Option.map mappingFunction wrappedOption
new OptionFunctor<'U>(result) :> Functor<option<obj>, 'U>
let fmap (f : 'T -> 'U) (x : Functor<'A, 'T>) : Functor<'A, 'U> = x.Map f
let listFunctor = new ListFunctor<int>([1;2;3;4])
let listFunctor2 = new ListFunctor<string>(["a";"b"])
let optionFunctor = new OptionFunctor<string>(Some("body"))
fmap ((+) 1) listFunctor
// => val it : Functor<obj list,int> = FSI_0003+ListFunctor`1[System.Int32] {Wrapped = [2; 3; 4; 5];}
fmap (fun (x:string) -> x.ToUpper()) listFunctor2
// => val it : Functor<obj list,string> = FSI_0003+ListFunctor`1[System.String] {Wrapped = ["A"; "B"];}
fmap (fun (x:string) -> x.Length) optionFunctor
// => val it : Functor<obj option,int> = FSI_0003+OptionFunctor`1[System.Int32] {Wrapped = Some 4;}
(*******************************************************************************)
[<AbstractClass>]
type Monad<'A, 'T>() =
static member Return (x: 'U) : Monad<'A, 'U> = raise <| new System.NotImplementedException("You must override this static method.")
abstract member Bind : ('T -> Monad<'A, 'U>) -> Monad<'A, 'U>
type OptionMonad<'T>(wrappedOption: option<'T>) =
inherit Monad<option<obj>, 'T>()
static member Return (toWrap: 'U) : Monad<option<obj>, 'U> =
let result = Some(toWrap)
new OptionMonad<'U>(result) :> Monad<option<obj>, 'U>
override this.Bind(monadYieldingFunction: 'T -> Monad<option<obj>, 'U>) : Monad<option<obj>, 'U> =
match wrappedOption with
| Some(x) -> monadYieldingFunction x
| None -> new OptionMonad<'U>(None) :> Monad<option<obj>, 'U>
member this.Wrapped: option<'T> = wrappedOption
type ListMonad<'T>(wrappedList: list<'T>) =
inherit Monad<list<obj>, 'T>()
static member Return (toWrap: 'U) : Monad<list<obj>, 'U> =
let result = [toWrap]
new ListMonad<'U>(result) :> Monad<list<obj>, 'U>
override this.Bind (monadYieldingFunction: 'T -> Monad<list<obj>, 'U>) : Monad<list<obj>, 'U> =
let rec flatMap (func: 'T -> Monad<list<obj>, 'U>) (xs: list<'T>) =
match xs with
| [] -> []
| head :: tail -> let headResults = (func head) :?> ListMonad<'U>
List.append headResults.Wrapped (flatMap func tail)
flatMap monadYieldingFunction wrappedList |> fun results -> new ListMonad<'U>(results) :> Monad<list<obj>, 'U>
member this.Wrapped: list<'T> = wrappedList
let returnMonad<'M, 'A, 'T, 'U when 'M :> Monad<'A,'T>>(toWrap: 'U) : Monad<'A,'U> =
let returnMethod = typeof<'M>.GetMethod("Return")
let genericMethod = returnMethod.MakeGenericMethod(typeof<'U>)
genericMethod.Invoke(null, [|toWrap|]) :?> Monad<'A,'U>
let bind (monad: Monad<'A, 'T>) (f: 'T -> Monad<'A, 'U>) : Monad<'A, 'U> = monad.Bind(f)
let sequence<'M, 'A, 'T when 'M :> Monad<'A,'T>>(inputMonads: list<'M>) : Monad<'A, list<'T>> =
let addToAccumulator inputMonad monadAccumulator =
bind inputMonad (fun x ->
bind monadAccumulator (fun xs ->
returnMonad<'M, 'A, 'T, list<'T>>(x :: xs)))
List.foldBack addToAccumulator inputMonads (returnMonad<'M, 'A, 'T, list<'T>> [])
let mapM (f: 'T -> 'M when 'M :> Monad<'A, 'U>) (xs: list<'T>) : Monad<'A, list<'U>> =
sequence (List.map f xs)
let listMonad = returnMonad<ListMonad<int>, list<obj>, int, int>(1)
// => val it : ListMonad<int> = FSI_0002+ListMonad`1[System.Int32] {Wrapped = [1];}
let optionMonad = returnMonad<OptionMonad<string>, option<obj>, string, string>("hello")
// => val it : OptionMonad<string> = FSI_0002+OptionMonad`1[System.String] {Wrapped = Some "hello";}
let testFunction = mapM (fun x -> if x % 2 = 0
then new OptionMonad<int>(Some(x / 2))
else new OptionMonad<int>(None))
testFunction [2;4]
// => val it : Monad<obj option,int list> = FSI_0003+OptionMonad`1[Microsoft.FSharp.Collections.FSharpList`1[System.Int32]] {Wrapped = Some [1; 2];}
testFunction [2;3;4]
// => val it : Monad<obj option,int list> = FSI_0003+OptionMonad`1[Microsoft.FSharp.Collections.FSharpList`1[System.Int32]] {Wrapped = null;}
@DetriusXii
Copy link

Hi,

Your approach doesn't work for monad transformers as a Monad transformer must be able to take any inner monad of type Monad<'A, 'T> and produce a definition of bind and map. The type 'A you specified doesn't tell you how to create the Monad<'A, 'T>.

What you need is a second class that represents the higher kinded type without the value parameter that instantiates the monad with the value parameter.

I have a monad library at https://github.com/DetriusXii/ExperimentalMonads/tree/master/Monads written in C# clarifies what I'm trying to explain.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment