2 people like it.

Suave.EvReact

Suave.EvReact is a library for creating events from URLs using Suave. This examples shows how to combine this library and evreact to orchestrate access to URLs.

 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: 

open Suave.EvReact

open Suave
open Suave.Http
open Suave.Successful
open Suave.Web
open Suave.Operators
open System.Text.RegularExpressions

open EvReact
open EvReact.Expr

let regex (pattern:string) (arg:HttpContext) =
    async {
      if Regex.IsMatch(arg.request.url.AbsolutePath, pattern) then
        return Some arg
      else
        return None
    }

let rexm (pattern:string) (ctx:HttpEventArgs) =
  Regex.Match(ctx.Context.request.url.AbsolutePath, pattern)

// Create the EvReact events associated with URLs
let startp, (startwp, start) = "/start/(\\d+)", httpResponse(Some 1000)
let workp, (workwp, work) = "/work/(\\d+)/(\\d+)", httpResponse(Some 1000)
let stopp, (stopwp, stop) = "/stop/(\\d+)", httpResponse(Some 1000)
let statusp, (statuswp, status) = "/status", httpResponse(Some 1000)

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 = choose 
            [
                regex startp >=> startwp
                regex workp >=> workwp
                regex stopp >=> stopwp
                regex statusp >=> statuswp
            ]

