F#でDapperを使ったDBアクセス

いよいよマスタ保守画面を追加していきます。DBアクセスにはDapperを使用します。

F#にはType Providerというものがあって、コンパイル時に実際のデータへアクセスしてモデルを構築してしまうという強力な仕組みがあります。
CSVファイル、JSON、XML、HTMLならFSharp.Data、データベースならSQL Providerというものがあります。

本来ならこれを使用するのが筋だと思うのですが、SQL Providerは.NET Coreでもビルドに .NET Frameworkが必要となっています。
F#のDBアクセスでは、他にRezoom.SQLという面白いものもあるのですが、こちらも.NET Frameworkで止まってます。Issueに、full support for type providers in .NET core.を待っているという言葉があります。
どうも、.NET Coreのリフレクション関連で.NET Frameworkから移行しきれていない機能があるように読めるのですが、よくわかりません...。

Type Providerについてはまたいずれどこかで探ってみるとして、今回はDapperで行きます。

Dapperは.NETでは 超 がつくほど有名なMicro ORMなので、よく知らないという方は"Dapper"でググってみるとGoogle先生がこれでもか！と言うほどリストアップしてくれます。

今回追加する画面の仕様

今回追加する画面の仕様は以下の通りです。

• メニューを選択するとDBへアクセスし、一覧画面を表示する
• Typeという項目でフィルタができる
• 新規データを登録できる
• 一覧からデータを選択して編集、保存できる
• 一覧からデータを選択して削除できる
• データベースはSQLiteを使用
• サーバー起動時に初期データの投入を行う
• データベースへの接続文字列はappsettings.jsonから取得する

本ブログのデータベースはPostgresなのですが、今回は手軽にSQLiteで実装します。
データベースへの接続文字列はappsettings.jsonから取得するようにするので、SQLite以外のデータベースを使いたい方は対応するADO.NETプロバイダを導入すれば行けると思います。ADO.NETプロバイダさえ準備できれば、割と簡単に接続できてしまうのがDapperの良いところですね。

Taxonomyマスタは以下のようなモデルになります。レコードで実装します。

/// <summary>
/// TaxonomyTypeの列挙型
/// </summary>
type TaxonomyTypeEnum =
    | Category = 0
    | Tag = 1
    | Series = 2


/// <summary>
/// 投稿記事の分類情報を表します。
/// </summary>
type Taxonomy = {
    /// <summary>
    /// id
    /// </summary>
    Id : int64;

    /// <summary>
    /// 分類タイプ
    /// </summary>
    Type : TaxonomyTypeEnum;

    /// <summary>
    /// 名称
    /// </summary>
    Name : string;

    /// <summary>
    /// カテゴリのアドレスを定義するために使用されるurlスラッグ。
    /// </summary>
    UrlSlug : string;

    /// <summary>
    /// 説明
    /// </summary>
    Description : string option;
}

本ブログはこのテーブルで記事のカテゴライズをしています。
SAFEテンプレート上ではClient側とServer側の両方で使用しますので、Sharedフォルダに配置しています。

TaxonomyテーブルのSQLiteのcreate文は以下です。Idカラムは自動採番されます。

create table if not exists [Taxonomy] (
    [Id] integer primary key autoincrement,
    [Type] integer not null,
    [Name] text not null,
    [UrlSlug] text not null,
    [Description] text null
)

DapperとSystem.Data.Sqliteの導入

DapperとSqliteデータベースプロバイダの追加は以下のコマンドをプロジェクトルートディレクトリで実行します。

.paket\paket.exe add Dapper --group Server --project Server
.paket\paket.exe add System.Data.Sqlite --group Server --project Server

前回の記事で paket.referencesに自動で追加されない！と書いたのですが、--project プロジェクト名を付けることで出来ました！
前回の記事も修正しなきゃ...。

DataAccess.fs

F#でDapperを使うためのラッパー関数をDataAccess.fsというモジュールに定義しています。

module DataAccess

open System
open System.Data
open System.Collections.Generic
open System.Dynamic
open Dapper

