TransAlt


Getting started

This is a simple library which allows you to compose your async computations into transactions. main combinators are:

  • fromAsync(async) will wrap any async workflow into an Alt object
  • pick(state,alt) will run your Alt object with specified state
  • withAck(ackAlt -> alt) allows you to create your Alt object with attached handlers for success/failed commit
  • merge(alt1,alt2) will return tuple with results of alts executed in parallel
  • choose(alt1,alt2) will return commit result only from first non error subcommit, other sub commit will be declined
  • bind(alt<'a>,'a -> Alt<'b>) allow to sequentially compose your alt computations

How it works

The main type is Alt, it defines some async computation which should commit result or error after execution

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
module Alt_ =
    type Alt_<'s,'r when 's : not struct> = 
            Alt of (ProcessId * Transaction<'s,'r> ->  Async<unit>) * IsMutatesState

    let fromAsync_ wrkfl =
            Alt((fun (_,tran:Transaction<'s,'r>) ->
                async{
                    try
                        let! res = wrkfl
                        let! _ = tran.commit (Ok(res))
                        return ()
                    with error -> let! _ = tran.commit (Error(error))
                                  return ()
                }),false
            )

But commit could be unsuccessful so you could add some handlers for successful/unsuccessful commit.

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
    let withAck_ (builder:Alt<'s, bool> -> Async<Alt<'s,'r>>) =  
            Alt((fun (procId,tran) ->
                async{
                    let nack = Promise.create<bool>()
                    let commit res = async{
                        let! commited = tran.commit res
                        nack.signal(commited) |> ignore
                        return commited}
                    let tran = {commit = commit; state = tran.state}
                    let! alt = builder(fromAsync(nack.future))
                    run procId tran alt 
                }), true)
    let altWithNack = withAck (fun (ack : Alt<unit, bool>) -> 
                                let ack = map(ack, fun x -> if x then printfn "do commit"
                                                            else printfn "do rollback"
                                                            ())
                                asyncReturn <| choose(Async.Sleep(100) |> fromAsync,ack)
                                )

State and communication

If your workflows have to communicate or share some state then you need to create some immutable object which will keep all shared data. Currently implemented only support for immutable channels, but it is easy to add your own. Lets define a channel and communicate two workflows. Your workflows should not use state mutation like in state monad but delegate change operations to a state keeper. So you have to define lenses which dramatically simplify state changes.

1: 
2: 
3: 
4: 
let St : Channel<int> = EmptyBounded(1) "channel"
let id_lens = { get = fun r -> r; 
                set = fun (r,v) -> v}
Alt.merge(id_lens.enq 1, id_lens.deq ()) |> pickWithResultState St |> Async.RunSynchronously |> printfn "%A"

Result is (Ok (null, 1), queue(channel []))

Why immutability? Because it is simple to share state between concurrent threads started by choose combinator and isolate changes from each other. And internally state keeper is able to resolve blocking problems and stop execution when workflows are deadlocked.

Builders

Library defines several builder which will help you to compose complex computations.

  • transB monadic builder
  • mergeB syntactic sugar for merge function
  • chooseB syntactic sugar for choose function
  • queryB inspired by joinads match

Samples

from joinads sample

 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: 
type St2 =
    { putStringC: Channel<string>; 
      putIntC: Channel<int>; 
      echoC: Channel<string>}

    static member putString =
        { get = fun r -> r.putStringC; 
          set = fun (r,v) -> { r with putStringC = v }}

    static member putInt =
        { get = fun r -> r.putIntC; 
          set = fun (r,v) -> { r with putIntC = v }}

    static member echo =
        { get = fun r -> r.echoC; 
          set = fun (r,v) -> { r with echoC = v }}

let state = {putStringC = EmptyUnbounded "putStringC"
             putIntC = EmptyUnbounded "putIntC"
             echoC = EmptyUnbounded "echoC"} 

let rec whileOk alt = tranB{
                         do! alt 
                         return! whileOk alt
                      } 

let getPutString = tranB{
    let! v = St2.putString.deq()
    do! St2.echo.enq(sprintf "Echo %s" v)
}

let getPutInt = tranB{
    let! v = St2.putInt.deq()
    do! St2.echo.enq(sprintf "Echo %d" v)
}

let getPut = choose(getPutString, getPutInt)

let getEcho = tranB{
    let! s = St2.echo.deq()
    Logger.logf "getEcho" "GOT: %A" s
}
let put5 =tranB { 
            for i in [1 .. 5] do
                Logger.logf "put5" "iter %d" i
                do! St2.putString.enq(sprintf "Hello %d!" i) 
                do! St2.putInt.enq(i)} 
mergeB{
    case put5
    case (whileOk getPut)
    case (whileOk getEcho)
} |> pickWithResultState state |> Async.RunSynchronously |> printfn "%A"

async cancellation from hopac samples

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
let asyncWitchCancellation wrkfl =
    withAck(fun nack -> async{
        let cts = new CancellationTokenSource()
        let wrkfl, res = Promise.wrapWrkfl(wrkfl)
        Async.Start(wrkfl, cts.Token)
        let nack = map(nack, fun commited ->  
                                    if not commited then printfn "async cancelled"
                                                         cts.Cancel())
        async{
            let! _ = pick () nack
            return () 
        } |> Async.Start
        return fromAsync res
    })
let wrkfl = async{
    do! Async.Sleep(1000)
    return "async finished"
}
(asyncWitchCancellation wrkfl, always "always finished") |> choose |> pick () |> Async.RunSynchronously |> printfn "%A"
(asyncWitchCancellation wrkfl, never()) |> choose |> pick () |> Async.RunSynchronously |> printfn "%A"

fetcher from hopac docs

 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: 
open Microsoft.FSharp.Control.WebExtensions
open System.Net
open System

let fetchAsync (name, url:string) = async { 
  let uri = new System.Uri(url)
  let webClient = new WebClient()
  let! html = webClient.AsyncDownloadString(uri)
  return sprintf "Read %d characters for %s" html.Length name
}

let fetchAlt (name, url) : Alt<'s,string> =
  fetchAsync (name, url) |> asyncWitchCancellation

let urlList = [ "Microsoft.com", "http://www.microsoft.com/" 
                "MSDN", "http://msdn.microsoft.com/" 
                "Bing", "http://www.bing.com" ]

let runFastest () =
  urlList
  |> Seq.map fetchAlt
  |> chooseXs
  |> pick ()
  |> Async.RunSynchronously

let runAll () =
  urlList
  |> Seq.map fetchAlt
  |> mergeXs
  |> pick ()
  |> Async.RunSynchronously

runFastest() |> printfn "%A"
runAll() |> printfn "%A"

one place buffer from joinads sample

 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: 
type St3 =
    { putC: Channel<string>; 
      getC: Channel<string>; 
      emptyC: Channel<unit>; 
      containsC: Channel<string>}

    static member put =
        { get = fun r -> r.putC; 
          set = fun (r,v) -> { r with putC = v }}

    static member get =
        { get = fun r -> r.getC; 
          set = fun (r,v) -> { r with getC = v }}

    static member empty =
        { get = fun r -> r.emptyC; 
          set = fun (r,v) -> { r with emptyC = v }}

    static member contains =
        { get = fun r -> r.containsC; 
          set = fun (r,v) -> { r with containsC = v }}

let stateSt3 = { putC = EmptyUnbounded "putC"
                 getC = EmptyUnbounded "getC"
                 emptyC = EmptyUnbounded "emptyC"
                 containsC = EmptyUnbounded "containsC"}
let add_empty = St3.empty.enq ()
let alts = chooseB{
    case (tranB{
        do! St3.empty.deq()
        let! x = St3.put.deq()
        do! St3.contains.enq(x) 
    })
    case (tranB{
        let! v = St3.contains.deq()
        do! St3.get.enq(v) 
        do! St3.empty.enq()
    })} 

let put = tranB { 
        do! fromAsync <| Async.Sleep 1000
        for i in 0 .. 10 do
          Logger.logf "put" "putting: %d" i
          do! St3.put.enq(string i) 
          do! fromAsync <| Async.Sleep 500 }

let got = tranB { 
            do! fromAsync <| Async.Sleep 250
            let! v = St3.get.deq()
            Logger.logf "got" "got: %s" v 
        }
mergeXs [whileOk got; put; whileOk alts; add_empty] |> pick stateSt3 |> Async.RunSynchronously |> printfn "%A"

Dinning philosophers from joinads sample

 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: 
let n = 5
let mapReplace k v map =
    let r = Map.remove k map
    Map.add k v r

type St4 =
    { chopsticksCs: Map<int,Channel<unit>>; 
      hungryC: Map<int,Channel<unit>>;}

    static member chopsticks i =
        { get = fun r -> Logger.logf "philosophers" "getting chopsticksCs %d " i
                         r.chopsticksCs.[i]; 
          set = fun (r,v) -> {r with chopsticksCs = mapReplace i v r.chopsticksCs}}
                             
    static member hungry i =
        { get = fun r -> Logger.logf "philosophers" "getting hungry %d " i
                         r.hungryC.[i]; 
          set = fun (r,v) -> {r with hungryC = mapReplace i v r.hungryC}}

let phioSt = {chopsticksCs = [ for i = 1 to n do yield i, EmptyUnbounded("chopsticksCs")] |> Map.ofList
              hungryC = [ for i = 1 to n do yield i, EmptyBounded 1 "hungryC" ] |> Map.ofList}

let philosophers = [| "Plato"; "Konfuzius"; "Socrates"; "Voltaire"; "Descartes" |]

let randomDelay (r : Random) = Async.Sleep(r.Next(1, 3) * 1000) |> fromAsync

let queries = Array.ofSeq (seq{
                            for i = 1 to n do
                                Logger.logf "philosophers" "left %d " i
                                let left = St4.chopsticks i
                                Logger.logf "philosophers" "left %d "(i % n + 1)
                                let right = St4.chopsticks (i % n + 1)
                                let random = new Random()
                                yield queryB{
                                    for _,_,_ in ((St4.hungry i).deq(), left.deq(), right.deq()) do
                                    select(i,random,left,right)
                                }
                          }) 
let findAndDo = tranB{
                    let! i,random,left,right = chooseXs(queries)
                    Logger.logf "philosophers" "%d wins " i
                    Logger.logf "philosophers" "%s is eating" philosophers.[i-1] 
                    do! randomDelay random
                    do! left.enq()  
                    do! right.enq()  
                    Logger.logf "philosophers" "%s is thinking" philosophers.[i-1] 
                    return ()
                }
    
let add_chopsticks = tranB{
    for i in 1..n do
        do! (St4.chopsticks i).enq()
    }
let random = new Random()  
let hungrySet = tranB{  
        let i = random.Next(1, n)
        Logger.logf "philosophers" "set hungry %s"  philosophers.[i]
        do! (St4.hungry i).enq()
        do! randomDelay random
}

mergeXs [whileOk findAndDo;whileOk hungrySet;add_chopsticks] |> pickWithResultState phioSt |> Async.RunSynchronously |> printfn "%A"

More examples in tests

namespace TransAlt
module Alt

from TransAlt
module Channel

from TransAlt
module Lens

from TransAlt
namespace System
namespace System.Threading
module State

from TransAlt
type Alt_<'s,'r (requires reference type)> = | Alt of (ProcessId * Transaction<'s,'r> -> Async<unit>) * IsMutatesState

Full name: Tutorial.Alt_.Alt_<_,_>
val not : value:bool -> bool

Full name: Microsoft.FSharp.Core.Operators.not
Multiple items
union case Alt_.Alt: (ProcessId * Transaction<'s,'r> -> Async<unit>) * IsMutatesState -> Alt_<'s,'r>

--------------------
module Alt

from TransAlt

--------------------
type Alt<'s,'r (requires reference type)> = | Alt of (ProcessId * Transaction<'s,'r> -> Async<unit>) * IsMutatesState

Full name: TransAlt.Alt.Alt<_,_>
type ProcessId = int

Full name: TransAlt.State.ProcessId
type Transaction<'s,'r (requires reference type)> =
  {state: StateKeeper<'s>;
   commit: TransactionResult<'r> -> Async<bool>;}

Full name: TransAlt.Alt.Transaction<_,_>
Multiple items
type Async
static member AsBeginEnd : computation:('Arg -> Async<'T>) -> ('Arg * AsyncCallback * obj -> IAsyncResult) * (IAsyncResult -> 'T) * (IAsyncResult -> unit)
static member AwaitEvent : event:IEvent<'Del,'T> * ?cancelAction:(unit -> unit) -> Async<'T> (requires delegate and 'Del :> Delegate)
static member AwaitIAsyncResult : iar:IAsyncResult * ?millisecondsTimeout:int -> Async<bool>
static member AwaitTask : task:Task<'T> -> Async<'T>
static member AwaitWaitHandle : waitHandle:WaitHandle * ?millisecondsTimeout:int -> Async<bool>
static member CancelDefaultToken : unit -> unit
static member Catch : computation:Async<'T> -> Async<Choice<'T,exn>>
static member FromBeginEnd : beginAction:(AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg:'Arg1 * beginAction:('Arg1 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * beginAction:('Arg1 * 'Arg2 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * arg3:'Arg3 * beginAction:('Arg1 * 'Arg2 * 'Arg3 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromContinuations : callback:(('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) -> Async<'T>
static member Ignore : computation:Async<'T> -> Async<unit>
static member OnCancel : interruption:(unit -> unit) -> Async<IDisposable>
static member Parallel : computations:seq<Async<'T>> -> Async<'T []>
static member RunSynchronously : computation:Async<'T> * ?timeout:int * ?cancellationToken:CancellationToken -> 'T
static member Sleep : millisecondsDueTime:int -> Async<unit>
static member Start : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
static member StartAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions * ?cancellationToken:CancellationToken -> Task<'T>
static member StartChild : computation:Async<'T> * ?millisecondsTimeout:int -> Async<Async<'T>>
static member StartChildAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions -> Async<Task<'T>>
static member StartImmediate : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
static member StartWithContinuations : computation:Async<'T> * continuation:('T -> unit) * exceptionContinuation:(exn -> unit) * cancellationContinuation:(OperationCanceledException -> unit) * ?cancellationToken:CancellationToken -> unit
static member SwitchToContext : syncContext:SynchronizationContext -> Async<unit>
static member SwitchToNewThread : unit -> Async<unit>
static member SwitchToThreadPool : unit -> Async<unit>
static member TryCancelled : computation:Async<'T> * compensation:(OperationCanceledException -> unit) -> Async<'T>
static member CancellationToken : Async<CancellationToken>
static member DefaultCancellationToken : CancellationToken

Full name: Microsoft.FSharp.Control.Async

--------------------
type Async<'T>

Full name: Microsoft.FSharp.Control.Async<_>
Multiple items
val unit : unit -> Alt<'a,unit> (requires reference type)

Full name: TransAlt.Alt.unit

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

Full name: Microsoft.FSharp.Core.unit
type IsMutatesState = bool

Full name: TransAlt.State.IsMutatesState
val fromAsync_ : wrkfl:Async<'r> -> Alt_<'s,'r> (requires reference type)

Full name: Tutorial.Alt_.fromAsync_
val wrkfl : Async<'r>
val tran : Transaction<'s,'r> (requires reference type)
val async : AsyncBuilder

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.async
val res : 'r
Transaction.commit: TransactionResult<'r> -> Async<bool>
union case TransactionResult.Ok: 'r -> TransactionResult<'r>
val error : exn
union case TransactionResult.Error: System.Exception -> TransactionResult<'r>
val withAck_ : builder:(Alt<'s,bool> -> Async<Alt<'s,'r>>) -> Alt_<'s,'r> (requires reference type)

Full name: Tutorial.Alt_.withAck_
val builder : (Alt<'s,bool> -> Async<Alt<'s,'r>>) (requires reference type)
type bool = System.Boolean

Full name: Microsoft.FSharp.Core.bool
val procId : ProcessId
val nack : Promise.Promise<bool>
module Promise

from TransAlt
val create : unit -> Promise.Promise<'a>

Full name: TransAlt.Promise.create
val commit : (TransactionResult<'r> -> Async<bool>)
val res : TransactionResult<'r>
val commited : bool
abstract member Promise.Promise.signal : 'a -> bool
val ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore
Transaction.state: StateKeeper<'s>
val alt : Alt<'s,'r> (requires reference type)
val fromAsync : wrkfl:Async<'r> -> Alt<'s,'r> (requires reference type)

Full name: TransAlt.Alt.fromAsync
property Promise.Promise.future: Async<bool>
val run : procId:ProcessId -> tran:Transaction<'a,'b> -> _arg1:Alt<'a,'b> -> unit (requires reference type)

Full name: TransAlt.Alt.run
val altWithNack : Alt<unit,unit>

Full name: Tutorial.Alt_.altWithNack
val withAck : builder:(Alt<'s,bool> -> Async<Alt<'s,'r>>) -> Alt<'s,'r> (requires reference type)

Full name: TransAlt.Alt.withAck
val ack : Alt<unit,bool>
val ack : Alt<unit,unit>
val map : alt:Alt<'a,'b> * f:('b -> 'c) -> Alt<'a,'c> (requires reference type)

Full name: TransAlt.Alt.map
val x : bool
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
val asyncReturn : x:'a -> Async<'a>

Full name: TransAlt.Alt.asyncReturn
val choose : one:Alt<'s,'r> * two:Alt<'s,'r> -> Alt<'s,'r> (requires reference type)

Full name: TransAlt.Alt.choose
static member Async.Sleep : millisecondsDueTime:int -> Async<unit>
val St : Channel<int>

Full name: Tutorial.St
Multiple items
module Channel

from TransAlt

--------------------
type Channel<'a> =
  {name: string;
   maxCount: int option;
   xs: 'a list;
   rxs: 'a list;}
  member Get : unit -> OpResp<Channel<'a> * 'a>
  member Put : x:'a -> OpResp<Channel<'a>>
  member AsString : string
  member Count : int
  member IsEmpty : bool

Full name: TransAlt.Channel.Channel<_>
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<_>
val EmptyBounded : limit:int -> name:string -> Channel<'a>

Full name: TransAlt.Channel.EmptyBounded
val id_lens : Lens<'a,'a>

Full name: Tutorial.id_lens
val r : 'a
val set : elements:seq<'T> -> Set<'T> (requires comparison)

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.set
val v : 'a
Multiple items
union case Alt.Alt: (ProcessId * Transaction<'s,'r> -> Async<unit>) * IsMutatesState -> Alt<'s,'r>

--------------------
module Alt

from TransAlt

--------------------
type Alt<'s,'r (requires reference type)> = | Alt of (ProcessId * Transaction<'s,'r> -> Async<unit>) * IsMutatesState

Full name: TransAlt.Alt.Alt<_,_>
val merge : one:Alt<'s,'a> * two:Alt<'s,'b> -> Alt<'s,('a * 'b)> (requires reference type)

Full name: TransAlt.Alt.merge
val pickWithResultState : state:'a -> alt:Alt<'a,'b> -> Async<TransactionResult<'b> * 'a> (requires reference type)

Full name: TransAlt.Alt.pickWithResultState
static member Async.RunSynchronously : computation:Async<'T> * ?timeout:int * ?cancellationToken:CancellationToken -> 'T
type St2 =
  {putStringC: Channel<string>;
   putIntC: Channel<int>;
   echoC: Channel<string>;}
  static member echo : Lens<St2,Channel<string>>
  static member putInt : Lens<St2,Channel<int>>
  static member putString : Lens<St2,Channel<string>>

Full name: Tutorial.St2
St2.putStringC: Channel<string>
Multiple items
val string : value:'T -> string

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

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

Full name: Microsoft.FSharp.Core.string
St2.putIntC: Channel<int>
St2.echoC: Channel<string>
static member St2.putString : Lens<St2,Channel<string>>

Full name: Tutorial.St2.putString
val r : St2
val v : Channel<string>
static member St2.putInt : Lens<St2,Channel<int>>

Full name: Tutorial.St2.putInt
val v : Channel<int>
static member St2.echo : Lens<St2,Channel<string>>

Full name: Tutorial.St2.echo
val state : St2

Full name: Tutorial.state
val EmptyUnbounded : name:string -> Channel<'a>

Full name: TransAlt.Channel.EmptyUnbounded
val whileOk : alt:Alt<'a,unit> -> Alt<'a,'b> (requires reference type)

Full name: Tutorial.whileOk
val alt : Alt<'a,unit> (requires reference type)
val tranB : TransactionBuilder

Full name: TransAlt.Alt.tranB
val getPutString : Alt<St2,unit>

Full name: Tutorial.getPutString
val v : string
property St2.putString: Lens<St2,Channel<string>>
static member ChEx.deq : qlens:Lens<'s,Channel<'v>> -> Alt<'s,'v> (requires reference type)
property St2.echo: Lens<St2,Channel<string>>
static member ChEx.enq : qlens:Lens<'s,Channel<'v>> * x:'v -> Alt<'s,unit> (requires reference type)
val sprintf : format:Printf.StringFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.sprintf
val getPutInt : Alt<St2,unit>

Full name: Tutorial.getPutInt
val v : int
property St2.putInt: Lens<St2,Channel<int>>
val getPut : Alt<St2,unit>

Full name: Tutorial.getPut
val getEcho : Alt<St2,unit>

Full name: Tutorial.getEcho
val s : string
module Logger

from TransAlt
val logf : who:string -> fmt:Printf.StringFormat<('a -> string)> -> msg:'a -> unit

Full name: TransAlt.Logger.logf
val put5 : Alt<St2,unit>

Full name: Tutorial.put5
val i : int
val mergeB : MergeBuilder

Full name: TransAlt.Alt.mergeB
custom operation: case (Alt<'a,'b>)

Calls MergeBuilder.Case
val asyncWitchCancellation : wrkfl:Async<'a> -> Alt<unit,'a>

Full name: Tutorial.asyncWitchCancellation
val wrkfl : Async<'a>
val nack : Alt<unit,bool>
val cts : CancellationTokenSource
Multiple items
type CancellationTokenSource =
  new : unit -> CancellationTokenSource
  member Cancel : unit -> unit + 1 overload
  member Dispose : unit -> unit
  member IsCancellationRequested : bool
  member Token : CancellationToken
  static member CreateLinkedTokenSource : params tokens:CancellationToken[] -> CancellationTokenSource + 1 overload

Full name: System.Threading.CancellationTokenSource

--------------------
CancellationTokenSource() : unit
val wrkfl : Async<unit>
val res : Async<'a>
val wrapWrkfl : wrkfl:Async<'a> -> Async<unit> * Async<'a>

Full name: TransAlt.Promise.wrapWrkfl
static member Async.Start : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
property CancellationTokenSource.Token: CancellationToken
val nack : Alt<unit,unit>
CancellationTokenSource.Cancel() : unit
CancellationTokenSource.Cancel(throwOnFirstException: bool) : unit
val pick : state:'a -> alt:Alt<'a,'b> -> Async<TransactionResult<'b>> (requires reference type)

Full name: TransAlt.Alt.pick
val wrkfl : Async<string>

Full name: Tutorial.wrkfl
val always : v:'a -> Alt<'b,'a> (requires reference type)

Full name: TransAlt.Alt.always
val never : unit -> Alt<'a,'b> (requires reference type)

Full name: TransAlt.Alt.never
namespace Microsoft
namespace Microsoft.FSharp
namespace Microsoft.FSharp.Control
module WebExtensions

from Microsoft.FSharp.Control
namespace System.Net
val fetchAsync : name:string * url:string -> Async<string>

Full name: Tutorial.fetchAsync
val name : string
val url : string
Multiple items
val string : value:'T -> string

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

--------------------
type string = String

Full name: Microsoft.FSharp.Core.string
val uri : Uri
Multiple items
type Uri =
  new : uriString:string -> Uri + 5 overloads
  member AbsolutePath : string
  member AbsoluteUri : string
  member Authority : string
  member DnsSafeHost : string
  member Equals : comparand:obj -> bool
  member Fragment : string
  member GetComponents : components:UriComponents * format:UriFormat -> string
  member GetHashCode : unit -> int
  member GetLeftPart : part:UriPartial -> string
  ...

Full name: System.Uri

--------------------
Uri(uriString: string) : unit
Uri(uriString: string, uriKind: UriKind) : unit
Uri(baseUri: Uri, relativeUri: string) : unit
Uri(baseUri: Uri, relativeUri: Uri) : unit
val webClient : WebClient
Multiple items
type WebClient =
  inherit Component
  new : unit -> WebClient
  member BaseAddress : string with get, set
  member CachePolicy : RequestCachePolicy with get, set
  member CancelAsync : unit -> unit
  member Credentials : ICredentials with get, set
  member DownloadData : address:string -> byte[] + 1 overload
  member DownloadDataAsync : address:Uri -> unit + 1 overload
  member DownloadFile : address:string * fileName:string -> unit + 1 overload
  member DownloadFileAsync : address:Uri * fileName:string -> unit + 1 overload
  member DownloadString : address:string -> string + 1 overload
  ...

Full name: System.Net.WebClient

--------------------
WebClient() : unit
val html : string
member WebClient.AsyncDownloadString : address:Uri -> Async<string>
property String.Length: int
val fetchAlt : name:string * url:string -> Alt<unit,string>

Full name: Tutorial.fetchAlt
val urlList : (string * string) list

Full name: Tutorial.urlList
val runFastest : unit -> TransactionResult<string>

Full name: Tutorial.runFastest
module Seq

from Microsoft.FSharp.Collections
val map : mapping:('T -> 'U) -> source:seq<'T> -> seq<'U>

Full name: Microsoft.FSharp.Collections.Seq.map
val chooseXs : xs:seq<Alt<'a,'b>> -> Alt<'a,'b> (requires reference type)

Full name: TransAlt.Alt.chooseXs
val runAll : unit -> TransactionResult<seq<string>>

Full name: Tutorial.runAll
val mergeXs : xs:seq<Alt<'s,'r>> -> Alt<'s,seq<'r>> (requires reference type)

Full name: TransAlt.Alt.mergeXs
type St3 =
  {putC: Channel<string>;
   getC: Channel<string>;
   emptyC: Channel<unit>;
   containsC: Channel<string>;}
  static member contains : Lens<St3,Channel<string>>
  static member empty : Lens<St3,Channel<unit>>
  static member get : Lens<St3,Channel<string>>
  static member put : Lens<St3,Channel<string>>

Full name: Tutorial.St3
St3.putC: Channel<string>
St3.getC: Channel<string>
St3.emptyC: Channel<unit>
St3.containsC: Channel<string>
static member St3.put : Lens<St3,Channel<string>>

Full name: Tutorial.St3.put
val r : St3
static member St3.get : Lens<St3,Channel<string>>

Full name: Tutorial.St3.get
static member St3.empty : Lens<St3,Channel<unit>>

Full name: Tutorial.St3.empty
val v : Channel<unit>
static member St3.contains : Lens<St3,Channel<string>>

Full name: Tutorial.St3.contains
val stateSt3 : St3

Full name: Tutorial.stateSt3
val add_empty : Alt<St3,unit>

Full name: Tutorial.add_empty
property St3.empty: Lens<St3,Channel<unit>>
val alts : Alt<St3,unit>

Full name: Tutorial.alts
val chooseB : ChooseBuilder

Full name: TransAlt.Alt.chooseB
custom operation: case (Alt<'a,'b>)

Calls ChooseBuilder.Case
val x : string
property St3.put: Lens<St3,Channel<string>>
property St3.contains: Lens<St3,Channel<string>>
property St3.get: Lens<St3,Channel<string>>
val put : Alt<St3,unit>

Full name: Tutorial.put
val got : Alt<St3,unit>

Full name: Tutorial.got
val n : int

Full name: Tutorial.n
val mapReplace : k:'a -> v:'b -> map:Map<'a,'b> -> Map<'a,'b> (requires comparison)

Full name: Tutorial.mapReplace
val k : 'a (requires comparison)
val v : 'b
val map : Map<'a,'b> (requires comparison)
val r : Map<'a,'b> (requires comparison)
Multiple items
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 remove : key:'Key -> table:Map<'Key,'T> -> Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.remove
val add : key:'Key -> value:'T -> table:Map<'Key,'T> -> Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.add
type St4 =
  {chopsticksCs: Map<int,Channel<unit>>;
   hungryC: Map<int,Channel<unit>>;}
  static member chopsticks : i:int -> Lens<St4,Channel<unit>>
  static member hungry : i:int -> Lens<St4,Channel<unit>>

Full name: Tutorial.St4
St4.chopsticksCs: Map<int,Channel<unit>>
St4.hungryC: Map<int,Channel<unit>>
static member St4.chopsticks : i:int -> Lens<St4,Channel<unit>>

Full name: Tutorial.St4.chopsticks
val r : St4
static member St4.hungry : i:int -> Lens<St4,Channel<unit>>

Full name: Tutorial.St4.hungry
val phioSt : St4

Full name: Tutorial.phioSt
val ofList : elements:('Key * 'T) list -> Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.ofList
val philosophers : string []

Full name: Tutorial.philosophers
val randomDelay : r:Random -> Alt<'a,unit> (requires reference type)

Full name: Tutorial.randomDelay
val r : Random
Multiple items
type Random =
  new : unit -> Random + 1 overload
  member Next : unit -> int + 2 overloads
  member NextBytes : buffer:byte[] -> unit
  member NextDouble : unit -> float

Full name: System.Random

--------------------
Random() : unit
Random(Seed: int) : unit
Random.Next() : int
Random.Next(maxValue: int) : int
Random.Next(minValue: int, maxValue: int) : int
val queries : Alt<St4,(int * Random * Lens<St4,Channel<unit>> * Lens<St4,Channel<unit>>)> []

Full name: Tutorial.queries
type Array =
  member Clone : unit -> obj
  member CopyTo : array:Array * index:int -> unit + 1 overload
  member GetEnumerator : unit -> IEnumerator
  member GetLength : dimension:int -> int
  member GetLongLength : dimension:int -> int64
  member GetLowerBound : dimension:int -> int
  member GetUpperBound : dimension:int -> int
  member GetValue : params indices:int[] -> obj + 7 overloads
  member Initialize : unit -> unit
  member IsFixedSize : bool
  ...

Full name: System.Array
val ofSeq : source:seq<'T> -> 'T []

Full name: Microsoft.FSharp.Collections.Array.ofSeq
Multiple items
val seq : sequence:seq<'T> -> seq<'T>

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

--------------------
type seq<'T> = Collections.Generic.IEnumerable<'T>

Full name: Microsoft.FSharp.Collections.seq<_>
val left : Lens<St4,Channel<unit>>
static member St4.chopsticks : i:int -> Lens<St4,Channel<unit>>
val right : Lens<St4,Channel<unit>>
val random : Random
val queryB : AltQueryBuilder

Full name: TransAlt.Alt.queryB
static member St4.hungry : i:int -> Lens<St4,Channel<unit>>
custom operation: select ('r2)

Calls AltQueryBuilder.Select
val findAndDo : Alt<St4,unit>

Full name: Tutorial.findAndDo
val add_chopsticks : Alt<St4,unit>

Full name: Tutorial.add_chopsticks
val random : Random

Full name: Tutorial.random
val hungrySet : Alt<St4,unit>

Full name: Tutorial.hungrySet
Fork me on GitHub