Blogging with F#

git clone https://github.com/ameier38/andrewmeier.dev.git
cd app
docker-compose up -d app

Background

1. Learn how to build a web site,
2. Learn new things by teaching myself topics through the process of writing tutorials, and
3. Help others learn by sharing the posts.

Tools

• F#: Functional programming language for writing succinct, robust and performant code. I chose to write the server in F# because it is my favorite language and I could leverage the existing .NET ecosystem of tools.
• ASP.NET Core: Web framework for .NET core.
• htmx: Library which extends HTML to help build dynamic server side applications. I switched from using React to htmx because it greatly simplifies building the application.
• hyperscript: Front end scripting language which is a companion library to htmx. This library helps build dynamic views with succinct code directly in HTML.
• Tailwind CSS: Utility first CSS framework which makes it easy to build great looking apps. Tailwind UI has a lot of great components for inspiration.
• Notion: Content management tool. It has apps for the desktop, web, and mobile so you can write from anywhere. I am using the Notion SDK for .NET in order to access the content from the Notion API.

Setup

gh repo create andrewmeier.dev
cd andrewmeier.dev

mkdir app
cd app
dotnet new sln -n andrewmeier.dev

dotnet new console -lang F# -n Build -o src/Build
dotnet new console -lang F# -n Server -o src/Server
dotnet new console -lang F# -n Tests -o src/Tests

• Build: FAKE project used to define build tasks. This is not necessary to build and run the application but it is convenient to have all the build tasks defined in one spot.
• Server: ASP.NET project for the web server. This is the main project for the application.
• Tests: UI tests using canopy.

Development

app/src/Server/src
├── Infrastructure.fs
├── Config.fs
├── PostClient.fs
├── ViewEngine.fs
├── PostController.fs
└── Program.fs

namespace global

open System
open System.IO

module Env =

    let variable (key:string) (defaultValue:string) =
        match Environment.GetEnvironmentVariable(key) with
        | s when String.IsNullOrEmpty(s) -> defaultValue
        | s -> s

		// Used for secret values so we can mount in containers when running in Kubernetes
    let secret secretName secretKey defaultEnv defaultValue =
        let secretsDir = variable "SECRETS_DIR" "/var/secrets" 
        let secretPath = Path.Combine(secretsDir, secretName, secretKey)
        if File.Exists(secretPath) then
            File.ReadAllText(secretPath).Trim()
        else
            variable defaultEnv defaultValue
            
[<AutoOpen>]
module ControllerExtensions =
    open Microsoft.AspNetCore.Mvc
    open Microsoft.Extensions.Primitives
    open System.Net.Mime
    
		// You can add extension methods to types with this syntax
    type Controller with
        member this.TryGetRequestHeader(key:string) =
            match this.Request.Headers.TryGetValue(key) with
            | true, value -> Some value
            | false, _ -> None
            
        member this.SetResponseHeader(key:string, value:string) =
            this.Response.Headers.Add(key, StringValues value)

        member this.IsHtmx =
            match this.TryGetRequestHeader("HX-Request") with
            | Some _ -> true
            | None -> false
            
        member this.HxPush(url:string) =
            this.SetResponseHeader("HX-Push", url)
            
        member this.Html(html:string) =
            this.Content(html, MediaTypeNames.Text.Html)

module Server.Config

open System

[<RequireQualifiedAccess>]
type AppEnv =
    | Prod
    | Dev

// Configures the host and port on which the server will listen
type ServerConfig =
    { Url:string }
    static member Load() =
        let host = Env.variable "SERVER_HOST" "0.0.0.0"
        let port = Env.variable "SERVER_PORT" "5000" |> int
        { Url = $"http://{host}:{port}" }

// Configuration needed to connect to Notion   
type NotionConfig =
    { DatabaseId:string
      Token:string }
    static member Load() =
        { DatabaseId = Env.variable "NOTION_DATABASE_ID" ""
          Token = Env.secret "notion" "token" "NOTION_TOKEN" "" }

