Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
142 lines (118 sloc) 5.16 KB
namespace FunScript
open System.IO
open System.Net
open System.Threading
open System.Text
// ----------------------------------------------------------------------------
// Simple web server hosting static files
// ----------------------------------------------------------------------------
module RuntimeImplementation =
[<AutoOpen>]
module HttpExtensions =
type System.Net.HttpListener with
member x.AsyncGetContext() =
Async.FromBeginEnd(x.BeginGetContext, x.EndGetContext)
type System.Net.HttpListenerRequest with
member request.InputString =
use sr = new StreamReader(request.InputStream)
sr.ReadToEnd()
type System.Net.HttpListenerResponse with
member response.Reply(s:string) =
let buffer = Encoding.UTF8.GetBytes(s)
response.ContentLength64 <- int64 buffer.Length
response.OutputStream.Write(buffer,0,buffer.Length)
response.OutputStream.Close()
member response.Reply(typ, buffer:byte[]) =
response.ContentLength64 <- int64 buffer.Length
response.ContentType <- typ
response.OutputStream.Write(buffer,0,buffer.Length)
response.OutputStream.Close()
/// Simple HTTP server
type HttpServer private (url, root) =
let contentTypes =
dict [ ".css", "text/css"; ".html", "text/html"; ".js", "text/javascript";
".gif", "image/gif"; ".png", "image/png"; ".jpg", "image/jpeg";
".mp3", "audio/mpeg"; ".wav", "audio/wav"; ".mpg", "video/mpeg" ]
let tokenSource = new CancellationTokenSource()
let agent = MailboxProcessor<HttpListenerContext>.Start((fun inbox -> async {
while true do
let! context = inbox.Receive()
let s = context.Request.Url.LocalPath
// Handle an ordinary file request
let file = root + (if s = "/" then "/index.html" else s)
if File.Exists(file) then
let ext = Path.GetExtension(file).ToLower()
let typ = contentTypes.[ext]
context.Response.Reply(typ, File.ReadAllBytes(file))
else
context.Response.Reply(sprintf "File not found: %s" file) }), tokenSource.Token)
let server = async {
use listener = new HttpListener()
listener.Prefixes.Add(url)
listener.Start()
while true do
let! context = listener.AsyncGetContext()
agent.Post(context) }
do Async.Start(server, cancellationToken = tokenSource.Token)
/// Stops the HTTP server and releases the TCP connection
member x.Stop() = tokenSource.Cancel()
/// Starts new HTTP server on the specified URL. The specified
/// function represents computation running inside the agent.
static member Start(url, root) =
new HttpServer(url, root)
// ----------------------------------------------------------------------------
// Main method that finds 'main' function and generates JS file
// ----------------------------------------------------------------------------
open FunScript
open System.IO
open System.Reflection
open Microsoft.FSharp.Quotations
open RuntimeImplementation
type Runtime private() =
static member Run(?expression, ?port, ?directory, ?components, ?browse) =
let components = defaultArg components []
let port = defaultArg port 8081
let directory = defaultArg directory ""
let browse = defaultArg browse true
// Find the main method in this assembly
let thisAsm = Assembly.GetExecutingAssembly()
let main =
match expression with
| None ->
printfn "Searching for main function..."
let types = thisAsm.GetTypes()
let flags = BindingFlags.NonPublic ||| BindingFlags.Public ||| BindingFlags.Static
let mains =
[ for typ in types do
for mi in typ.GetMethods(flags) do
if mi.Name = "main" then yield mi ]
let main =
match mains with
| [it] -> it
| _ -> failwith "Main function not found!"
printfn "Found entry point..."
Expr.Call(main, [])
| Some e -> e
// Get the path
let root = Path.GetDirectoryName(System.Reflection.Assembly.GetExecutingAssembly().Location)
let root = Path.Combine(root, directory)
// Compile the main function into a script
let sw = System.Diagnostics.Stopwatch.StartNew()
let source = FunScript.Compiler.Compiler.Compile(main, components=components)
let sourceWrapped = sprintf "$(document).ready(function () {\n%s\n});" source
let filename = Path.Combine(root, "page.js")
printfn "Generated JavaScript in %f sec..." (float sw.ElapsedMilliseconds / 1000.0)
System.IO.File.Delete filename
System.IO.File.WriteAllText(filename, sourceWrapped)
let shouldOnlyGenerateCode =
System.Environment.GetCommandLineArgs()
|> Array.exists ((=) "--only-generate-code")
if not shouldOnlyGenerateCode then
// Starting the web server
let url = sprintf "http://localhost:%d/" port
let server = HttpServer.Start(url, root)
printfn "Starting web server at %s" url
if browse then
System.Diagnostics.Process.Start(url) |> ignore
System.Console.ReadLine() |> ignore
server.Stop()