6 people like it.
Like the snippet!

Event handling URL requests

Suave.EvReact is a small library for transforming HTPP request to Suave into events that are orchestrated using EvReact expressions.

 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:

open Suave.EvReact

open Suave
open Suave.Http
open Suave.Successful
open Suave.Web
open Suave.EvReact
open EvReact
open EvReact.Expr

// Create the EvReact events associated with URLs
let start = HttpEvent()
let work = HttpEvent()
let stop = HttpEvent()
let status = HttpEvent()

let jobs = ResizeArray<string>()

// chooseEvents is the only combiner currently featured by Suave.EvReact
// The list is (regex, event, default)
// Whenever the regex is matched by Suave the event is fired. 
// The default web part can be overridden by assigining the Result property
// in the event

// In this example we have jobs that are started by accessing /start/id
// You perform some work only if the job is running with /work/id/arg
// You stop the job using /stop/id
let app = chooseEvents 
            [
                ("/start/(\\d+)", start, NO_CONTENT)
                ("/work/(\\d+)/(\\d+)", work, NO_CONTENT)
                ("/stop/(\\d+)", stop, NO_CONTENT)
                ("/status", status, NO_CONTENT)
            ]

// This EvReact net simply react to the status event by printing the list of jobs
let statusReq = !!status.Publish |-> (fun arg -> arg.Result <- OK (System.String.Join("<br/>", jobs)))

// Useful net generator expressing a loop until
let loopUntil terminator body = +( body / terminator ) - never

// The orchestrator used to run the nets
let orch = EvReact.Orchestrator.create()

// When start is received the function gets triggered
let startNet = !!start.Publish |-> (fun arg ->
  // Read the id from the argument
  let id = arg.Match.Groups.[1].Value
  jobs.Add(id)

  // Set the response
  arg.Result <- OK (sprintf "Started job %s" id)
  
  // The net performing the actual work is triggered only if the id is the one started
  let doWork = (work.Publish %- (fun arg -> arg.Match.Groups.[1].Value = id)) |-> (fun arg ->
    let value = int(arg.Match.Groups.[2].Value)
    arg.Result <- OK ((value + 1).ToString())
  )
  
  // We get the stop event and only if relates to the current id trigger the stopNet event
  let stopNet = HttpEvent()
  let stopThis = (stop.Publish %- (fun arg -> arg.Match.Groups.[1].Value = id))
                 |-> (fun arg -> arg.Result <- OK(sprintf "Job %s done" id)
                                 jobs.Remove(id) |> ignore 
                                 stopNet.Trigger(arg)
                     )
  // Start a net listening for the stop event
  Expr.start HttpEventArgs.Empty orch stopThis |> ignore

  // Net looping forever unless the stopNet event fires
  let net = (loopUntil [|stopNet.Publish|] doWork)

  // Starts the net
  Expr.start HttpEventArgs.Empty orch net |> ignore
)

// Starts the startNet and statusReq nets looping forever
Expr.start HttpEventArgs.Empty orch (+startNet)
Expr.start HttpEventArgs.Empty orch (+statusReq)
  
// Starts Suave
startWebServer defaultConfig app

namespace Suave

namespace EvReact

module Http

from Suave

module Successful

from Suave

module Web

from Suave

Multiple items
module Expr

from EvReact

--------------------
type Expr<'T>
static member ( |=> ) : Expr<'a> * ('a -> unit) -> Expr<'a>
static member ( |-> ) : Expr<'a> * ('a -> unit) -> Expr<'a>
static member ( &&& ) : Expr<'a> * Expr<'a> -> Expr<'a>
static member ( ||| ) : Expr<'a> * Expr<'a> -> Expr<'a>
static member ( / ) : Expr<'a> * IEvent<'a> [] -> Expr<'a>
static member ( - ) : Expr<'a> * Expr<'a> -> Expr<'a>
static member ( ~+ ) : Expr<'a> -> Expr<'a>

Full name: EvReact.Expr<_>

val start : obj

Full name: Script.start

val work : obj

Full name: Script.work

val stop : obj

Full name: Script.stop

val status : obj

Full name: Script.status

val jobs : System.Collections.Generic.List<string>

Full name: Script.jobs

type ResizeArray<'T> = System.Collections.Generic.List<'T>

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

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 app : WebPart

Full name: Script.app

val NO_CONTENT : WebPart

Full name: Suave.Successful.NO_CONTENT

val statusReq : Expr<obj>

Full name: Script.statusReq

val arg : obj

val OK : body:string -> WebPart

Full name: Suave.Successful.OK

namespace System

Multiple items
type String =
  new : value:char -> string + 7 overloads
  member Chars : int -> char
  member Clone : unit -> obj
  member CompareTo : value:obj -> int + 1 overload
  member Contains : value:string -> bool
  member CopyTo : sourceIndex:int * destination:char[] * destinationIndex:int * count:int -> unit
  member EndsWith : value:string -> bool + 2 overloads
  member Equals : obj:obj -> bool + 2 overloads
  member GetEnumerator : unit -> CharEnumerator
  member GetHashCode : unit -> int
  ...

Full name: System.String

--------------------
System.String(value: nativeptr<char>) : unit
System.String(value: nativeptr<sbyte>) : unit
System.String(value: char []) : unit
System.String(c: char, count: int) : unit
System.String(value: nativeptr<char>, startIndex: int, length: int) : unit
System.String(value: nativeptr<sbyte>, startIndex: int, length: int) : unit
System.String(value: char [], startIndex: int, length: int) : unit
System.String(value: nativeptr<sbyte>, startIndex: int, length: int, enc: System.Text.Encoding) : unit

System.String.Join(separator: string, values: System.Collections.Generic.IEnumerable<string>) : string
System.String.Join<'T>(separator: string, values: System.Collections.Generic.IEnumerable<'T>) : string
System.String.Join(separator: string, [<System.ParamArray>] values: obj []) : string
System.String.Join(separator: string, [<System.ParamArray>] value: string []) : string
System.String.Join(separator: string, value: string [], startIndex: int, count: int) : string

val loopUntil : terminator:IEvent<obj> [] -> body:Expr<obj> -> Expr<obj>

Full name: Script.loopUntil

val terminator : IEvent<obj> []

val body : Expr<obj>

val never : Expr<'a>

Full name: EvReact.Expr.never

val orch : Orchestrator<obj>

Full name: Script.orch

Multiple items
module Orchestrator

from EvReact

--------------------
type Orchestrator<'T>

Full name: EvReact.Orchestrator<_>

val create : unit -> Orchestrator<'a>

Full name: EvReact.Orchestrator.create

val startNet : Expr<obj>

Full name: Script.startNet

val id : string

System.Collections.Generic.List.Add(item: string) : unit

val sprintf : format:Printf.StringFormat<'T> -> 'T

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

val doWork : Expr<obj>

val value : 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<_>

val stopNet : obj

val stopThis : Expr<obj>

System.Collections.Generic.List.Remove(item: string) : bool

val ignore : value:'T -> unit

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

val start : 'a -> Orchestrator<'a> -> Expr<'a> -> System.IDisposable

Full name: EvReact.Expr.start

val net : Expr<obj>

val startWebServer : config:SuaveConfig -> webpart:WebPart -> unit

Full name: Suave.Web.startWebServer

val defaultConfig : SuaveConfig

Full name: Suave.Web.defaultConfig

Raw view Test code New version

More information

Link:	http://fssnip.net/tL
Posted:	8 years ago
Author:	Antonio Cisternino
Tags:	evreact , reactive programming