type Config =
    { AppEnv: AppEnv
      Debug: bool
      ServerConfig: ServerConfig
      NotionConfig:NotionConfig }
    static member Load() =
        { AppEnv = match Env.variable "APP_ENV" "prod" with "prod" -> AppEnv.Prod | _ -> AppEnv.Dev
          Debug = Env.variable "DEBUG" "true" |> Boolean.Parse
          ServerConfig = ServerConfig.Load()
          NotionConfig = NotionConfig.Load() }

type Post =
    { id: string
      permalink: string
      title: string
      summary: string
      icon: string
      iconAlt: string
      cover: string
      tags: string[]
      createdAt: DateTime
      updatedAt: DateTime }
    
type PostDetail =
    { post: Post
      content: IBlock[] }
    
type IPostClient =
    abstract List: unit -> Task<Post[]>
    abstract GetById: pageId:string -> Task<PostDetail option>
    abstract GetByPermalink: permalink:string -> Task<PostDetail option>

type LivePostClient(config:NotionConfig, cache:IMemoryCache) =
    let clientOpts = ClientOptions(AuthToken=config.Token)
    let client = NotionClientFactory.Create(clientOpts)
    
    // Get the page id from the permalink and cache the result
    let getPageId(permalink:string) = task {
        match cache.TryGetValue(permalink) with
        | true, value ->
            let pageId = unbox<string> value
            return Some pageId
        | _ ->
            let filter = TextFilter("permalink", permalink)
            let queryParams = DatabasesQueryParameters(Filter=filter)
            let! res = client.Databases.QueryAsync(config.DatabaseId, queryParams)
            match Seq.tryHead res.Results with
            | Some page ->
                // The cache entry will take up 1/1000 entries.
                // The entries limit is defined in Program.fs when adding the cache.
                let cacheEntryOpts = MemoryCacheEntryOptions(Size=1L)
                let pageId = cache.Set(permalink, page.Id, cacheEntryOpts)
                return Some pageId
            | None ->
                return None
    }
    
    let getPublishedPage (pageId:string) = task {
        let! page = client.Pages.RetrieveAsync(pageId)
        let status = page.Properties |> Props.getSelect "status" ""
        if status = "Published" then
            return Some page
        else
            return None
    }
    
    let listPublishedPages () = task {
        let mutable hasMore = true
        let mutable cursor = null
        let posts = ResizeArray()
        // Filter for pages where the 'status' select field is 'Published'
        let filter = SelectFilter("status", "Published")
        let queryParams = DatabasesQueryParameters(StartCursor=cursor, Filter=filter)
        while hasMore do
            let! res = client.Databases.QueryAsync(config.DatabaseId, queryParams)
            hasMore <- res.HasMore
            cursor <- res.NextCursor
            for page in res.Results do
                posts.Add(page)
        return posts |> Seq.map Post.fromDto |> Seq.toArray
    }
    
    let listBlocks (pageId:string) = task {
        let blocks = ResizeArray()
        let mutable hasMore = true
        let mutable cursor = null
        while hasMore do
            let parameters = BlocksRetrieveChildrenParameters(StartCursor=cursor)
            let! res = client.Blocks.RetrieveChildrenAsync(pageId, parameters)
            hasMore <- res.HasMore
            cursor <- res.NextCursor
            blocks.AddRange(res.Results)
        return blocks.ToArray()
    }
    
    let getPostById (pageId:string) = task {
        match! getPublishedPage pageId with
        | Some page ->
            let post = Post.fromDto page
            let! blocks = listBlocks pageId
            let postDetail = { post = post; content = blocks  }
            return Some postDetail
        | None ->
            return None
    }
    
    let getPostByPermalink (permalink:string) = task {
        match! getPageId permalink with
        | Some pageId ->
            return! getPostById pageId
        | None ->
            return None
    }
    
    interface IPostClient with
        member _.List() = listPublishedPages()
        
        member _.GetById(pageId) = getPostById pageId
        
        member _.GetByPermalink(permalink) = getPostByPermalink(permalink)

module Server.ViewEngine

// ---------------------------
// Default HTML elements
// ---------------------------

