Computation Expression for handling transaction logic in SQLite

database_txn.fsx

#r "nuget: Microsoft.Data.Sqlite"
#r "nuget: Oxpecker"
#r "nuget: FSharp.Control.TaskSeq"

open Microsoft.Data.Sqlite

open FSharp.Control
open System.Threading.Tasks

type User = { id: int64; name: string }
type Reader<'a> = SqliteDataReader -> TaskSeq<'a>
type OneReader<'a> = SqliteDataReader -> Task<'a option>
type Txn = SqliteTransaction
type Cmd = SqliteCommand

type CmdOneReader<'a> =
  { name: string
    cmd: Cmd
    reader: OneReader<'a> }

let readUser (rd: SqliteDataReader) =
  taskSeq {
    while! rd.ReadAsync() do
      yield
        { id = rd.GetInt64 0
          name = rd.GetString 1 }
  }


let setIdParam (id: int64) (cmd: Cmd) =
  cmd.Parameters.AddWithValue("id", id) |> ignore
  cmd

let selectUserById (id: int64) (txn: Txn) =
  { name = "selectUserById"
    cmd =
      txn.Connection.CreateCommand(CommandText = "SELECT id, name FROM user WHERE id = @id")
      |> setIdParam id
    reader = readUser >> TaskSeq.tryHead }

type Sink<'a> =
  { fail: string -> Task<'a>
    defaultValue: 'a }

type SetDb = SetDb of string

type TxnBuilder<'a>(sink: Sink<'a>) =
  let mutable globalTxn: Txn option = None

  member _.Yield(SetDb dbPath) =
    let connStr = $"Data Source={dbPath};Mode=ReadWrite"

    task {
      try
        let conn = new SqliteConnection(connStr)
        do! conn.OpenAsync()
        let! txn = conn.BeginTransactionAsync()
        globalTxn <- Some(txn :?> Txn)
        return sink.defaultValue
      with :? SqliteException as e ->
        return! sink.fail e.Message
    }



  member _.Bind(cmdr: Txn -> CmdOneReader<'b>, f: 'b -> Task<'a>) =
    task {
      match globalTxn with
      | Some gTxn ->
        let cmdr = cmdr gTxn

        try
          let! q = cmdr.cmd.ExecuteReaderAsync()
          let! r = cmdr.reader q

          return!
            match r with
            | Some v -> f v
            | None -> sink.fail $"expecting to read one in {cmdr.name}, got none"

        with e ->
          do! cmdr.cmd.Transaction.RollbackAsync()
          return! sink.fail e.Message
      | None -> return! sink.fail "transaction is not open"
    }

  member _.Bind(comp: Task<'b>, f: 'b -> Task<'a>) =
    task {
      let! r = comp
      return! f r
    }

  member _.Return x =
    task {
      do! globalTxn |> Option.map (_.CommitAsync()) |> Option.defaultValue (task { () })
      return x
    }

  member _.ReturnFrom(x: Task<'a>) = x

  member _.Zero() = sink.defaultValue

  member _.Combine(x: Task<'a>, y: Task<'a>) =
    task {
      let! _ = x
      return! y
    }

  member _.Delay(f: unit -> Task<'a>) = f ()


let txn sink = TxnBuilder sink

let dummySink =
  { fail = (fun _ -> task { () })
    defaultValue = () }

txn dummySink {
  SetDb "/bla/bla"
  let! x = selectUserById 1
  return ()
}
|> ignore

open Oxpecker.ViewEngine

let sink =
  { fail = fun (e: string) -> task { return div (class' = "box") { $"error  {e}" } }
    defaultValue = div () { "default div" } }

txn sink {
  SetDb "/path/to/db"
  let! r = selectUserById 1
  return div () { $"{r}" }
}