15 people like it.

Abstracting over 'M'

A higher kind of request to Don Syme... please please please,,,, we desperately need higher kinds!

  1: 
  2: 
  3: 
  4: 
  5: 
  6: 
  7: 
  8: 
  9: 
 10: 
 11: 
 12: 
 13: 
 14: 
 15: 
 16: 
 17: 
 18: 
 19: 
 20: 
 21: 
 22: 
 23: 
 24: 
 25: 
 26: 
 27: 
 28: 
 29: 
 30: 
 31: 
 32: 
 33: 
 34: 
 35: 
 36: 
 37: 
 38: 
 39: 
 40: 
 41: 
 42: 
 43: 
 44: 
 45: 
 46: 
 47: 
 48: 
 49: 
 50: 
 51: 
 52: 
 53: 
 54: 
 55: 
 56: 
 57: 
 58: 
 59: 
 60: 
 61: 
 62: 
 63: 
 64: 
 65: 
 66: 
 67: 
 68: 
 69: 
 70: 
 71: 
 72: 
 73: 
 74: 
 75: 
 76: 
 77: 
 78: 
 79: 
 80: 
 81: 
 82: 
 83: 
 84: 
 85: 
 86: 
 87: 
 88: 
 89: 
 90: 
 91: 
 92: 
 93: 
 94: 
 95: 
 96: 
 97: 
 98: 
 99: 
100: 
101: 
102: 
103: 
104: 
105: 
106: 
107: 
108: 
109: 
110: 
111: 
112: 
113: 
114: 
115: 
116: 
117: 
118: 
119: 
120: 
121: 
122: 
123: 
// Inspired by http://higherlogics.blogspot.com/2009/10/abstracting-over-type-constructors.html
// Join our voices http://t0yv0.blogspot.com/2011/02/where-fnet-falls-short-higher-kinds.html