[<AutoOpen>]
module HtmlElements =

    // ---------------------------
    // Definition of different HTML content
    //
    // For more info check:
    // - https://developer.mozilla.org/en-US/docs/Web/HTML/Element
    // - https://www.w3.org/TR/html5/syntax.html#void-elements
    // ---------------------------

    type HtmlAttribute =
        | KeyValue of string * string   // e.g., div [ _class "text-xl" ] -> <div class="text-xl"></div>
        | Boolean of string             // e.g., button [ _disabled ] -> <button disabled></button>
        | Children of HtmlElement list  // e.g., div [ p "Hello" ] -> <div><p>Hello</p></div>
        | EmptyAttribute                // No op
        
    and HtmlElement =
        | Element of string * HtmlAttribute list        // e.g., <h1>Hello</h1>
        | VoidElement of string * HtmlAttribute list    // e.g., <br/>
        | TextElement of string                         // Text content
        | EmptyElement                                  // No op


// ---------------------------
// Internal ViewBuilder
// ---------------------------

module private ViewBuilder =
    open System.Text
    
    let inline (+=) (sb:StringBuilder) (s:string) = sb.Append(s)
    let inline (+!) (sb:StringBuilder) (s:string) = sb.Append(s) |> ignore
    
    let encode v = System.Net.WebUtility.HtmlEncode v
    
    let rec buildElement (el:HtmlElement) (sb:StringBuilder) =
        match el with
        | Element (tag, attributes) ->
            sb += "<" +! tag
            let children = ResizeArray()
            for attr in attributes do
                match attr with
                | KeyValue (key, value) -> sb += " " += key += "=\"" += value +! "\""
                | Boolean key -> sb += " " +! key
                | Children elements -> children.AddRange(elements)
                | EmptyAttribute -> ()
            sb +! ">"
            for child in children do buildElement child sb
            sb += "</" += tag +! ">"
        | VoidElement (tag, attributes) ->
            sb += "<" +! tag
            for attr in attributes do
                match attr with
                | KeyValue (key, value) -> sb += " " += key += "=\"" += value +! "\""
                | Boolean key -> sb += " " +! key
                | Children _ -> failwith "void elements cannot have children"
                | EmptyAttribute -> ()
            sb +! ">"
        | TextElement text -> sb +! (encode text)
        | EmptyElement -> ()

// ---------------------------
// Render HTML views
// ---------------------------

[<RequireQualifiedAccess>]
module Render =
    open System.Text
    open ViewBuilder
    
		// Used by htmx for partial views
    let view (html:HtmlElement) =
        let sb = StringBuilder()
        buildElement html sb
        sb.ToString()
        
		// Used for full page loads
    let document (html:HtmlElement) =
        let sb = StringBuilder()
        sb += "<!DOCTYPE html>" +! System.Environment.NewLine
        buildElement html sb
        sb.ToString()

type Html() =
    static member empty = EmptyElement
    static member raw (v:string) = TextElement v
    static member html (attrs:HtmlAttribute list) = Element ("html", attrs)
    static member head (attrs:HtmlAttribute list) = Element ("head", attrs)
    static member title (value:string) = Element ("title", [ Children [ TextElement value ] ])
    static member meta (attrs:HtmlAttribute list) = VoidElement ("meta", attrs)
    static member link (attrs:HtmlAttribute list) = VoidElement ("link", attrs)
    static member script (attrs:HtmlAttribute list) = Element ("script", attrs)
    static member body (attrs:HtmlAttribute list) = Element ("body", attrs)
    static member nav (attrs:HtmlAttribute list) = Element ("nav", attrs)
    static member h1 (attrs:HtmlAttribute list) = Element ("h1", attrs)
    static member h2 (attrs:HtmlAttribute list) = Element ("h2", attrs)
    static member h3 (attrs:HtmlAttribute list) = Element ("h3", attrs)
    static member div (attrs:HtmlAttribute list) = Element ("div", attrs)
    static member _id (v:string) = KeyValue ("id", v)
    static member _class (v:string) = KeyValue ("class", v)
    static member _class (v:string list) = KeyValue ("class", v |> String.concat " ")
    static member _style (v:string) = KeyValue ("style", v)
    static member _children (v:HtmlElement list) = Children v
    static member _children (v:HtmlElement) = Children [ v ]
    static member _children (v:string) = Children [ TextElement v ]

