Program.fs 3.27 KB
Newer Older
mud rz's avatar
initial  
mud rz committed
1 2 3 4 5 6 7 8 9 10 11 12 13
module fsharp_bench.App

open System
open System.IO
open Microsoft.AspNetCore.Builder
open Microsoft.AspNetCore.Cors.Infrastructure
open Microsoft.AspNetCore.Hosting
open Microsoft.Extensions.Hosting
open Microsoft.Extensions.Logging
open Microsoft.Extensions.DependencyInjection
open Giraffe
open FSharp.Control.Tasks.V2.ContextInsensitive

mud rz's avatar
mud rz committed
14 15 16 17 18 19
type hello_world = { hello: string }

let indexHandler: HttpHandler = json { hello = "world" }

let rootHandler: HttpHandler =
    let view = Content.welcome ()
mud rz's avatar
initial  
mud rz committed
20 21 22
    htmlView view

let fortunesHandler: HttpHandler =
mud rz's avatar
mud rz committed
23 24 25 26 27 28
    fun ctx next ->
        task {
            let! excerpts = Db.fortunes ()
            let view = Content.excerpts_listing_page excerpts
            return! htmlView view ctx next
        }
mud rz's avatar
initial  
mud rz committed
29

mud rz's avatar
mud rz committed
30 31 32
[<CLIMutable>]
type res = { excerpts: Excerpt.t list }

mud rz's avatar
initial  
mud rz committed
33
let fortunesJsonHandler: HttpHandler =
mud rz's avatar
mud rz committed
34 35 36 37 38 39
    fun ctx next ->
        task {
            let! excerpts = Db.fortunes ()
            let res = { excerpts = excerpts }
            return! json res ctx next
        }
mud rz's avatar
initial  
mud rz committed
40 41

let webApp =
mud rz's avatar
mud rz committed
42 43 44 45 46 47
    choose [ GET
             >=> choose [ route "/" >=> indexHandler
                          route "/root" >=> rootHandler
                          route "/fortunes" >=> fortunesHandler
                          route "/fortunes-json" >=> fortunesJsonHandler ]
             setStatusCode 404 >=> text "Not Found" ]
mud rz's avatar
initial  
mud rz committed
48 49 50 51 52

// ---------------------------------
// Error handler
// ---------------------------------

mud rz's avatar
mud rz committed
53
let errorHandler (ex: Exception) (logger: ILogger) =
mud rz's avatar
initial  
mud rz committed
54
    logger.LogError(ex, "An unhandled exception has occurred while executing the request.")
mud rz's avatar
mud rz committed
55 56 57 58

    clearResponse
    >=> setStatusCode 500
    >=> text ex.Message
mud rz's avatar
initial  
mud rz committed
59 60 61 62 63

// ---------------------------------
// Config and Main
// ---------------------------------

mud rz's avatar
mud rz committed
64 65 66 67 68 69 70
let configureCors (builder: CorsPolicyBuilder) =
    builder.WithOrigins("http://localhost:8080").AllowAnyMethod().AllowAnyHeader()
    |> ignore

let configureApp (app: IApplicationBuilder) =
    let env =
        app.ApplicationServices.GetService<IWebHostEnvironment>()
mud rz's avatar
initial  
mud rz committed
71 72

    (match env.EnvironmentName with
mud rz's avatar
mud rz committed
73 74
     | "Development" -> app.UseDeveloperExceptionPage()
     | _ -> app.UseGiraffeErrorHandler(errorHandler)).UseHttpsRedirection().UseCors(configureCors).UseStaticFiles()
mud rz's avatar
initial  
mud rz committed
75 76
        .UseGiraffe(webApp)

mud rz's avatar
mud rz committed
77 78
let configureServices (services: IServiceCollection) =
    services.AddCors() |> ignore
mud rz's avatar
initial  
mud rz committed
79 80
    services.AddGiraffe() |> ignore

mud rz's avatar
mud rz committed
81 82 83
let configureLogging (builder: ILoggingBuilder) =
    builder.AddFilter(fun l -> l.Equals LogLevel.Error).AddConsole().AddDebug()
    |> ignore
mud rz's avatar
initial  
mud rz committed
84 85 86 87

[<EntryPoint>]
let main args =
    let contentRoot = Directory.GetCurrentDirectory()
mud rz's avatar
mud rz committed
88
    let webRoot = Path.Combine(contentRoot, "WebRoot")
mud rz's avatar
initial  
mud rz committed
89
    Console.WriteLine("Starting...")
mud rz's avatar
mud rz committed
90 91 92 93
    let port = 5001
    let port = 3000
    let port = string port

mud rz's avatar
initial  
mud rz committed
94
    Host.CreateDefaultBuilder(args)
mud rz's avatar
mud rz committed
95 96 97 98 99 100 101 102
        .ConfigureWebHostDefaults(fun webHostBuilder ->
        webHostBuilder.UseContentRoot(contentRoot).UseWebRoot(webRoot).UseUrls("http://localhost:" + port)
                      .Configure(Action<IApplicationBuilder> configureApp).ConfigureServices(configureServices)
                      .ConfigureLogging(configureLogging)
        |> ignore

        Console.WriteLine("Giraffe listening on :" + port)).Build().Run()

mud rz's avatar
initial  
mud rz committed
103
    0