Scriban + HTMX F# extensions for Giraffer

Extensions.fs

namespace Extensions

open System
open System.Runtime.CompilerServices
open System.IO
open System.Threading.Tasks
open Microsoft.AspNetCore.Antiforgery
open Microsoft.AspNetCore.Http
open Microsoft.Extensions.DependencyInjection
open Microsoft.Extensions.Primitives

open Scriban
open Scriban.Parsing
open Scriban.Runtime

open Giraffe

open FsToolkit.ErrorHandling


[<Extension>]
type HttpContextExtensions =

    [<Extension>]
    static member inline getCsrfToken(ctx: HttpContext) =
        let af = ctx.GetService<IAntiforgery>()
        af.GetAndStoreTokens ctx


[<Extension>]
type HtmxExtensions =

    [<Extension>]
    static member inline XHTrigger(ctx: HttpContext) =
        match ctx.Request.Headers.TryGetValue "HX-Trigger" with
        | (true, value) ->
            match value |> Seq.tryHead with
            | Some value -> value |> ValueOption.ofObj
            | None -> ValueNone
        | (false, _) -> ValueNone

    [<Extension>]
    static member inline XHTriggerName(ctx: HttpContext) =
        match ctx.Request.Headers.TryGetValue "HX-Trigger-Name" with
        | (true, value) ->
            match value |> Seq.tryHead with
            | Some value -> value |> ValueOption.ofObj
            | None -> ValueNone
        | (false, _) -> ValueNone

    [<Extension>]
    static member inline XHTarget(ctx: HttpContext) =
        match ctx.Request.Headers.TryGetValue "HX-Target" with
        | (true, value) ->
            match value |> Seq.tryHead with
            | Some value -> value |> ValueOption.ofObj
            | None -> ValueNone
        | (false, _) -> ValueNone

    [<Extension>]
    static member inline XHPrompt(ctx: HttpContext) =
        match ctx.Request.Headers.TryGetValue "HX-Prompt" with
        | (true, value) ->
            match value |> Seq.tryHead with
            | Some value -> value |> ValueOption.ofObj
            | None -> ValueNone
        | (false, _) -> ValueNone

    [<Extension>]
    static member inline IsHtmx(ctx: HttpContext) =
        match ctx.Request.Headers.TryGetValue "HX-Request" with
        | (true, value) ->
            match value |> Seq.tryHead |> Option.map bool.TryParse with
            | Some (true, value) -> value
            | Some (false, _) -> false
            | None -> false
        | (false, _) -> false

    [<Extension>]
    static member inline SetXHPush(ctx: HttpContext, url: string) =
        ctx.Response.Headers.Add("HX-Push", StringValues(url))

    [<Extension>]
    static member inline SetXHRedirect(ctx: HttpContext, url: string) =
        ctx.Response.Headers.Add("HX-Redirect", StringValues(url))

    [<Extension>]
    static member inline SetXHTrigger(ctx: HttpContext, trigger: string) =
        ctx.Response.Headers.Add("HX-Trigger", StringValues(trigger))

    [<Extension>]
    static member inline SetXHTrigger<'T>(ctx: HttpContext, trigger: string, detail: 'T) =
        let opts = Json.JsonOptions()
        opts.SerializerOptions.WriteIndented <- false
        let event = [ trigger, detail ] |> Map.ofList

        let payload =
            System.Text.Json.JsonSerializer.Serialize(event, opts.SerializerOptions)

        ctx.Response.Headers.Add("HX-Trigger", StringValues(payload))

    [<Extension>]
    static member inline SetXHAfterSwap(ctx: HttpContext) =
        ctx.Response.Headers.Add("HX-Trigger-After-Swap", StringValues("true"))

    [<Extension>]
    static member inline SetXHAfterSettle(ctx: HttpContext) =
        ctx.Response.Headers.Add("HX-Trigger-After-Settle", StringValues("true"))

    [<Extension>]
    static member inline SetXHRefresh(ctx: HttpContext) =
        ctx.Response.Headers.Add("HX-Refresh", StringValues("true"))

type ScribanViewPaths =
    abstract member ViewPath: string

[<RequireQualifiedAccess>]
module Scriban =
    let fromDiskLoaderWithPath (path: string option) =
        let viewsPath = defaultArg path "Views"

        { new ITemplateLoader with
            member _.GetPath(_, _, templateName) = Path.Combine(viewsPath, templateName)

            member _.Load(_, _, templatePath) = File.ReadAllText templatePath

            member _.LoadAsync(_, _, templatePath) =
                File.ReadAllTextAsync templatePath
                |> ValueTask<string> }

    let fromDiskLoader () = fromDiskLoaderWithPath None

    let defaultViewPaths (path) =
        { new ScribanViewPaths with
            member _.ViewPath = path |> Option.defaultValue "Views" }

    let viewPaths () = defaultViewPaths None


[<Extension>]
type ScribanExtensions =

    /// <summary>
    /// Renders an Scriban template from disk and includes support for the "include" directive
    /// This can help you to include other HTML files
    /// </summary>
    /// <param name="ctx">ASP.NET's HttpContext</param>
    /// <param name="templatePath">The scriban template's relative path to the views directory</param>
    /// <param name="payload">An object to be exposed to the Scriban template's scripting engine</param>
    [<Extension>]
    static member RenderScribanTemplate(ctx: HttpContext, templatePath: string, ?payload: obj) =
        task {
            let loader = ctx.GetService<ITemplateLoader>()
            let defaultViewPaths = ctx.GetService<ScribanViewPaths>()
            let tplContext = TemplateContext()

            let scriptingObj =
                let scriptingObj = ScriptObject()

                match payload with
                | Some model -> scriptingObj.Import(model, filter = null, renamer = null)
                | None -> ()

                scriptingObj

            tplContext.PushGlobal scriptingObj
            tplContext.TemplateLoader <- loader

            let file =
                (defaultViewPaths.ViewPath, templatePath)
                |> Path.Combine
                |> FileInfo

            let! content = File.ReadAllTextAsync file.FullName
            let tpl = Template.Parse(content, file.FullName)

            return! tpl.RenderAsync(tplContext)
        }

    [<Extension>]
    static member inline AddScriban(services: IServiceCollection) =
        services
            .AddSingleton<ScribanViewPaths>(fun _ -> Scriban.viewPaths ())
            .AddSingleton<ITemplateLoader>(fun _ -> Scriban.fromDiskLoader ())

    [<Extension>]
    static member inline AddScriban(services: IServiceCollection, path: string) =
        services
            .AddSingleton<ScribanViewPaths>(fun _ -> Scriban.defaultViewPaths (Some path))
            .AddSingleton<ITemplateLoader>(fun _ -> Scriban.fromDiskLoaderWithPath (Some path))