Type-Safe effect builder

A simple continuation monad that encodes extensible and type-safe effects.

Basic Types & Builder

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18:

type Eff<'Ctx, 'T> = ('Ctx -> 'T -> unit) -> 'Ctx -> unit

type EffBuilder() =
    member __.Return x : Eff<'Ctx,'T> = fun k c -> k c x
    member __.Bind(f : Eff<'Ctx, 'T>, g : 'T -> Eff<'Ctx, 'S>) : Eff<'Ctx, 'S> =
        fun k c -> f (fun c t -> g t k c) c

    member __.Zero() : Eff<'Ctx, unit> = __.Return()
    member __.ReturnFrom (x : Eff<'Ctx, 'T>) = x

let eff = new EffBuilder()

let getCtx<'Ctx> () : Eff<'Ctx, 'Ctx> = fun k c -> k c c

let run handler (eff : Eff<'Ctx, 'T>) =
    let cell = ref Unchecked.defaultof<'T>
    eff (fun _ t -> cell := t) handler
    !cell

Defining and combining abstract effects

 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:

module Logger =

    type ILogger = 
        abstract Log : string -> unit

    let log (msg : string) = eff {
        let! logger = getCtx<#ILogger> ()
        logger.Log msg
    }

    let logf fmt = Printf.ksprintf log fmt

module State =

    type IState<'T> =
        abstract Get : unit -> 'T
        abstract Set : 'T -> unit

    let get () = eff {
        let! state = getCtx<#IState<'T>>()
        return state.Get()
    }

    let set (t : 'T) = eff {
        let! state = getCtx<#IState<'T>>()
        state.Set t
    }


module DateTime =

    type IDateTime =
        abstract Now : System.DateTime

    let now() = eff {
        let! dt = getCtx<#IDateTime>()
        return dt.Now
    }

// type signature of this computation reveals effect dependencies of the workflow
let combinedEffects() = eff {
    let! date = DateTime.now()
    do! Logger.logf "Current time is: %O" date
    do! Logger.log "Reading the variable"
    let! x = State.get()
    do! Logger.log "Incrementing the variable"
    do! State.set (x + 1)
    do! Logger.log "Reading the variable again"
    return! State.get()
}

Defining "effect handlers"

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23:

type ConsoleLogger() =
    interface Logger.ILogger with
        member __.Log msg = printfn "%s" msg

type RefCellState<'T>(init : 'T) =
    let cell = ref init
    interface State.IState<'T> with
        member __.Get () = !cell
        member __.Set t = cell := t

type MyHandler(init) =
    let logger = new ConsoleLogger() :> Logger.ILogger
    let cell = new RefCellState<int>(init) :> State.IState<int>

    interface Logger.ILogger with
        member __.Log m = logger.Log m

    interface State.IState<int> with
        member __.Get() = cell.Get()
        member __.Set t = cell.Set t

    interface DateTime.IDateTime with
        member __.Now = System.DateTime.Now.AddYears(10)

Executing the computations

1: 
2: 
3: 
4: 
5: 
6: 
7: 
8:

run (ConsoleLogger()) (Logger.log "log test")
run (RefCellState("lorem ipsum")) (State.get ())
run (MyHandler(init = 41)) (combinedEffects())

// uncomment for type errors
//run (ConsoleLogger()) (State.get())
//run (RefCellState(0)) (Logger.log "lorem ipsum")
//run (ConsoleLogger()) (combinedEffects())

type unit = Unit

Full name: Microsoft.FSharp.Core.unit

Multiple items
type EffBuilder =
  new : unit -> EffBuilder
  member Bind : f:Eff<'Ctx,'T> * g:('T -> Eff<'Ctx,'S>) -> Eff<'Ctx,'S>
  member Return : x:'T -> Eff<'Ctx,'T>
  member ReturnFrom : x:Eff<'Ctx,'T> -> Eff<'Ctx,'T>
  member Zero : unit -> Eff<'Ctx,unit>

Full name: Script.EffBuilder

--------------------
new : unit -> EffBuilder

member EffBuilder.Return : x:'T -> Eff<'Ctx,'T>

Full name: Script.EffBuilder.Return

val x : 'T

type Eff<'Ctx,'T> = ('Ctx -> 'T -> unit) -> 'Ctx -> unit

Full name: Script.Eff<_,_>

val k : ('Ctx -> 'T -> unit)

val c : 'Ctx

val __ : EffBuilder

member EffBuilder.Bind : f:Eff<'Ctx,'T> * g:('T -> Eff<'Ctx,'S>) -> Eff<'Ctx,'S>

Full name: Script.EffBuilder.Bind

val f : Eff<'Ctx,'T>

val g : ('T -> Eff<'Ctx,'S>)

val k : ('Ctx -> 'S -> unit)

val t : 'T

member EffBuilder.Zero : unit -> Eff<'Ctx,unit>

Full name: Script.EffBuilder.Zero

member EffBuilder.Return : x:'T -> Eff<'Ctx,'T>

member EffBuilder.ReturnFrom : x:Eff<'Ctx,'T> -> Eff<'Ctx,'T>

Full name: Script.EffBuilder.ReturnFrom

val x : Eff<'Ctx,'T>

val eff : EffBuilder

Full name: Script.eff

val getCtx : unit -> k:('Ctx -> 'Ctx -> unit) -> c:'Ctx -> unit

Full name: Script.getCtx

val k : ('Ctx -> 'Ctx -> unit)

val run : handler:'Ctx -> eff:Eff<'Ctx,'T> -> 'T

Full name: Script.run

val handler : 'Ctx

val eff : Eff<'Ctx,'T>

val cell : 'T ref

Multiple items
val ref : value:'T -> 'T ref

Full name: Microsoft.FSharp.Core.Operators.ref

--------------------
type 'T ref = Ref<'T>

Full name: Microsoft.FSharp.Core.ref<_>

module Unchecked

from Microsoft.FSharp.Core.Operators

val defaultof<'T> : 'T

Full name: Microsoft.FSharp.Core.Operators.Unchecked.defaultof

type ILogger =
  interface
    abstract member Log : string -> unit
  end

Full name: Script.Logger.ILogger

abstract member ILogger.Log : string -> unit

Full name: Script.Logger.ILogger.Log

Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string

val log : msg:string -> Eff<#ILogger,unit>

Full name: Script.Logger.log

val msg : string

val logger : #ILogger

abstract member ILogger.Log : string -> unit

val logf : fmt:Printf.StringFormat<'a,Eff<#ILogger,unit>> -> 'a

Full name: Script.Logger.logf

val fmt : Printf.StringFormat<'a,Eff<#ILogger,unit>>

module Printf

from Microsoft.FSharp.Core

val ksprintf : continutation:(string -> 'Result) -> format:Printf.StringFormat<'T,'Result> -> 'T

Full name: Microsoft.FSharp.Core.Printf.ksprintf

type IState<'T> =
  interface
    abstract member Get : unit -> 'T
    abstract member Set : 'T -> unit
  end

Full name: Script.State.IState<_>

abstract member IState.Get : unit -> 'T

Full name: Script.State.IState`1.Get

Multiple items
abstract member IState.Set : 'T -> unit

Full name: Script.State.IState`1.Set

--------------------
module Set

from Microsoft.FSharp.Collections

--------------------
type Set<'T (requires comparison)> =
  interface IComparable
  interface IEnumerable
  interface IEnumerable<'T>
  interface ICollection<'T>
  new : elements:seq<'T> -> Set<'T>
  member Add : value:'T -> Set<'T>
  member Contains : value:'T -> bool
  override Equals : obj -> bool
  member IsProperSubsetOf : otherSet:Set<'T> -> bool
  member IsProperSupersetOf : otherSet:Set<'T> -> bool
  ...

Full name: Microsoft.FSharp.Collections.Set<_>

--------------------
new : elements:seq<'T> -> Set<'T>

val get : unit -> Eff<#IState<'T>,'T>

Full name: Script.State.get

val state : #IState<'T>

abstract member IState.Get : unit -> 'T

val set : t:'T -> Eff<#IState<'T>,unit>

Full name: Script.State.set

abstract member IState.Set : 'T -> unit

type IDateTime =
  interface
    abstract member Now : DateTime
  end

Full name: Script.DateTime.IDateTime

abstract member IDateTime.Now : System.DateTime

Full name: Script.DateTime.IDateTime.Now

namespace System

Multiple items
type DateTime =
  struct
    new : ticks:int64 -> DateTime + 10 overloads
    member Add : value:TimeSpan -> DateTime
    member AddDays : value:float -> DateTime
    member AddHours : value:float -> DateTime
    member AddMilliseconds : value:float -> DateTime
    member AddMinutes : value:float -> DateTime
    member AddMonths : months:int -> DateTime
    member AddSeconds : value:float -> DateTime
    member AddTicks : value:int64 -> DateTime
    member AddYears : value:int -> DateTime
    ...
  end

Full name: System.DateTime

--------------------
System.DateTime()
   (+0 other overloads)
System.DateTime(ticks: int64) : unit
   (+0 other overloads)
System.DateTime(ticks: int64, kind: System.DateTimeKind) : unit
   (+0 other overloads)
System.DateTime(year: int, month: int, day: int) : unit
   (+0 other overloads)
System.DateTime(year: int, month: int, day: int, calendar: System.Globalization.Calendar) : unit
   (+0 other overloads)
System.DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int) : unit
   (+0 other overloads)
System.DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, kind: System.DateTimeKind) : unit
   (+0 other overloads)
System.DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, calendar: System.Globalization.Calendar) : unit
   (+0 other overloads)
System.DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, millisecond: int) : unit
   (+0 other overloads)
System.DateTime(year: int, month: int, day: int, hour: int, minute: int, second: int, millisecond: int, kind: System.DateTimeKind) : unit
   (+0 other overloads)

val now : unit -> Eff<#IDateTime,System.DateTime>

Full name: Script.DateTime.now

val dt : #IDateTime

property IDateTime.Now: System.DateTime

val combinedEffects : unit -> Eff<'a,int> (requires 'a :> State.IState<int> and 'a :> Logger.ILogger and 'a :> DateTime.IDateTime)

Full name: Script.combinedEffects

val date : System.DateTime

module DateTime

from Script

val now : unit -> Eff<#DateTime.IDateTime,System.DateTime>

Full name: Script.DateTime.now

module Logger

from Script

val logf : fmt:Printf.StringFormat<'a,Eff<#Logger.ILogger,unit>> -> 'a

Full name: Script.Logger.logf

val log : msg:string -> Eff<#Logger.ILogger,unit>

Full name: Script.Logger.log

val x : int

module State

from Script

val get : unit -> Eff<#State.IState<'T>,'T>

Full name: Script.State.get

val set : t:'T -> Eff<#State.IState<'T>,unit>

Full name: Script.State.set

Multiple items
type ConsoleLogger =
interface ILogger
new : unit -> ConsoleLogger

Full name: Script.ConsoleLogger

--------------------
new : unit -> ConsoleLogger

override ConsoleLogger.Log : msg:string -> unit

Full name: Script.ConsoleLogger.Log

val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn

Multiple items
type RefCellState<'T> =
interface IState<'T>
new : init:'T -> RefCellState<'T>

Full name: Script.RefCellState<_>

--------------------
new : init:'T -> RefCellState<'T>

val init : 'T

override RefCellState.Get : unit -> 'T

Full name: Script.RefCellState`1.Get

val __ : RefCellState<'T>

Multiple items
override RefCellState.Set : t:'T -> unit

Full name: Script.RefCellState`1.Set

--------------------
module Set

from Microsoft.FSharp.Collections

--------------------
type Set<'T (requires comparison)> =
  interface IComparable
  interface IEnumerable
  interface IEnumerable<'T>
  interface ICollection<'T>
  new : elements:seq<'T> -> Set<'T>
  member Add : value:'T -> Set<'T>
  member Contains : value:'T -> bool
  override Equals : obj -> bool
  member IsProperSubsetOf : otherSet:Set<'T> -> bool
  member IsProperSupersetOf : otherSet:Set<'T> -> bool
  ...

Full name: Microsoft.FSharp.Collections.Set<_>

--------------------
new : elements:seq<'T> -> Set<'T>

Multiple items
type MyHandler =
  interface IDateTime
  interface IState<int>
  interface ILogger
  new : init:int -> MyHandler

Full name: Script.MyHandler

--------------------
new : init:int -> MyHandler

val init : int

val logger : Logger.ILogger

val cell : State.IState<int>

Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>

override MyHandler.Log : m:string -> unit

Full name: Script.MyHandler.Log

val m : string

abstract member Logger.ILogger.Log : string -> unit

val __ : MyHandler

override MyHandler.Get : unit -> int

Full name: Script.MyHandler.Get

abstract member State.IState.Get : unit -> 'T

Multiple items
override MyHandler.Set : t:int -> unit

Full name: Script.MyHandler.Set

--------------------
module Set

from Microsoft.FSharp.Collections

--------------------
type Set<'T (requires comparison)> =
  interface IComparable
  interface IEnumerable
  interface IEnumerable<'T>
  interface ICollection<'T>
  new : elements:seq<'T> -> Set<'T>
  member Add : value:'T -> Set<'T>
  member Contains : value:'T -> bool
  override Equals : obj -> bool
  member IsProperSubsetOf : otherSet:Set<'T> -> bool
  member IsProperSupersetOf : otherSet:Set<'T> -> bool
  ...

Full name: Microsoft.FSharp.Collections.Set<_>

--------------------
new : elements:seq<'T> -> Set<'T>

val t : int

abstract member State.IState.Set : 'T -> unit

override MyHandler.Now : System.DateTime

Full name: Script.MyHandler.Now

property System.DateTime.Now: System.DateTime

System.DateTime.AddYears(value: int) : System.DateTime

Next Version Raw view Test code New version

More information

Link:	http://fssnip.net/7TM
Posted:	6 years ago
Author:	Eirik Tsarpalis
Tags:	effects