// https://stackoverflow.com/questions/42797288/dapper-column-to-f-option-property
type OptionHandler<'T> () =
    inherit SqlMapper.TypeHandler<option<'T>> ()

    override __.SetValue (param, value) =
        let valueOrNull =
            match value with
            | Some x -> box x
            | None   -> null

        param.Value <- valueOrNull

    override __.Parse value =
        if isNull value || value = box DBNull.Value
        then None
        else Some (value :?> 'T)

let addOptionHandlers() =
    // 他にも使用する型があるなら追加する
    SqlMapper.AddTypeHandler(OptionHandler<string>())
    SqlMapper.AddTypeHandler(OptionHandler<int>())
    SqlMapper.AddTypeHandler(OptionHandler<DateTime>())
    SqlMapper.AddTypeHandler(OptionHandler<decimal>())


let private logError work = 
    try
        work()
    with 
    | ex ->
        let name = ex.GetType().Name
        printfn "%s:%s" name ex.Message
        reraise()

// 参考　https://gist.github.com/vbfox/1e9f42f6dcdd9efd6660
let query<'Result> (sql:string) (connection:IDbConnection) : 'Result seq =
    let work() = 
        connection.Query<'Result>(sql)
    work |> logError

let parametrizedQuery<'Result> (sql:string) (param:obj) (connection:IDbConnection) : 'Result seq =
    let work() = 
        connection.Query<'Result>(sql, param)
    work |> logError
   
let mapParametrizedQuery<'Result> (sql:string) (param : Map<string,_>) (connection:IDbConnection) : 'Result seq =
    let expando = ExpandoObject()
    let expandoDictionary = expando :> IDictionary<string,obj>
    for paramValue in param do
        expandoDictionary.Add(paramValue.Key, paramValue.Value :> obj)

    connection |> parametrizedQuery sql expando

let execute (sql:string) (param:_) (connection:IDbConnection) =
    let work() = 
        let response = connection.Execute(sql, param)
        printfn "response:%d" response
        response
    work |> logError

Dapperは System.Data.IDbConnectionに対する拡張メソッドとして、QueryとExecuteが定義されているだけというとてもきれいなAPIになっています。
引数として、SQL文とSQLパラメータを受ける形式になっていて、SQLパラメータはobject型の任意のオブジェクトを受け取ります。
与えられたSQLパラメータオブジェクトのプロパティがSQL文中のパラメータプレースホルダにマッピングされて実行されます。

DataAccess.fsは、ここのコードをベースにしています。
違いはエラーが起きた場合の対処ぐらいです。
mapParametetrizedQueryはF#の連想配列を受ける関数で、内部はExpandoObjectに変換してからDapperを使用しています。
Dapperはobject型のプロパティの他、IDictionaryのKeyもマッピングしてくれます。
今回はパラメータがある場合レコード型を定義して、それをparametrizedQueryに渡して呼び出しています。

パラメータの数を状況によって変動させたいような場合はmapParametetrizedQueryを使用すると良いのではないでしょうか。
これのExecute版は定義していませんが、Executeを使うのはデータ更新の場合であることが多く、パラメータにはモデルそのものを渡すことになるので省略しています。
参考にした先ほどのリンクもそういうことなんだろうなぁと思っています。

F#にはデータが無いという状況を表す Option<'T> という判別共用体がありますが、DataAccess.fsではnullをNoneに変換するための型変換を行なうようにしています。
StackOverFlowのここの記事を参考にしました。
Dapper使用前のどこかで一回、addOptionHandlers()を呼び出すと、null可の項目にnullが入っていた場合、Noneに変換されるようになります。
今回はTaxonomyレコード型のDescriptionを string option （Option<string> と同義） で定義しています。

DbInit.fs (初期データの投入)

DbInit.fsモジュールにて、初期データの投入を行っています。
接続文字列をappsettings.jsonから取得するために、Saturnのapp_configに初期データ投入処理の関数を登録しています。

src\Server\Server.fs

  :
  :
  :
let app = application {
    url ("http://0.0.0.0:" + port.ToString() + "/")
    use_router webApp
    memory_cache
    use_static publicPath
    use_gzip
    app_config DbInit.Initialize
}

run app

app_configに指定できる関数は IApplicationBuilder を引数として受けて IApplicationBuilder を返す関数（F#ではIApplicationBuilder -> IApplicationBuilder と表現します）を指定できます。
このIApplicationBuilderのApplicationServicesプロパティに設定されている IServiceProvider のGetServiceメソッドを使用して IConfiguration オブジェクトをDIコンテナから取得することで設定情報にアクセスすることが出来ます。

src\Server\DbInit.fs

  :
  :
  :
let Initialize (app:IApplicationBuilder) =
    let config = app.ApplicationServices.GetService<IConfiguration>()
    let connectionString = config.GetConnectionString("BlogDb")
    let conn = getConnection connectionString

    // テーブル作成
    conn |> createTaxonomyTable

    match (conn |> existsTaxonomies) with 
    | 0 -> 
        // データ追加
        let records = [
            {Id=0L; Type=TaxonomyTypeEnum.Category; Name=".NET"; UrlSlug="dotnet"; Description=Some ".NET Framework, .NET Core に関する話題が中心です。"}
            {Id=0L; Type=TaxonomyTypeEnum.Category; Name="猫"; UrlSlug="cats"; Description=Some "飼っている２匹の猫の話題が中心です。"}
            {Id=0L; Type=TaxonomyTypeEnum.Tag; Name="ASP.NET Core"; UrlSlug="asp-net-core"; Description=Some "ASP.NET Coreに関する話題です。"}
            {Id=0L; Type=TaxonomyTypeEnum.Tag; Name="nekoni.net"; UrlSlug="create-nekoni-net"; Description=Some "本サイトの開発に関する話題です。"}
            {Id=0L; Type=TaxonomyTypeEnum.Tag; Name="マロ"; UrlSlug="maro"; Description=Some "うちの営業部長。先住猫のマロに関しての話題です。"}
            {Id=0L; Type=TaxonomyTypeEnum.Tag; Name="フク"; UrlSlug="fuku"; Description=Some "しんねりさん。２匹目の猫、フクちゃんに関しての話題です。"}
        ]
        conn |> addTaxonomies records
        app    
    | _ -> app

appsettings.jsonには次のように接続文字列が定義されています。

{
  "Logging": {
    "IncludeScopes": false,
    "LogLevel": {
      "Default": "Warning"
    }
  },
  "ConnectionStrings": {
    "BlogDb": "Data Source=BlogData.db"
  }
}

let connectionString = config.GetConnectionString("BlogDb")の部分でConnectionStringsのBlogDbというキーで参照しています。

Saturnも通常のASP.NET Coreと同様、内部でWebHost.CreateDefaultBuilderを使用してIWebHostBuilderを初期化しているため、appsettings.jsonの内容を読み込むことが出来ます。

Visual Studio 2017で ASP.NET Core WebアプリケーションをF#で作成してみるとわかりますが、F#で作成したStartUpクラスにもちゃんとDIしてくれるんですよね。

Saturnの場合、StartUpクラスのConfigureメソッドと同様の指定がapp_configを使用すれば出来るようです。
指定するのは関数でクラスでは無いのでDIはしてもらえません（ASP.NET CoreのDIはコンストラクタインジェクションのみ）が、上記のようにGetService<'T>メソッドを使用すれば取得出来るというのをここで見つけました。
ありがとう、Samuele Rescaさん＆Google先生。

サーバー側API

Fable.Remotingでクライアントとサーバーのやりとりを実装します。
SAFEテンプレートでcounterサンプルのAPIが定義済みですが、今回追加する画面のAPIと合わせてServicesというフォルダに各画面毎にAPI定義を実装します。

SAFEテンプレートではcounterサンプルのAPIはServer.fsに記載されていますが、これをServer\Services\Counter.fsに移動します。

src\Server\Services\Counter.fs

module Services.Counter

open System.Threading.Tasks

open Microsoft.AspNetCore.Http
open FSharp.Control.Tasks.V2
open Giraffe
open Fable.Remoting.Server
open Fable.Remoting.Giraffe

open Shared

let getInitCounter () : Task<Counter> = task { return 42 }
let apiRoute:(HttpFunc -> HttpContext -> HttpFuncResult)  = 
    let api:ICounterApi = { 
        initialCounter = getInitCounter >> Async.AwaitTask
    }
    Remoting.createApi()
    |> Remoting.withRouteBuilder Route.builder
    |> Remoting.fromValue api
    |> Remoting.buildHttpHandler

apiRouteの定義がFable.Remotingのサーバー側定義となります。
initialCounterという名前で公開していて、実装はgetInitCounter関数を呼び出すというようになっています。
withRouteBuilder関数に指定している Route.builderはShared.fsに定義しているURLを作成する関数です。

今回追加するページ(Taxonomies)のAPI

同様に、今回追加するページ Taxonomies のAPI定義は以下となります。

src\Server\Services\Taxonomies.fs

module Services.Taxonomies

open System.Threading.Tasks

open Microsoft.AspNetCore.Http
open Microsoft.Extensions.DependencyInjection
open FSharp.Control.Tasks.V2
open Giraffe
open Fable.Remoting.Server
open Fable.Remoting.Giraffe

open Shared
open Microsoft.Extensions.Configuration

let getTaxonomies (connectionString:string) (param: GetTaxonomiesParam) :Task<GetTaxonomiesResult> = task {
    return Repository.getTaxonomies connectionString param.taxonomyType param.pagenation
}

let getTaxonomy (connectionString:string) (id:int) = task {
    return Repository.getTaxonomy connectionString id
}

let addNewTaxonomy (connectionString:string) (record:BlogModels.Taxonomy) = task {
    return Repository.addNewTaxonomy connectionString record
}

let updateTaxonomy (connectionString:string) (record:BlogModels.Taxonomy) = task {
    return Repository.updateTaxonomy connectionString record
}

let removeTaxonomy (connectionString:string) (record:BlogModels.Taxonomy) = task {
    return Repository.removeTaxonomy connectionString record
}

let apiRoute:(HttpFunc -> HttpContext -> HttpFuncResult) =
    let getApi (ctx:HttpContext) :ITaxonomyApi = 
        // let config = ctx.RequestServices.GetService(typeof<IConfiguration>) :?> IConfiguration
        let config = ctx.RequestServices.GetService<IConfiguration>();
        let connectionString = config.GetConnectionString("BlogDb")
        printfn "ConnectionString:%s" connectionString
        
        { 
            getTaxonomies = getTaxonomies connectionString >> Async.AwaitTask
            getTaxonomy = getTaxonomy connectionString >> Async.AwaitTask
            addNewTaxonomy = addNewTaxonomy connectionString >> Async.AwaitTask
            updateTaxonomy = updateTaxonomy connectionString >> Async.AwaitTask
            removeTaxonomy = removeTaxonomy connectionString >> Async.AwaitTask
        }

    Remoting.createApi()
    |> Remoting.withRouteBuilder Route.builder
    |> Remoting.fromContext (fun ctx -> getApi ctx)
    |> Remoting.buildHttpHandler

基本的な構造はServer\Services\Counter.fsと同様ですが、注目して欲しいのは、Remoting.createApi()に続くパイプラインの２行目です。

Counterでは

    |> Remoting.fromValue api

となっていたところが、Taxonomiesでは

    |> Remoting.fromContext (fun ctx -> getApi ctx)

となっています。
Remoting.fromValueではAPI定義そのものを指定していましたが、Remoting.fromContextはHttpContextを引数に取る関数を指定します。
TaxonomiesではDBアクセスに接続文字列が必要となるので、HttpContextのRequestServicesプロパティに設定されているIServiceProviderのGetServiceメソッドを使って設定情報を取得しています。DbInit.fsでやった方法と同じですね。
ちなみにコメントアウトされている行の書き方でも取得できますが、型パラメータを指定した下の書き方の方が短くていいですよね。
下の書き方をする場合は、open Microsoft.Extensions.DependencyInjectionをお忘れなく。

TaxonomiesのAPIは一覧取得、idによる一件取得、新規追加、更新、削除の５つのメソッドから成っています。
実際のDBアクセスはRepository.fsというモジュールにまとめてあります。

Repository.fs

module Repository

open System.Data.SQLite
open DataAccess
open Shared
open Shared.BlogModels
open Dapper

module SqliteTypeHandler =
    open Dapper
    type TaxonomyTypeEnumHandler () =
        inherit SqlMapper.TypeHandler<TaxonomyTypeEnum> ()

        override __.SetValue (param, value) =
            param.Value <- value

        override __.Parse value =
            enum<TaxonomyTypeEnum> (value :?> int)

    let addTypeHandlers () =
        SqlMapper.AddTypeHandler(TaxonomyTypeEnumHandler())

let getConnection (connectionString:string) = 
    new SQLiteConnection(connectionString)


let getTaxonomies (connectionString:string) (taxonomyType:TaxonomyTypeEnum option) (page:PagerModel)  =
    let connection = getConnection connectionString

    let sqlWhere = 
        match taxonomyType with
        | None -> ""
        | Some x -> sprintf "where [Type] = %d " (int x)

    let getCount criteria =
        let sql = 
            """
            select count(1) as [cnt]
            from [Taxonomy]
            """
        connection 
        |> query<int64> (sql + criteria) |> Seq.head
    let newPager = {page with allRowsCount = getCount sqlWhere }
    let newCurrent = min newPager.currentPage newPager.LastPage

    let getList criteria =    
        let sql = 
            """
            select *
            from [Taxonomy]
            """
        let sqlOrder = "order by [Id] "
        let sqlLimitAndOffset = sprintf "limit %d offset %d" page.rowsPerPage ((newCurrent - 1L) * page.rowsPerPage)
        connection 
        |> query<Taxonomy> (sql + criteria + sqlOrder + sqlLimitAndOffset)

    { data = getList sqlWhere
      pagenation = {newPager with currentPage = newCurrent} }


type IdParam = { 
    Id : int64;
}
let getTaxonomy (connectionString:string) (id:int64) =
    let connection = getConnection connectionString

    let sql =
        """
        select * from [Taxonomy]
        where [Id] = @Id
        """
    let param = {Id = id}

    connection 
    |> parametrizedQuery<Taxonomy> sql param
    |> Seq.tryHead


let addNewTaxonomy (connectionString:string) (record:Taxonomy) =
    let connection = getConnection connectionString

    let sql = 
        """
        insert into [Taxonomy] (
          [Type] 
         ,[Name]
         ,[UrlSlug]
         ,[Description]
        )
        values (
          @Type 
         ,@Name 
         ,@UrlSlug 
         ,@Description
        )
        """
    connection 
    |> execute sql record

let updateTaxonomy (connectionString:string) (record:Taxonomy) =
    let connection = getConnection connectionString

    let sql = 
        """
        update [Taxonomy] 
        set 
          [Type] = @Type
         ,[Name] = @Name
         ,[UrlSlug] = @UrlSlug
         ,[Description] = @Description
        where [Id] = @Id
        """
    connection 
    |> execute sql record

let removeTaxonomy (connectionString:string) (record:Taxonomy) =
    let connection = getConnection connectionString

    let sql =
        """
        delete from [Taxonomy]
        where [Id] = @Id
        """
    connection 
    |> execute sql record        

一覧取得のgetTaxonomiesだけ、ページング機構を実現するためちょっと複雑になっていますが、他はDataAccess.fsにSQLを投げてるだけの簡単な処理になっていると思います。

最初の方のサブモジュールSqliteTypeHandlerはちょっと特殊な事情なのですが、SqliteのINTEGER型はSystem.Int64になって返ってくることへの対策です。
Taxonomyのモデルを見ていただきたいのですが、Type という項目はTaxonomyTypeEnumという列挙型になっています。

/// <summary>
/// TaxonomyTypeの列挙型
/// </summary>
type TaxonomyTypeEnum =
    | Category = 0
    | Tag = 1
    | Series = 2

本来、Dapperは列挙型で定義した項目にもきれいにマッピングしてくれるのですが、この列挙型はSystem.Int32のためマッピングでエラー(InvalidCastException)になってしまいます。
で、次のようにInt64の列挙型にすればいいのかなと安易に思っていたのですが、

/// <summary>
/// TaxonomyTypeの列挙型
/// </summary>
type TaxonomyTypeEnum =
    | Category = 0L
    | Tag = 1L
    | Series = 2L

なーんと、FableがInt64の列挙型に対応していないんですよねぇ...。TaxonomyモデルはClient側でも使用するのでこれは困りました。
まぁ、実際はこの３値しか取りえないのでInt64である必要も無いのですが...。
SqliteでInt32の型を指定できればいいのですが、それも無理そうなので型変換で対処しました。他のDBならこれは不要かと思います。

Server.fs

// Dapperの初期化。null←→option の変換設定
DataAccess.addOptionHandlers()
// Sqliteの型変換設定
Repository.SqliteTypeHandler.addTypeHandlers()

let publicPath = Path.GetFullPath "../Client/public"
let port = 8085us

let webApp = router {
    forward "/api/ICounterApi" Services.Counter.apiRoute
    forward "/api/ITaxonomyApi" Services.Taxonomies.apiRoute
}

let app = application {
    url ("http://0.0.0.0:" + port.ToString() + "/")
    use_router webApp
    memory_cache
    use_static publicPath
    use_gzip
    app_config DbInit.Initialize
}

run app

頭のopenのあたりは省略しています。

まず、DapperにTypeHandlerの登録を行っています。TypeHandlerの登録はどこか一カ所で行えばOKなのでこのモジュールに書いてあります。

それからルートの定義です。
SAFEテンプレートではこのモジュールに直接Fable.Remotingの定義がしてあり、それをuse_routerに指定してありました。
今回、Fable.RemotingのAPI定義はServicesディレクトリ以下に移動したので、ここでルートを定義してuse_routerに指定という形にしてあります。
見たまんまの感じで、"/api/ICounterApi"という要求が来たら、Fable.Remotingで定義したルートへ流すという感じになります。

うー。Client側の説明もしたかったのですが、ここまででだいぶ長くなってしまったので、次回にしたいと思います。

次回説明分も含め、コードはGitHubのリポジトリをご覧ください。