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) not null, Age int);
insert Person (Id, Name, Age) values (1, 'hoge', 10);
insert Person (Id, Name, Age) values (2, 'foo', 30);
insert Person (Id, Name, Age) values (3, 'bar', null);

Prelude.fs

module Prelude

open Tranq

(* 年齢に関する判別共用体をカプセル化するモジュール: このモジュールのすべての関数は副作用なし *)
module Age = 
  type T = 
    private 
    | Child of int
    | Adult of int
    | Unknown
  (* int option -> T *)
  let compose = function
    | Some age ->
      if age > 20 then Adult age else Child age
    | _ -> Unknown
  (* int T -> int option *)
  let decompose = function
    | Child age | Adult age -> Some age
    | Unknown -> None
  (* T -> T *)
  let incr age =
    decompose age |> Option.map ((+) 1) |> compose
  (* 判別共用体をアクティブパターンへ変換 *)
  let (|Child|Adult|Unknown|) = function
    | Child age -> Child age
    | Adult age -> Adult age
    | Unknown -> Unknown
  (* IDataConv<T, int option> *)
  let conv = { 
    new IDataConv<T, int option> with
      member this.Compose(v) = compose v
      member this.Decompose(t) = decompose t }

(* 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; }
 
(* DBアクセスのモジュール: このモジュールのすべての関数は副作用あり *)
module Dao =
  (* Tx<Person list> *)
  let all = Db.query<Person> "select * from Person" []
  (* int -> Tx<Person> *)
  let find (id: int) = 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 -> string *)
  let describe person =
    match person.Age with
    | Age.Child _ -> "子供"
    | Age.Adult _ -> "大人"
    | Age.Unknown -> "年齢不詳"
 
(* 業務ロジックとDBアクセスをつなぐモジュール: このモジュールのすべての関数は副作用あり*)
module Service = 
  (* 'a -> Tx<Person> *)
  let updateAge id = txRequired {
    let! person = Dao.find id
    let person =
      person 
      |> Logic.incrAge 
    return! Dao.update person }
  (* Tx<Person list>*)
  let update = txRequired {
    let! person1 = updateAge 1
    let! person2 = updateAge 2
    let! person3 = updateAge 3
    return [person1; person2; person3] }
  (* Tx<string>*)
  let describe = txRequired {
    let! persons = Dao.all
    return persons |> List.map Logic.describe }
 
(* トランザクションの実行 *)
eval Service.update |> function
| Success ret -> printfn "success: %+A\n" ret
| Failure exn -> printfn "failure: %+A\n" exn

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

Program_Output

LOG: select Id, Name, Age from Person where Id = 1
LOG: update Person set Name = N'hoge', Age = 11 where Id = 1
LOG: select Id, Name, Age from Person where Id = 2
LOG: update Person set Name = N'foo', Age = 31 where Id = 2
LOG: select Id, Name, Age from Person where Id = 3
LOG: update Person set Name = N'bar', Age = null where Id = 3
success: [{Id = 1;
  Name = "hoge";
  Age = Child 11;}; {Id = 2;
                     Name = "foo";
                     Age = Adult 31;}; {Id = 3;
                                        Name = "bar";
                                        Age = Unknown;}]

LOG: select * from Person
success: ["子供"; "大人"; "年齢不詳"]