Tranqを使ってF#の機能を最大限活用する https://github.com/nakamura-to/Tranq

Create.sql

use tempdb;
if exists (select * from dbo.sysobjects where id = object_id(N'Person')) drop table Person;
create table Person (Id int primary key, Name varchar(50), Age int, Height decimal(5,2));
insert Person (Id, Name, Age, Height) values (1, 'hoge', 10, 140.00);
insert Person (Id, Name, Age, Height) values (2, 'foo', 30, 170.00);

Prelude.fs

module Prelude

open Tranq

(* センチメートルを表す測定単位 *)
[<Measure>] type cm

(* 年齢に関する判別共用体をカプセル化するモジュール: このモジュールのすべての関数は副作用なし *)
module Age =
  type T = private Child of int | Adult of int
  let (|Child|Adult|) = function Child x -> Child x | Adult x -> Adult x
  let compose age = if age < 20 then Child age else Adult age
  let decompose (Adult age| Child age) = age
  let conv = { 
    new IDataConv<T, int> with
      member this.Compose(v) = compose v
      member this.Decompose(t) = decompose t }
  let incr = decompose >> (+) 1 >> compose

(* Tranqの設定*)
let private config = 
  let reg = DataConvRegistry()
  reg.Add(Age.conv)
  { Dialect = MsSqlDialect(reg)
    ConnectionProvider = fun () ->
      let connectionString = "Data Source=.\SQLEXPRESS;Initial Catalog=tempdb;Integrated Security=True;" 
      new System.Data.SqlClient.SqlConnection(connectionString) :> System.Data.Common.DbConnection
    Listener = function
      | SqlIssuing(_, stmt) -> printfn "LOG: %s" stmt.FormattedText
      | _ -> () }

(* トランザクションの実行 *)
let eval workflow = Tx.eval config workflow

Program.fs

open Tranq
open Prelude

(* DBのテーブルに対応するPersonレコード *)
type Person = { [<Id>]Id: int; Name: string; Age: Age.T; Height: decimal<cm> }

(* DBアクセスのモジュール: このモジュールのすべての関数は副作用あり *)
module Dao =
  (* 'a -> Tx<Person> *)
  let find id = Db.find<Person> [id]
  (* Person -> Tx<Person> *)
  let update = Db.update<Person>

(* 業務ロジックのモジュール: このモジュールのすべての関数は副作用なし*)
module Logic =
  (* Person -> Person *)
  let incrAge person = 
    { person with Age = Age.incr person.Age}
  (* Person -> Person *)
  let incrHeight person =
    let incr =
      match person.Age with
      | Age.Child age -> 0.1M<cm> * decimal age
      | _ -> 0M<cm>
    { person with Height = person.Height + incr }

(* 業務ロジックとDBアクセスをつなぐモジュール: このモジュールのすべての関数は副作用あり*)
module Service = 
  (* 'a -> Tx<Person> *)
  let updateAgeAndHeight id = txRequired {
    let! person = Dao.find id
    let person =
      person 
      |> Logic.incrAge 
      |> Logic.incrHeight
    return! Dao.update person }
  (* Tx<Person list>*)
  let update = txRequired {
    let! person1 = updateAgeAndHeight 1
    let! person2 = updateAgeAndHeight 2
    return [person1; person2] }

(* トランザクションの実行 *)
eval Service.update |> function
| Success ret -> printfn "success: %+A\n" ret
| Failure exn -> printfn "failure: %+A\n" exn