module MonadModule = 
    //Generic Monad Definition
    [<AbstractClass>]
    type MonadDef<'M when 'M :> MonadDef<'M>>() as this = 
         let (>>=) m f = this.Bind(m, f)
         let unit v = this.Return v
         static let listDef = ListDef()

         abstract member Return<'T> : 'T -> IMonad<'T,'M> 
         abstract member Bind<'T, 'S> : IMonad<'T,'M> * ('T -> IMonad<'S,'M>) -> IMonad<'S,'M> 
         abstract member Zero<'T> : unit -> IMonad<'T,'M>
         
         member this.Delay(f) = unit () >>= fun () -> f()
         member this.Combine<'T>(first : IMonad<unit, 'M>, second : IMonad<'T, 'M>) : IMonad<'T, 'M>  = 
            this.Then (first, second)

         member this.Then<'T, 'S>(firstM : IMonad<'T, 'M>, secondM : IMonad<'S, 'M>) : IMonad<'S, 'M> =
            firstM >>= fun _ -> secondM

         member this.Map<'T, 'S>(f : 'T -> 'S, m : IMonad<'T, 'M>) : IMonad<'S, 'M> =
            m >>= fun v -> unit (f v)

         member this.Apply<'T, 'S>(mf : IMonad<'T -> 'S, 'M>, m : IMonad<'T, 'M>) : IMonad<'S, 'M> =
            mf >>= fun f -> m >>= fun v -> unit (f v)   

         member this.Join<'T>(m : IMonad<IMonad<'T, 'M>, 'M>) : IMonad<'T, 'M> =
            m >>= id

         member this.Sequence<'T>(lm : IMonad<IMonad<'T, 'M>, ListDef>) : IMonad<IMonad<'T, ListDef>, 'M> =
            match lm :?> _ with
            | Nil -> unit (Nil :> _)
            | Cons (m, ms) -> m >>= fun v -> this.Sequence ms >>= fun vs -> unit (listDef.ConsM v vs)
        
         member this.MapM<'T, 'S>(f : 'T -> IMonad<'S, 'M>, l : IMonad<'T, ListDef>) : IMonad<IMonad<'S, ListDef>, 'M> =  
            this.Sequence (listDef.Map ((fun v -> f v), l))

         member this.FilterM<'T>(p : 'T -> IMonad<bool, 'M>, l : IMonad<'T, ListDef>) : IMonad<IMonad<'T, ListDef>, 'M> =
            match l :?> _ with
            | Nil -> unit (Nil :> _)
            | Cons (x, xs) -> p x >>= fun b -> this.FilterM (p, xs) >>= fun ys -> if b then unit (listDef.ConsM x ys) else unit ys   

    and IMonad<'T,'M when 'M :> MonadDef<'M>> = interface end 

    // List Monad
    and List<'T> = 
        | Nil
        | Cons of ('T * List<'T>)
        interface IMonad<'T, ListDef>
    and
        ListDef() = 
            inherit MonadDef<ListDef>() with
                member this.OfList<'T>(xs : list<'T>) : IMonad<'T, ListDef> =
                    List.foldBack (fun v acc -> this.ConsM v acc) xs <| this.Zero() 

                member this.ConsM (x : 'T) (acc : IMonad<'T, ListDef>) : IMonad<'T, ListDef> = Cons (x, acc :?> _) :> _
                 
                member this.Foldr<'T, 'S>(f : 'T -> 'S -> 'S, seed : 'S, list : IMonad<'T, ListDef>) : 'S =
                    match list :?> _ with
                    | Nil -> seed
                    | Cons (x, xs) -> f x (this.Foldr (f, seed, xs) )

                member this.Concat<'T>(first : IMonad<'T, ListDef>, second : IMonad<'T, ListDef>) : IMonad<'T, ListDef> =
                    this.Foldr(this.ConsM, second, first)

                override this.Return<'T>(v : 'T) : IMonad<'T, ListDef> = 
                    Cons (v, Nil) :> _ 
          
                override this.Bind<'T,'S>(m : IMonad<'T, ListDef>, f : 'T -> IMonad<'S, ListDef>) : IMonad<'S, ListDef> =  
                    this.Foldr ((fun x acc -> this.Concat (f x, acc)), Nil :> _, m)

                override this.Zero<'T>() : IMonad<'T, ListDef> = 
                    Nil :> _ 
 
    let listM = ListDef()


open MonadModule

// Maybe Monad
module MaybeModule =

    type Maybe<'T> = 
        | Nothing 
        | Just of 'T 
        interface IMonad<'T, MaybeDef> 
    and 
        
        MaybeDef() = 
            inherit MonadDef<MaybeDef>() with
                override this.Return<'T>(v : 'T) : IMonad<'T, MaybeDef> = 
                    Just v :> _ 
      
                override this.Bind<'T,'S>(m : IMonad<'T, MaybeDef>, f : 'T -> IMonad<'S, MaybeDef>) : IMonad<'S, MaybeDef> = 
                    match m :?> _ with 
                    | Nothing -> Nothing :> _ 
                    | Just x  -> f x

                override this.Zero<'T>() : IMonad<'T, MaybeDef> = 
                    Nothing :> _
                
                member this.Just<'T>(value : 'T) : IMonad<'T, MaybeDef> =
                    Just value :> _
                member this.Nothing<'T>() : IMonad<'T, MaybeDef> =
                    Nothing :> _
    
    let maybeM = new MaybeDef()     
 

open MaybeModule


//Examples

let test = listM.OfList [ maybeM.Just 1; maybeM.Just 2 ]
maybeM.Sequence test |> printfn "%A"


let powerSet xs = listM.FilterM ((fun _ -> listM.OfList [false; true]), listM.OfList xs)
powerSet [1..3] |> printfn "%A"
Multiple items
type AbstractClassAttribute =
  inherit Attribute
  new : unit -> AbstractClassAttribute

Full name: Microsoft.FSharp.Core.AbstractClassAttribute

