Last active
April 2, 2021 08:15
-
-
Save evilz/f94e470b714ab9b522da4c98e27995d6 to your computer and use it in GitHub Desktop.
Todo WebAPI in Fsharp
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module TodoBasic | |
open System | |
open System.Text.Json.Serialization | |
open System.Threading.Tasks | |
open Microsoft.AspNetCore.Builder | |
open Microsoft.AspNetCore.Http | |
open Microsoft.AspNetCore.Routing | |
open Microsoft.AspNetCore.Hosting | |
open Microsoft.Extensions.Hosting | |
open Microsoft.AspNetCore.Diagnostics | |
open Microsoft.AspNetCore.Http.Features | |
open Microsoft.EntityFrameworkCore | |
open FSharp.Control.Tasks | |
[<AutoOpen>] | |
module Data = | |
[<CLIMutable>] | |
type Todo = | |
{ Id: int | |
mutable Name: string | |
mutable IsComplete: bool } | |
type TodoDbContext() = | |
inherit DbContext() | |
[<DefaultValue>] | |
val mutable todos: DbSet<Todo> | |
member this.Todos | |
with public get () = this.todos | |
and public set x = this.todos <- x | |
override __.OnConfiguring(optionsBuilder: DbContextOptionsBuilder) = | |
optionsBuilder.UseInMemoryDatabase("Todos") | |
|> ignore | |
[<AutoOpen>] | |
module Web = | |
type Router = | |
{ get: string -> (HttpContext -> Task) -> unit | |
post: string -> (HttpContext -> Task) -> unit | |
delete: string -> (HttpContext -> Task) -> unit } | |
let createRouter (builder: IEndpointRouteBuilder) = | |
{ get = | |
fun pattern action -> | |
builder.MapGet(pattern, RequestDelegate action) | |
|> ignore | |
post = | |
fun pattern action -> | |
builder.MapPost(pattern, RequestDelegate action) | |
|> ignore | |
delete = | |
fun pattern action -> | |
builder.MapDelete(pattern, RequestDelegate action) | |
|> ignore } | |
[<AutoOpen>] | |
module Handlers = | |
let getTodos (ctx: HttpContext) = | |
unitTask { | |
use db = new TodoDbContext() | |
let! todos = db.Todos.ToListAsync() | |
return! ctx.Response.WriteAsJsonAsync(todos) | |
} | |
let getTodo (ctx: HttpContext) = | |
unitTask { | |
let id = | |
ctx.GetRouteValue "id" |> Convert.ToInt32 | |
use db = new TodoDbContext() | |
let! todo = db.Todos.FindAsync(id) | |
match box todo with | |
| null -> ctx.Response.StatusCode <- 404 | |
| _ -> do! ctx.Response.WriteAsJsonAsync(todo) | |
} | |
let createTodo (ctx: HttpContext) = | |
unitTask { | |
let! todo = ctx.Request.ReadFromJsonAsync<Todo>() | |
use db = new TodoDbContext() | |
let! _ = db.Todos.AddAsync(todo, ctx.RequestAborted) | |
let! __ = db.SaveChangesAsync(ctx.RequestAborted) | |
ctx.Response.StatusCode <- 204 | |
} | |
let updateCompleted (ctx: HttpContext) = | |
unitTask { | |
let id = | |
ctx.GetRouteValue "id" |> Convert.ToInt32 | |
use db = new TodoDbContext() | |
let! todo = db.Todos.FindAsync(id) | |
match box todo with | |
| null -> ctx.Response.StatusCode <- 404 | |
| _ -> | |
let! inputTodo = ctx.Request.ReadFromJsonAsync<Todo>() | |
todo.IsComplete <- inputTodo.IsComplete | |
let! __ = db.SaveChangesAsync() | |
ctx.Response.StatusCode <- 204 | |
} | |
let deleteTodo (ctx: HttpContext) = | |
unitTask { | |
let id = | |
ctx.GetRouteValue "id" |> Convert.ToInt32 | |
use db = new TodoDbContext() | |
let! todo = db.Todos.FindAsync(id) | |
match box todo with | |
| null -> ctx.Response.StatusCode <- 404 | |
| _ -> | |
let _ = db.Todos.Remove(todo) | |
let! __ = db.SaveChangesAsync() | |
ctx.Response.StatusCode <- 204 | |
} | |
let handleExn (errorApp: IApplicationBuilder) = | |
errorApp.Run | |
(fun ctx -> | |
ctx.Response.StatusCode <- 500 | |
let exceptionHandlerPathFeature : IExceptionHandlerPathFeature = | |
ctx.Features.Get<IExceptionHandlerPathFeature>() | |
let error = exceptionHandlerPathFeature.Error | |
let problemDetail = | |
{| ``type`` = error.GetType().Name | |
title = error.Message | |
detail = error.StackTrace |} | |
ctx.Response.WriteAsJsonAsync(problemDetail) | |
) | |
module App = | |
let configureRoutes (builder: IEndpointRouteBuilder) = | |
let { get = get | |
post = post | |
delete = delete } = | |
createRouter builder | |
get "/api/todos" getTodos | |
get "/api/todos/{id:int}" getTodo | |
post "/api/todos" createTodo | |
post "/api/todos/{id:int}" updateCompleted | |
delete "/api/todos/{id:int}" deleteTodo | |
[<EntryPoint>] | |
let main args = | |
Host | |
.CreateDefaultBuilder(args) | |
.ConfigureWebHostDefaults(fun webHost -> | |
webHost.Configure | |
(fun app -> | |
app | |
.UseExceptionHandler(handleExn) | |
.UseRouting() | |
.UseEndpoints(Action<IEndpointRouteBuilder>(configureRoutes)) | |
|> ignore) | |
|> ignore) | |
.Build() | |
.Run() | |
0 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment