Skip to content

Instantly share code, notes, and snippets.

@thinkbeforecoding
Created October 1, 2014 08:06
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save thinkbeforecoding/7db1b995ed447a791ce5 to your computer and use it in GitHub Desktop.
Save thinkbeforecoding/7db1b995ed447a791ce5 to your computer and use it in GitHub Desktop.
Http Server in F#
// This module implements AwaitTask for non generic Task
// It should be useless in F# 4 since it should be implemented in FSharp.Core
[<AutoOpen>]
module AsyncExtensions =
open System
open System.Threading
open System.Threading.Tasks
type Microsoft.FSharp.Control.Async with
static member Raise(ex) = Async.FromContinuations(fun (_,econt,_) -> econt ex)
static member AwaitTask (t: Task) =
let tcs = new TaskCompletionSource<unit>(TaskContinuationOptions.None)
t.ContinueWith((fun _ ->
if t.IsFaulted then tcs.SetException t.Exception
elif t.IsCanceled then tcs.SetCanceled()
else tcs.SetResult(())), TaskContinuationOptions.ExecuteSynchronously) |> ignore
async {
try
do! Async.AwaitTask tcs.Task
with
| :? AggregateException as ex ->
do! Async.Raise (ex.Flatten().InnerExceptions |> Seq.head) }
open System.Net
open System.IO
open Microsoft.FSharp.Control
let server handler =
let listener = new HttpListener(IgnoreWriteExceptions = true )
listener.Prefixes.Add("http://localhost:80/")
listener.Start()
let rec listen() =
async {
let! context = Async.AwaitTask <| listener.GetContextAsync()
match handler context with
| Some process -> Async.Start process
| None -> context.Response.StatusCode <- 404
context.Response.Close()
return! listen() }
listen()
|> Async.Start
listener
let url path webPart (context: HttpListenerContext) =
if context.Request.Url.LocalPath = path then
webPart context
else
None
type WebPart = HttpListenerContext -> Async<unit> option
let methOd m (webPart: WebPart) (context: HttpListenerContext) =
if context.Request.HttpMethod = m then
webPart context
else
None
let GET = methOd "GET"
let POST = methOd "POST"
let text s (context: HttpListenerContext) =
async {
context.Response.ContentType <- "text/plain"
use writer = new StreamWriter(context.Response.OutputStream)
do! Async.AwaitTask(writer.WriteLineAsync (s: string))
do! Async.AwaitTask(writer.FlushAsync())
context.Response.Close() }
|> Some
let choose parts context =
parts
|> List.tryPick (fun part -> part context)
let s = server <| choose [GET (url "/hello" (text "Hello World"))
GET (url "/world" (text "World")) ]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment