Skip to content
Permalink
master
Switch branches/tags

Name already in use

A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
Go to file
 
 
Cannot retrieve contributors at this time
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()