type Svg() =
    static member svg (attrs:HtmlAttribute list) = Element ("svg", attrs)
    static member path (attrs:HtmlAttribute list) = Element ("path", attrs)
    static member circle (attrs:HtmlAttribute list) = Element ("circle", attrs)
    static member _viewBox (v:string) = KeyValue ("viewBox", v)
    static member _width (v:int) = KeyValue ("width", string v)
    static member _height (v:int) = KeyValue ("height", string v)
    static member _fill (v:string) = KeyValue ("fill", v)

type Htmx() =
    static member _hxGet (v:string) = KeyValue ("hx-get", v)
    static member _hxGet (v:string option) = match v with Some v -> KeyValue ("hx-get", v) | None -> EmptyAttribute
    static member _hxPost (v:string) = KeyValue("hx-post", v)
    static member _hxPost (v:string option) = match v with Some v -> KeyValue("hx-post", v) | None -> EmptyAttribute
    static member _hxTrigger (v:string) = KeyValue ("hx-trigger", v)
    static member _hxTarget (v:string) = KeyValue ("hx-target", v)
    static member _hxTarget (v:string option) = match v with Some v -> KeyValue ("hx-target", v) | None -> EmptyAttribute
    
type Hyper() =
    static member _hyper (v:string) = KeyValue ("_", v)

div [
    _id post.permalink
    _class "relative border-b-2 border-gray-200 p-2 cursor-pointer hover:bg-gray-100"
    _hxGet $"/{post.id}"
    _hxTarget "#page"
    _children [
        div [
            _class "flex justify-between"
            _children [
                h3 [
                    _class "text-lg font-medium text-gray-800 mb-2"
                    _children post.title
                ]
                p [
                    _class "text-sm text-gray-500 leading-7"
                    _children (post.updatedAt.ToString("MM/dd/yyyy"))
                ]
            ]
        ]
        p [
            _class "text-sm text-gray-500"
            _children post.summary
        ]
        div [
            _class "loader absolute inset-0 w-full h-full bg-gray-500/25"
            _children [
                div [
                    _class "flex justify-center items-center h-full"
                    _children Spinner.circle
                ]
            ]
        ]
    ]
]

// Specifies that this controller handles the index route (i.e., https://andrewmeier.dev/)
[<Route("")>]
type PostController(client:IPostClient) =
    inherit Controller()
    
    member private this.Render(page:HtmlElement, ?extraMetas:HtmlElement list) =
        let extraMetas = extraMetas |> Option.defaultValue List.empty
        let html =
            if this.IsHtmx then Render.view page
            else page |> Layout.main extraMetas |> Render.document
        this.Html(html)
    
    // No route specified so use the controller route
    [<HttpGet>]
    member this.Index() = task {
        let! posts = client.List()
        let page =
            posts
            |> Array.filter (fun p -> p.permalink <> "about")
            |> Page.postList
        if this.IsHtmx then this.HxPush("/")
        return this.Render(page)
    }
        
    [<Route("404")>]
    [<HttpGet>]
    member this.NotFound() =
        let page = Page.notFound
        if this.IsHtmx then this.HxPush("/404")
        this.Render(page)
        
    // Routes matching post ids, e.g., /<guid>
    [<Route("{postId:guid}")>]
    [<HttpGet>]
    member this.PostById(postId:string) = task {
        match! client.GetById(postId) with
        | Some postDetail ->
            let metas = Page.postTwitterMetas postDetail.post
            let page = Page.postDetail postDetail
            if this.IsHtmx then this.HxPush($"/{postDetail.post.permalink}")
            return this.Render(page, metas)
        | None ->
            let page = Page.notFound
            if this.IsHtmx then this.HxPush("/404")
            return this.Render(page)
    }
    
    // Routes matching permalinks, e.g., /blogging-with-fsharp
    [<Route("{permalink:regex(^[[a-z-]]+$)}")>]
    [<HttpGet>]
    member this.PostByPermalink(permalink:string) = task {
        match! client.GetByPermalink(permalink) with
        | Some postDetail ->
            let metas = Page.postTwitterMetas postDetail.post
            let page = Page.postDetail postDetail
            if this.IsHtmx then this.HxPush($"/{permalink}")
            return this.Render(page, metas)
        | None ->
            let page = Page.notFound
            if this.IsHtmx then this.HxPush("/404")
            return this.Render(page)
    }