// This EvReact net simply react to the status event by printing the list of jobs
let statusReq = !!status |-> (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 |-> (fun arg ->
  let m = rexm startp arg
  // Read the id from the argument
  let id = m.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 %- (fun arg -> let m = rexm workp arg in m.Groups.[1].Value = id)) |-> (fun arg ->
    let m = rexm workp arg
    let value = int(m.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 = Event.create<HttpEventArgs>("stopNet")
  let stopThis = (stop %- (fun arg -> let m = rexm stopp arg in m.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 Unchecked.defaultof<_> orch stopThis |> ignore

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

  // Starts the net
  Expr.start Unchecked.defaultof<_> orch net |> ignore
)

// Starts the startNet and statusReq nets looping forever
Expr.start Unchecked.defaultof<_> orch (+startNet)
Expr.start Unchecked.defaultof<_> orch (+statusReq)
  
// Starts Suave
startWebServer defaultConfig app
namespace Suave
module EvReact

from Suave
module Http

from Suave
module Successful

from Suave
module Web

from Suave
module Operators

from Suave
namespace System
namespace System.Text
namespace System.Text.RegularExpressions
Multiple items
module EvReact

from Suave

--------------------
namespace EvReact
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 regex : pattern:string -> arg:HttpContext -> Async<HttpContext option>

Full name: Script.regex
val pattern : 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
val arg : HttpContext
Multiple items
module HttpContext

from Suave.Http

--------------------
type HttpContext =
  {request: HttpRequest;
   runtime: HttpRuntime;
   connection: Connection;
   userState: Map<string,obj>;
   response: HttpResult;}
  member clientIp : trustProxy:bool -> sources:string list -> IPAddress
  member clientPort : trustProxy:bool -> sources:string list -> Port
  member clientProto : trustProxy:bool -> sources:string list -> string
  member clientIpTrustProxy : IPAddress
  member clientPortTrustProxy : Port
  member clientProtoTrustProxy : string
  member isLocal : bool
  static member clientIp_ : Property<HttpContext,IPAddress>
  static member clientPort_ : Property<HttpContext,Port>
  static member clientProto_ : Property<HttpContext,string>
  static member connection_ : Property<HttpContext,Connection>
  static member isLocal_ : Property<HttpContext,bool>
  static member request_ : Property<HttpContext,HttpRequest>
  static member response_ : Property<HttpContext,HttpResult>
  static member runtime_ : Property<HttpContext,HttpRuntime>
  static member userState_ : Property<HttpContext,Map<string,obj>>

Full name: Suave.Http.HttpContext
val async : AsyncBuilder

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.async
Multiple items
type Regex =
  new : pattern:string -> Regex + 1 overload
  member GetGroupNames : unit -> string[]
  member GetGroupNumbers : unit -> int[]
  member GroupNameFromNumber : i:int -> string
  member GroupNumberFromName : name:string -> int
  member IsMatch : input:string -> bool + 1 overload
  member Match : input:string -> Match + 2 overloads
  member Matches : input:string -> MatchCollection + 1 overload
  member Options : RegexOptions
  member Replace : input:string * replacement:string -> string + 5 overloads
  ...

Full name: System.Text.RegularExpressions.Regex

--------------------
Regex(pattern: string) : unit
Regex(pattern: string, options: RegexOptions) : unit
Regex.IsMatch(input: string, pattern: string) : bool
Regex.IsMatch(input: string, pattern: string, options: RegexOptions) : bool
HttpContext.request: HttpRequest
HttpRequest.url: System.Uri
property System.Uri.AbsolutePath: string
union case Option.Some: Value: 'T -> Option<'T>
union case Option.None: Option<'T>
val rexm : pattern:string -> ctx:HttpEventArgs -> Match

Full name: Script.rexm
val ctx : HttpEventArgs
type HttpEventArgs =
  inherit ResponseEventArgs
  private new : HttpContext * int option -> HttpEventArgs
  member Context : HttpContext

Full name: Suave.EvReact.HttpEventArgs
Regex.Match(input: string, pattern: string) : Match
Regex.Match(input: string, pattern: string, options: RegexOptions) : Match
property HttpEventArgs.Context: HttpContext
val startp : string

Full name: Script.startp
val startwp : WebPart

Full name: Script.startwp
val start : IEvent<HttpEventArgs>

Full name: Script.start
val httpResponse : int option -> WebPart * IEvent<HttpEventArgs>

Full name: Suave.EvReact.httpResponse
val workp : string

Full name: Script.workp
val workwp : WebPart

Full name: Script.workwp
val work : IEvent<HttpEventArgs>

Full name: Script.work
val stopp : string

Full name: Script.stopp
val stopwp : WebPart

Full name: Script.stopwp
val stop : IEvent<HttpEventArgs>

Full name: Script.stop
val statusp : string

Full name: Script.statusp
val statuswp : WebPart

Full name: Script.statuswp
val status : IEvent<HttpEventArgs>

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<_>
val app : WebPart<HttpContext>

Full name: Script.app
val choose : options:WebPart<'a> list -> WebPart<'a>

Full name: Suave.WebPart.choose
val statusReq : Expr<HttpEventArgs>

Full name: Script.statusReq
val arg : HttpEventArgs
property ResponseEventArgs.Result: WebPart
val OK : body:string -> WebPart

Full name: Suave.Successful.OK
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<HttpEventArgs> [] -> body:Expr<HttpEventArgs> -> Expr<HttpEventArgs>

Full name: Script.loopUntil
val terminator : IEvent<HttpEventArgs> []
val body : Expr<HttpEventArgs>
val never : Expr<'a>

Full name: EvReact.Expr.never
val orch : Orchestrator<HttpEventArgs>

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<HttpEventArgs>

Full name: Script.startNet
val m : Match
val id : string
property Match.Groups: GroupCollection
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<HttpEventArgs>
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 : Event<HttpEventArgs>
Multiple items
module Event

from EvReact

--------------------
module Event

from Microsoft.FSharp.Control

--------------------
type Event<'T> =
  new : unit -> Event<'T>
  new : string -> Event<'T>
  member Trigger : 'T -> unit
  member Publish : IEvent<'T>

Full name: EvReact.Event<_>

--------------------
type Event<'Delegate,'Args (requires delegate and 'Delegate :> Delegate)> =
  new : unit -> Event<'Delegate,'Args>
  member Trigger : sender:obj * args:'Args -> unit
  member Publish : IEvent<'Delegate,'Args>

Full name: Microsoft.FSharp.Control.Event<_,_>

--------------------
new : unit -> Event<'T>
new : string -> Event<'T>

--------------------
new : unit -> Event<'Delegate,'Args>
val create : string -> Event<'a>

Full name: EvReact.Event.create
val stopThis : Expr<HttpEventArgs>
System.Collections.Generic.List.Remove(item: string) : bool
val ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore
member Event.Trigger : 'T -> unit
val start : 'a -> Orchestrator<'a> -> Expr<'a> -> System.IDisposable

Full name: EvReact.Expr.start
module Unchecked

from Microsoft.FSharp.Core.Operators
val defaultof<'T> : 'T

Full name: Microsoft.FSharp.Core.Operators.Unchecked.defaultof
val net : Expr<HttpEventArgs>
property Event.Publish: IEvent<HttpEventArgs>
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/7Q0
Posted:8 years ago
Author:Antonio Cisternino
Tags: evreact , suave

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.