--------------------
new : unit -> AbstractClassAttribute
Multiple items
type MonadDef<'M (requires 'M :> MonadDef<'M>)> =
  new : unit -> MonadDef<'M>
  abstract member Bind : IMonad<'T,'M> * ('T -> IMonad<'S,'M>) -> IMonad<'S,'M>
  abstract member Return : 'T -> IMonad<'T,'M>
  abstract member Zero : unit -> IMonad<'T,'M>
  member Apply : mf:IMonad<('T -> 'S),'M> * m:IMonad<'T,'M> -> IMonad<'S,'M>
  member Combine : first:IMonad<unit,'M> * second:IMonad<'T,'M> -> IMonad<'T,'M>
  member Delay : f:(unit -> IMonad<'a,'M>) -> IMonad<'a,'M>
  member FilterM : p:('T -> IMonad<bool,'M>) * l:IMonad<'T,ListDef> -> IMonad<IMonad<'T,ListDef>,'M>
  member Join : m:IMonad<IMonad<'T,'M>,'M> -> IMonad<'T,'M>
  member Map : f:('T -> 'S) * m:IMonad<'T,'M> -> IMonad<'S,'M>
  ...

Full name: Script.MonadModule.MonadDef<_>

--------------------
new : unit -> MonadDef<'M>
val this : MonadDef<'M> (requires 'M :> MonadDef<'M>)
val m : IMonad<'b,'M> (requires 'M :> MonadDef<'M>)
val f : ('b -> IMonad<'c,'M>) (requires 'M :> MonadDef<'M>)
abstract member MonadDef.Bind : IMonad<'T,'M> * ('T -> IMonad<'S,'M>) -> IMonad<'S,'M>
Multiple items
val unit : ('b -> IMonad<'b,'M>) (requires 'M :> MonadDef<'M>)

--------------------
type unit = Unit

Full name: Microsoft.FSharp.Core.unit
val v : 'b
abstract member MonadDef.Return : 'T -> IMonad<'T,'M>
val listDef : ListDef
Multiple items
type ListDef =
  inherit MonadDef<ListDef>
  new : unit -> ListDef
  override Bind : m:IMonad<'T,ListDef> * f:('T -> IMonad<'S,ListDef>) -> IMonad<'S,ListDef>
  member Concat : first:IMonad<'T,ListDef> * second:IMonad<'T,ListDef> -> IMonad<'T,ListDef>
  member ConsM : x:'T -> acc:IMonad<'T,ListDef> -> IMonad<'T,ListDef>
  member Foldr : f:('T -> 'S -> 'S) * seed:'S * list:IMonad<'T,ListDef> -> 'S
  member OfList : xs:'T list -> IMonad<'T,ListDef>
  override Return : v:'T -> IMonad<'T,ListDef>
  override Zero : unit -> IMonad<'T,ListDef>

Full name: Script.MonadModule.ListDef

--------------------
new : unit -> ListDef
abstract member MonadDef.Return : 'T -> IMonad<'T,'M>

Full name: Script.MonadModule.MonadDef`1.Return
type IMonad<'T,'M (requires 'M :> MonadDef<'M>)>

Full name: Script.MonadModule.IMonad<_,_>
abstract member MonadDef.Bind : IMonad<'T,'M> * ('T -> IMonad<'S,'M>) -> IMonad<'S,'M>

Full name: Script.MonadModule.MonadDef`1.Bind
abstract member MonadDef.Zero : unit -> IMonad<'T,'M>

Full name: Script.MonadModule.MonadDef`1.Zero
type unit = Unit

Full name: Microsoft.FSharp.Core.unit
member MonadDef.Delay : f:(unit -> IMonad<'a,'M>) -> IMonad<'a,'M>

Full name: Script.MonadModule.MonadDef`1.Delay
val f : (unit -> IMonad<'a,'M>) (requires 'M :> MonadDef<'M>)
member MonadDef.Combine : first:IMonad<unit,'M> * second:IMonad<'T,'M> -> IMonad<'T,'M>

Full name: Script.MonadModule.MonadDef`1.Combine
val first : IMonad<unit,'M> (requires 'M :> MonadDef<'M>)
val second : IMonad<'T,'M> (requires 'M :> MonadDef<'M>)
member MonadDef.Then : firstM:IMonad<'T,'M> * secondM:IMonad<'S,'M> -> IMonad<'S,'M>
member MonadDef.Then : firstM:IMonad<'T,'M> * secondM:IMonad<'S,'M> -> IMonad<'S,'M>

Full name: Script.MonadModule.MonadDef`1.Then
val firstM : IMonad<'T,'M> (requires 'M :> MonadDef<'M>)
val secondM : IMonad<'S,'M> (requires 'M :> MonadDef<'M>)
Multiple items
member MonadDef.Map : f:('T -> 'S) * m:IMonad<'T,'M> -> IMonad<'S,'M>

Full name: Script.MonadModule.MonadDef`1.Map

--------------------
module Map

from Microsoft.FSharp.Collections

--------------------
type Map<'Key,'Value (requires comparison)> =
  interface IEnumerable
  interface IComparable
  interface IEnumerable<KeyValuePair<'Key,'Value>>
  interface ICollection<KeyValuePair<'Key,'Value>>
  interface IDictionary<'Key,'Value>
  new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
  member Add : key:'Key * value:'Value -> Map<'Key,'Value>
  member ContainsKey : key:'Key -> bool
  override Equals : obj -> bool
  member Remove : key:'Key -> Map<'Key,'Value>
  ...

Full name: Microsoft.FSharp.Collections.Map<_,_>

--------------------
new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
val f : ('T -> 'S)
val m : IMonad<'T,'M> (requires 'M :> MonadDef<'M>)
val v : 'T
member MonadDef.Apply : mf:IMonad<('T -> 'S),'M> * m:IMonad<'T,'M> -> IMonad<'S,'M>

Full name: Script.MonadModule.MonadDef`1.Apply
val mf : IMonad<('T -> 'S),'M> (requires 'M :> MonadDef<'M>)
member MonadDef.Join : m:IMonad<IMonad<'T,'M>,'M> -> IMonad<'T,'M>

Full name: Script.MonadModule.MonadDef`1.Join
val m : IMonad<IMonad<'T,'M>,'M> (requires 'M :> MonadDef<'M>)
val id : x:'T -> 'T

Full name: Microsoft.FSharp.Core.Operators.id
member MonadDef.Sequence : lm:IMonad<IMonad<'T,'M>,ListDef> -> IMonad<IMonad<'T,ListDef>,'M>

Full name: Script.MonadModule.MonadDef`1.Sequence
val lm : IMonad<IMonad<'T,'M>,ListDef> (requires 'M :> MonadDef<'M>)
union case List.Nil: List<'T>
union case List.Cons: ('T * List<'T>) -> List<'T>
val ms : List<IMonad<'T,'M>> (requires 'M :> MonadDef<'M>)
member MonadDef.Sequence : lm:IMonad<IMonad<'T,'M>,ListDef> -> IMonad<IMonad<'T,ListDef>,'M>
val vs : IMonad<'T,ListDef>
member ListDef.ConsM : x:'T -> acc:IMonad<'T,ListDef> -> IMonad<'T,ListDef>
member MonadDef.MapM : f:('T -> IMonad<'S,'M>) * l:IMonad<'T,ListDef> -> IMonad<IMonad<'S,ListDef>,'M>

Full name: Script.MonadModule.MonadDef`1.MapM
val f : ('T -> IMonad<'S,'M>) (requires 'M :> MonadDef<'M>)
val l : IMonad<'T,ListDef>
member MonadDef.Map : f:('T -> 'S) * m:IMonad<'T,'M> -> IMonad<'S,'M>
member MonadDef.FilterM : p:('T -> IMonad<bool,'M>) * l:IMonad<'T,ListDef> -> IMonad<IMonad<'T,ListDef>,'M>

Full name: Script.MonadModule.MonadDef`1.FilterM
val p : ('T -> IMonad<bool,'M>) (requires 'M :> MonadDef<'M>)
type bool = System.Boolean

Full name: Microsoft.FSharp.Core.bool
val x : 'T
val xs : List<'T>
val b : bool
member MonadDef.FilterM : p:('T -> IMonad<bool,'M>) * l:IMonad<'T,ListDef> -> IMonad<IMonad<'T,ListDef>,'M>
val ys : IMonad<'T,ListDef>
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | Nil
  | Cons of ('T * List<'T>)
  interface IMonad<'T,ListDef>

Full name: Script.MonadModule.List<_>
val this : ListDef
member ListDef.OfList : xs:'T list -> IMonad<'T,ListDef>

Full name: Script.MonadModule.ListDef.OfList
val xs : 'T list
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
val foldBack : folder:('T -> 'State -> 'State) -> list:'T list -> state:'State -> 'State

Full name: Microsoft.FSharp.Collections.List.foldBack
val acc : IMonad<'T,ListDef>
override ListDef.Zero : unit -> IMonad<'T,ListDef>
member ListDef.ConsM : x:'T -> acc:IMonad<'T,ListDef> -> IMonad<'T,ListDef>

Full name: Script.MonadModule.ListDef.ConsM
member ListDef.Foldr : f:('T -> 'S -> 'S) * seed:'S * list:IMonad<'T,ListDef> -> 'S

Full name: Script.MonadModule.ListDef.Foldr
val f : ('T -> 'S -> 'S)
val seed : 'S
Multiple items
val list : IMonad<'T,ListDef>

--------------------
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
member ListDef.Foldr : f:('T -> 'S -> 'S) * seed:'S * list:IMonad<'T,ListDef> -> 'S
member ListDef.Concat : first:IMonad<'T,ListDef> * second:IMonad<'T,ListDef> -> IMonad<'T,ListDef>

Full name: Script.MonadModule.ListDef.Concat
val first : IMonad<'T,ListDef>
val second : IMonad<'T,ListDef>
override ListDef.Return : v:'T -> IMonad<'T,ListDef>

Full name: Script.MonadModule.ListDef.Return
override ListDef.Bind : m:IMonad<'T,ListDef> * f:('T -> IMonad<'S,ListDef>) -> IMonad<'S,ListDef>

Full name: Script.MonadModule.ListDef.Bind
val m : IMonad<'T,ListDef>
val f : ('T -> IMonad<'S,ListDef>)
val acc : IMonad<'S,ListDef>
member ListDef.Concat : first:IMonad<'T,ListDef> * second:IMonad<'T,ListDef> -> IMonad<'T,ListDef>
override ListDef.Zero : unit -> IMonad<'T,ListDef>

Full name: Script.MonadModule.ListDef.Zero
val listM : ListDef

Full name: Script.MonadModule.listM
module MonadModule

from Script
type Maybe<'T> =
  | Nothing
  | Just of 'T
  interface IMonad<'T,MaybeDef>

Full name: Script.MaybeModule.Maybe<_>
union case Maybe.Nothing: Maybe<'T>
union case Maybe.Just: 'T -> Maybe<'T>
Multiple items
type MaybeDef =
  inherit MonadDef<MaybeDef>
  new : unit -> MaybeDef
  override Bind : m:IMonad<'T,MaybeDef> * f:('T -> IMonad<'S,MaybeDef>) -> IMonad<'S,MaybeDef>
  member Just : value:'T -> IMonad<'T,MaybeDef>
  member Nothing : unit -> IMonad<'T,MaybeDef>
  override Return : v:'T -> IMonad<'T,MaybeDef>
  override Zero : unit -> IMonad<'T,MaybeDef>

Full name: Script.MaybeModule.MaybeDef

--------------------
new : unit -> MaybeDef
val this : MaybeDef
override MaybeDef.Return : v:'T -> IMonad<'T,MaybeDef>

Full name: Script.MaybeModule.MaybeDef.Return
override MaybeDef.Bind : m:IMonad<'T,MaybeDef> * f:('T -> IMonad<'S,MaybeDef>) -> IMonad<'S,MaybeDef>

Full name: Script.MaybeModule.MaybeDef.Bind
val m : IMonad<'T,MaybeDef>
val f : ('T -> IMonad<'S,MaybeDef>)
override MaybeDef.Zero : unit -> IMonad<'T,MaybeDef>

Full name: Script.MaybeModule.MaybeDef.Zero
member MaybeDef.Just : value:'T -> IMonad<'T,MaybeDef>

Full name: Script.MaybeModule.MaybeDef.Just
val value : 'T
member MaybeDef.Nothing : unit -> IMonad<'T,MaybeDef>

Full name: Script.MaybeModule.MaybeDef.Nothing
val maybeM : MaybeDef

Full name: Script.MaybeModule.maybeM
module MaybeModule

from Script
val test : IMonad<IMonad<int,MaybeDef>,ListDef>

Full name: Script.test
member ListDef.OfList : xs:'T list -> IMonad<'T,ListDef>
member MaybeDef.Just : value:'T -> IMonad<'T,MaybeDef>
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
val powerSet : xs:'a list -> IMonad<IMonad<'a,ListDef>,ListDef>

Full name: Script.powerSet
val xs : 'a list

More information

Link:http://fssnip.net/2Q
Posted:13 years ago
Author:Nick Palladinos
Tags: polymorphism , monads