div [
    _id post.permalink
    _class "relative border-b-2 border-gray-200 p-2 cursor-pointer hover:bg-gray-100"
    // i.e., when we click this div, make a GET request to /<post-id>
    _hxGet $"/{post.id}"
    // i.e., take the response from the above GET request and replace the element with id 'page'
    _hxTarget "#page"
    _children [
        div [
            _class "flex justify-between"
            _children [
                h3 [
                    _class "text-lg font-medium text-gray-800 mb-2"
                    _children post.title
                ]
                p [
                    _class "text-sm text-gray-500 leading-7"
                    _children (post.updatedAt.ToString("MM/dd/yyyy"))
                ]
            ]
        ]
        p [
            _class "text-sm text-gray-500"
            _children post.summary
        ]
        div [
            _class "loader absolute inset-0 w-full h-full bg-gray-500/25"
            _children [
                div [
                    _class "flex justify-center items-center h-full"
                    _children Spinner.circle
                ]
            ]
        ]
    ]
]

open Microsoft.AspNetCore.Builder
open Microsoft.Extensions.DependencyInjection
open Prometheus
open Server.Config
open Server.PostClient
open Serilog
open Serilog.Events

[<EntryPoint>]
let main _ =
    // Load the config from Config.fs
    let config = Config.Load()
    // Configure the Serilog logger
    let logger = 
        LoggerConfiguration()
            .MinimumLevel.Override("Microsoft.AspNetCore", LogEventLevel.Warning)
            .MinimumLevel.Is(if config.Debug then LogEventLevel.Debug else LogEventLevel.Information)
            .WriteTo.Console()
            .CreateLogger()
    Log.Logger <- logger
    Log.Debug("Debug mode")
    Log.Debug("{Config}", config)
    
    try
        try
            let builder = WebApplication.CreateBuilder()
            builder.Host.UseSerilog() |> ignore
            // Add a memory cache service so we can cache the permalink page ids
            builder.Services.AddMemoryCache(fun opts -> opts.SizeLimit <- 1000L) |> ignore
            // Add the Notion configuration which is a dependency of the Notion client
            builder.Services.AddSingleton<NotionConfig>(config.NotionConfig) |> ignore
            // When testing use the mock post client
            if config.AppEnv = AppEnv.Dev then
                builder.Services.AddSingleton<IPostClient,MockPostClient>() |> ignore
            // Otherwise use the live post client
            else
                builder.Services.AddSingleton<IPostClient,LivePostClient>() |> ignore
            builder.Services.AddControllers() |> ignore
            builder.Services.AddHealthChecks() |> ignore
            
            let app = builder.Build()
            // Serve static files from wwwroot folder
            app.UseStaticFiles() |> ignore
            // User Serilog request logging for cleaner logs
            app.UseSerilogRequestLogging() |> ignore
            // Add controller endpoints
            app.MapControllers() |> ignore
            // Add health check endpoints
            app.MapHealthChecks("/healthz") |> ignore
            // Add Prometheus /metrics endpoint
            app.MapMetrics() |> ignore
            // Run the server on the specified host and port
            app.Run(config.ServerConfig.Url)
            0
        with ex ->
            Log.Error(ex, "Error running server")
            1
    finally
        Log.CloseAndFlush()

Writing

1. There are applications for web, desktop, and mobile so you can write anywhere.
2. You can add metadata as properties to the blog posts
3. There is an API which you can use to fetch the posts and content.
4. It is free up to a certain usage

Conclusion