DotEnv.fs

[<RequireQualifiedAccess>]
module DotEnv =
    open System
    open System.IO

    let private parseLine (line: string) =
        let splitCount = 2

        match line.Split('=', splitCount, StringSplitOptions.RemoveEmptyEntries) with
        | args when args.Length = splitCount -> Environment.SetEnvironmentVariable(args.[0], args.[1])
        | _ -> ()

    let private load =
        lazy
            (let filePath = Path.Combine(Directory.GetCurrentDirectory(), ".env")

             filePath
             |> File.Exists
             |> function
                 | false -> ()
                 | true -> filePath |> File.ReadAllLines |> Seq.iter parseLine)

    let init () = load.Force()

Extensions.fs

namespace Extensions

[<RequireQualifiedAccess>]
type AsyncMsg<'a> =
    | Started
    | Completed of 'a

[<RequireQualifiedAccess>]
type Deferred<'a> =
    | HasNotStartedYet
    | InProgress
    | Resolved of 'a

[<RequireQualifiedAccess>]
module Deferred =

    let map (transform: 'a -> 'b) (deferred: Deferred<'a>) : Deferred<'b> =
        match deferred with
        | Deferred.HasNotStartedYet -> Deferred.HasNotStartedYet
        | Deferred.InProgress -> Deferred.InProgress
        | Deferred.Resolved value -> Deferred.Resolved(transform value)

    let bind (transform: 'a -> Deferred<'b>) (deferred: Deferred<'a>) : Deferred<'b> =
        match deferred with
        | Deferred.HasNotStartedYet -> Deferred.HasNotStartedYet
        | Deferred.InProgress -> Deferred.InProgress
        | Deferred.Resolved value -> transform value

    let iter (action: 'a -> unit) (deferred: Deferred<'a>) : unit =
        match deferred with
        | Deferred.HasNotStartedYet -> ()
        | Deferred.InProgress -> ()
        | Deferred.Resolved value -> action value

    let resolved deferred : bool =
        match deferred with
        | Deferred.HasNotStartedYet -> false
        | Deferred.InProgress -> false
        | Deferred.Resolved _ -> true

    let exists (predicate: 'a -> bool) deferred : bool =
        match deferred with
        | Deferred.HasNotStartedYet -> false
        | Deferred.InProgress -> false
        | Deferred.Resolved value -> predicate value

[<RequireQualifiedAccess>]
module Config =
    open Fable.Core

    [<Emit("process.env[$0] ? process.env[$0] : ''")>]
    let variable (key: string) : string = jsNative

[<RequireQualifiedAccess>]
module StaticFile =
    open Fable.Core.JsInterop

    let inline import (relativePath: string) : string = importDefault relativePath

PrimitiveTypes.fs

namespace PrimitiveTypes

open System

[<RequireQualifiedAccess>]
module Boolean =

    let fromString (value: string) =
        match bool.TryParse value with
        | true, boolean -> Some boolean
        | _ -> None

[<RequireQualifiedAccess>]
module DateTime =

    let fromString (value: string) =
        match DateTime.TryParse value with
        | true, parsedValue -> Some parsedValue
        | _ -> None

[<RequireQualifiedAccess>]
module DateTimeOffset =

    let fromString (value: string) =
        match DateTimeOffset.TryParse value with
        | true, parsedValue -> Some parsedValue
        | _ -> None

[<RequireQualifiedAccess>]
module Decimal =

    let fromString (value: string) =
        match Decimal.TryParse value with
        | true, parsedValue -> Some parsedValue
        | _ -> None

[<RequireQualifiedAccess>]
module Guid =

    let fromString (value: string) =
        match Guid.TryParse value with
        | true, parsedValue -> Some parsedValue
        | _ -> None

    let toOptionIfEmpty value =
        if value = Guid.Empty then None else Some value

    let toNullableIfEmpty value =
        if value = Guid.Empty then
            Nullable<Guid>()
        else
            Nullable value

[<RequireQualifiedAccess>]
module Int32 =

    let fromString (value: string) =
        match Int32.TryParse value with
        | true, parsedValue -> Some parsedValue
        | _ -> None

[<RequireQualifiedAccess>]
module Int64 =

    let fromString (value: string) =
        match Int64.TryParse value with
        | true, parsedValue -> Some parsedValue
        | _ -> None

[<RequireQualifiedAccess>]
module String =

    let isNotNullOrWhiteSpace = String.IsNullOrWhiteSpace >> not

    let toNullIfEmpty value =
        if String.IsNullOrWhiteSpace value then null else value

    let toUpper (value: string) = value.ToUpper()

    let toLower (value: string) = value.ToLower()

    let trim (value: string) = value.Trim()

    let toQueryString (query: (string * string) list) =
        String.Join("&", query |> List.map (fun (key, value) -> $"{key}={value}"))

    let toOptionIfEmpty (value: string) =
        if String.IsNullOrWhiteSpace value then
            None
        else
            value.Trim() |> Some

    let capitalize (value: string) =
        let character = value.[0]
        let letter = character.ToString().ToUpper()

        let pascalCased = letter + value.Substring(1)

        pascalCased

Tracers.fs

[<RequireQualifiedAccess>]
module Tracers

open System
open Fable.Core

let getMsgNameAndFields (t: Type) (x: 'Msg) : string * obj =
    let rec getCaseName (t: Type) (acc: string list) (x: obj) =
        let caseName = Reflection.getCaseName x

        let uci =
            FSharp.Reflection.FSharpType.GetUnionCases(t)
            |> Array.find (fun uci -> uci.Name = caseName)

        let acc = (Reflection.getCaseName x) :: acc
        let fields = Reflection.getCaseFields x

        if fields.Length = 1 && Reflection.isUnion fields.[0] then
            getCaseName (uci.GetFields().[0].PropertyType) acc fields.[0]
        else
            // Case names are intentionally left reverted so we see
            // the most meaningful message first
            let msgName = acc |> String.concat "/"

            let fields =
                (uci.GetFields(), fields)
                ||> Array.zip
                |> Array.map (fun (fi, v) -> fi.Name, v)
                |> JsInterop.createObj

            msgName, fields

    if Reflection.isUnion x then
        getCaseName t [] x
    else
        "Msg", box x

/// Use it when initializing your Elmish app like this
/// |> Program.withTrace Tracers.console
let inline console (msg: 'Msg) (state: 'State) =
    let msg, fields = getMsgNameAndFields typeof<'Msg> msg
    JS.console.log (msg, fields, state)