diff --git a/src/Saturn/Controller.fs b/src/Saturn/Controller.fs index b8cbabf3..e0a494da 100644 --- a/src/Saturn/Controller.fs +++ b/src/Saturn/Controller.fs @@ -18,6 +18,7 @@ module Controller = type Action = | Index | Show + | Exists | Add | Edit | Create @@ -32,13 +33,14 @@ module Controller = let inputSet = Set actions if inputSet |> Set.contains All then [] else - let allSet = Set [Index;Show;Add;Edit;Create;Update;Patch;Delete;DeleteAll] + let allSet = Set [Index;Show;Exists;Add;Edit;Create;Update;Patch;Delete;DeleteAll] allSet - inputSet |> Set.toList ///Type representing internal state of the `controller` computation expression - type ControllerState<'Key, 'IndexOutput, 'ShowOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> = { + type ControllerState<'Key, 'IndexOutput, 'ShowOutput, 'ExistsOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> = { Index: (HttpContext -> Task<'IndexOutput>) option Show: (HttpContext -> 'Key -> Task<'ShowOutput>) option + Exists: (HttpContext -> 'Key -> Task<'ExistsOutput>) option Add: (HttpContext -> Task<'AddOutput>) option Edit: (HttpContext -> 'Key -> Task<'EditOutput>) option Create: (HttpContext -> Task<'CreateOutput>) option @@ -104,10 +106,10 @@ module Controller = /// edit (fun (ctx, id) -> (sprintf "Edit handler no version - %i" id) |> Controller.text ctx) /// } /// ``` - type ControllerBuilder<'Key, 'IndexOutput, 'ShowOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> internal () = + type ControllerBuilder<'Key, 'IndexOutput, 'ShowOutput, 'ExistsOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> internal () = - member __.Yield(_) : ControllerState<'Key, 'IndexOutput, 'ShowOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> = - { Index = None; Show = None; Add = None; Edit = None; Create = None; Update = None; Patch = None; Delete = None; DeleteAll = None; NotFoundHandler = None; Version = None; SubControllers = []; Plugs = Map.empty<_,_>; ErrorHandler = (fun _ ex -> raise ex); CaseInsensitive = false } + member __.Yield(_) : ControllerState<'Key, 'IndexOutput, 'ShowOutput, 'ExistsOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> = + { Index = None; Show = None; Exists = None; Add = None; Edit = None; Create = None; Update = None; Patch = None; Delete = None; DeleteAll = None; NotFoundHandler = None; Version = None; SubControllers = []; Plugs = Map.empty<_,_>; ErrorHandler = (fun _ ex -> raise ex); CaseInsensitive = false } ///Operation that should render (or return in case of API controllers) list of data [] @@ -125,6 +127,14 @@ module Controller = member x.Show (state, handler: HttpContext -> 'Dependency -> 'Key -> Task<'ShowOutput>) = {state with Show = Some (x.MapDependencyHandlerToHandler' handler)} + ///Operation that should handle a HEAD request and return a bodiless 200 OK or 404 NOT FOUND for a single entry + [] + member __.Exists (state, handler: HttpContext -> 'Key -> Task<'ExistsOutput>) = + {state with Exists = Some handler} + + member x.Exists (state, handler: HttpContext -> 'Dependency -> 'Key -> Task<'ExistsOutput>) = + {state with Exists = Some (x.MapDependencyHandlerToHandler' handler)} + ///Operation that should render form for adding new item [] member __.Add (state, handler: HttpContext -> Task<'AddOutput>) = @@ -183,7 +193,7 @@ module Controller = ///Define not-found handler for the controller [] - member __.NotFoundHandler(state : ControllerState<_,_,_,_,_,_,_,_,_,_>, handler) = + member __.NotFoundHandler(state : ControllerState<_,_,_,_,_,_,_,_,_,_,_>, handler) = {state with NotFoundHandler = Some handler} ///Define error for the controller @@ -206,7 +216,7 @@ module Controller = ///Toggle case insensitve routing [] - member __.CaseInsensitive (state : ControllerState<_,_,_,_,_,_,_,_,_,_> ) = + member __.CaseInsensitive (state : ControllerState<_,_,_,_,_,_,_,_,_,_,_> ) = {state with CaseInsensitive = true} ///Inject a controller into the routing table rooted at a given route. All of that controller's actions will be anchored off of the route as a prefix. @@ -226,7 +236,7 @@ module Controller = {state with Plugs = newplugs} if actions |> List.contains All then - [Index;Show;Add;Edit;Create;Update;Patch;Delete;DeleteAll] |> List.fold (fun acc e -> addPlug acc e handler) state + [Index;Show;Exists;Add;Edit;Create;Update;Patch;Delete;DeleteAll] |> List.fold (fun acc e -> addPlug acc e handler) state else actions |> List.fold (fun acc e -> addPlug acc e handler) state @@ -324,12 +334,12 @@ module Controller = | None -> routeHandler actionHandler - member this.Run (state: ControllerState<'Key, 'IndexOutput, 'ShowOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput>) : HttpHandler = + member this.Run (state: ControllerState<'Key, 'IndexOutput, 'ShowOutput, 'ExistsOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput>) : HttpHandler = let siteMap = HandlerMap() let addToSiteMap v p = siteMap.AddPath p v let keyFormat = match state with - | { Show = None; Edit = None; Update = None; Delete = None; Patch = None; SubControllers = [] } -> None + | { Show = None; Exists = None; Edit = None; Update = None; Delete = None; Patch = None; SubControllers = [] } -> None | _ -> match typeof<'Key> with | k when k = typeof -> "/%b" @@ -380,6 +390,15 @@ module Controller = addToSiteMap route yield this.AddKeyHandler state Show state.Show.Value route ] + yield HEAD >=> choose [ + let addToSiteMap = addToSiteMap "HEAD" + + if keyFormat.IsSome then + if state.Exists.IsSome then + let route = keyFormat.Value + addToSiteMap route + yield this.AddKeyHandler state Exists state.Exists.Value route + ] yield POST >=> choose [ let addToSiteMap = addToSiteMap "POST" @@ -467,4 +486,4 @@ module Controller = res ///Computation expression used to create controllers - let controller<'Key, 'IndexOutput, 'ShowOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> = ControllerBuilder<'Key, 'IndexOutput, 'ShowOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> () + let controller<'Key, 'IndexOutput, 'ShowOutput, 'ExistsOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> = ControllerBuilder<'Key, 'IndexOutput, 'ShowOutput, 'ExistsOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> () diff --git a/src/Saturn/ControllerEndpoint.fs b/src/Saturn/ControllerEndpoint.fs index 2116f544..8c7b0432 100644 --- a/src/Saturn/ControllerEndpoint.fs +++ b/src/Saturn/ControllerEndpoint.fs @@ -37,9 +37,10 @@ module Controller = allSet - inputSet |> Set.toList ///Type representing internal state of the `controller` computation expression - type ControllerState<'Key, 'IndexOutput, 'ShowOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> = { + type ControllerState<'Key, 'IndexOutput, 'ShowOutput, 'ExistsOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> = { Index: (HttpContext -> Task<'IndexOutput>) option Show: (HttpContext -> 'Key -> Task<'ShowOutput>) option + Exists: (HttpContext -> 'Key -> Task<'ExistsOutput>) option Add: (HttpContext -> Task<'AddOutput>) option Edit: (HttpContext -> 'Key -> Task<'EditOutput>) option Create: (HttpContext -> Task<'CreateOutput>) option @@ -104,10 +105,10 @@ module Controller = /// edit (fun (ctx, id) -> (sprintf "Edit handler no version - %i" id) |> Controller.text ctx) /// } /// ``` - type ControllerBuilder<'Key, 'IndexOutput, 'ShowOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> internal () = + type ControllerBuilder<'Key, 'IndexOutput, 'ShowOutput, 'ExistsOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> internal () = - member __.Yield(_) : ControllerState<'Key, 'IndexOutput, 'ShowOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> = - { Index = None; Show = None; Add = None; Edit = None; Create = None; Update = None; Patch = None; Delete = None; DeleteAll = None; NotFoundHandler = None; Version = None; SubControllers = []; Plugs = Map.empty<_,_>; ErrorHandler = (fun _ ex -> raise ex); } + member __.Yield(_) : ControllerState<'Key, 'IndexOutput, 'ShowOutput, 'ExistsOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> = + { Index = None; Show = None; Exists = None; Add = None; Edit = None; Create = None; Update = None; Patch = None; Delete = None; DeleteAll = None; NotFoundHandler = None; Version = None; SubControllers = []; Plugs = Map.empty<_,_>; ErrorHandler = (fun _ ex -> raise ex); } ///Operation that should render (or return in case of API controllers) list of data [] @@ -183,7 +184,7 @@ module Controller = ///Define not-found handler for the controller [] - member __.NotFoundHandler(state : ControllerState<_,_,_,_,_,_,_,_,_,_>, handler) = + member __.NotFoundHandler(state : ControllerState<_,_,_,_,_,_,_,_,_,_,_>, handler) = {state with NotFoundHandler = Some handler} ///Define error for the controller @@ -375,7 +376,7 @@ module Controller = endpoint |> List.map (fun e -> e actionHandler) - member this.Run (state: ControllerState<'Key, 'IndexOutput, 'ShowOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput>) : Endpoint list = + member this.Run (state: ControllerState<'Key, 'IndexOutput, 'ShowOutput, 'ExistsOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput>) : Endpoint list = let isKnownKey = match state with | { Show = None; Edit = None; Update = None; Delete = None; Patch = None; SubControllers = [] } -> false @@ -469,7 +470,7 @@ module Controller = ] ///Computation expression used to create controllers - let controller<'Key, 'IndexOutput, 'ShowOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> = ControllerBuilder<'Key, 'IndexOutput, 'ShowOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> () + let controller<'Key, 'IndexOutput, 'ShowOutput, 'ExistsOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> = ControllerBuilder<'Key, 'IndexOutput, 'ShowOutput, 'ExistsOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> () ///Computation expression used to create HttpHandlers representing subcontrollers. - let subcontroller<'Key, 'IndexOutput, 'ShowOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> = Saturn.Controller.ControllerBuilder<'Key, 'IndexOutput, 'ShowOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> () + let subcontroller<'Key, 'IndexOutput, 'ShowOutput, 'ExistsOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> = Saturn.Controller.ControllerBuilder<'Key, 'IndexOutput, 'ShowOutput, 'ExistsOutput, 'AddOutput, 'EditOutput, 'CreateOutput, 'UpdateOutput, 'PatchOutput, 'DeleteOutput, 'DeleteAllOutput> () diff --git a/src/Saturn/Router.fs b/src/Saturn/Router.fs index 208ffe82..925a00b8 100644 --- a/src/Saturn/Router.fs +++ b/src/Saturn/Router.fs @@ -15,6 +15,8 @@ module Router = ///Type representing route type, used in internal state of the `application` computation expression type RouteType = | Get + | Head + | GetOrHead | Post | Put | Delete @@ -145,6 +147,8 @@ module Router = let v = match typ with | RouteType.Get -> "GET" + | RouteType.Head -> "HEAD" + | RouteType.GetOrHead -> "GET_HEAD" | RouteType.Post -> "POST" | RouteType.Put -> "PUT" | RouteType.Patch -> "PATCH" @@ -177,6 +181,8 @@ module Router = routes, routesf let gets, getsf = generateRoutes RouteType.Get + let heads, headsf = generateRoutes RouteType.Head + let getOrHeads, getOrHeadsf = generateRoutes RouteType.GetOrHead let posts, postsf = generateRoutes RouteType.Post let patches, patchesf = generateRoutes RouteType.Patch @@ -212,6 +218,16 @@ module Router = for e in getsf do yield GET >=> e + for e in heads do + yield HEAD >=> e + for e in headsf do + yield HEAD >=> e + + for e in getOrHeads do + yield GET_HEAD >=> e + for e in getOrHeadsf do + yield GET_HEAD >=> e + for e in posts do yield POST >=> e for e in postsf do @@ -257,6 +273,26 @@ module Router = member __.GetF(state, path : PrintfFormat<_,_,_,_,'f>, action) : RouterState = addRouteF RouteType.Get state path action + ///Adds handler for `HEAD` request. + [] + member __.Head(state, path : string, action: HttpHandler) : RouterState = + addRoute RouteType.Head state path action + + ///Adds handler for `HEAD` request. + [] + member __.HeadF(state, path : PrintfFormat<_,_,_,_,'f>, action) : RouterState = + addRouteF RouteType.Head state path action + + ///Adds handler for either `GET` or `HEAD` request. + [] + member __.GetOrHead(state, path : string, action: HttpHandler) : RouterState = + addRoute RouteType.GetOrHead state path action + + ///Adds handler for either `GET` or `HEAD` request. + [] + member __.GetOrHeadF(state, path : PrintfFormat<_,_,_,_,'f>, action) : RouterState = + addRouteF RouteType.GetOrHead state path action + ///Adds handler for `POST` request. [] member __.Post(state, path : string, action: HttpHandler) : RouterState =