4 people like it.

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: 

type Eff<'Ctx, 'T> = 'Ctx -> 'T

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

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

let eff = new EffBuilder()

let getCtx<'Ctx> () : Eff<'Ctx, 'Ctx> = id

let run ctx (eff : Eff<'Ctx, 'T>) = eff ctx

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: 

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
    }

Combining effects

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 

// 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())
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

Full name: Script.Eff<_,_>
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 c : 'Ctx
member EffBuilder.Zero : unit -> Eff<'Ctx,unit>

Full name: Script.EffBuilder.Zero
type unit = Unit

Full name: Microsoft.FSharp.Core.unit
val ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore
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 -> Eff<'Ctx,'Ctx>

Full name: Script.getCtx
val id : x:'T -> 'T

Full name: Microsoft.FSharp.Core.Operators.id
val run : ctx:'Ctx -> eff:Eff<'Ctx,'T> -> 'T

Full name: Script.run
val ctx : 'Ctx
val eff : Eff<'Ctx,'T>
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
val t : 'T
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
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<_>
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

More information

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

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.