Skip to content
Permalink
master
Go to file
 
 
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()
You can’t perform that action at this time.