relational-record を MySQL で使ってみた

[relational-record](https://hackage.haskell.org/package/relational-record)は型安全にSQLを生成できるライブラリで、コンパイルが通れば正しいSQLが生成されます。とても便利そうだったので早速自分のMySQL環境で使ってみようと思ったのですが導入する時にいくつか試行錯誤した点があったのでメモ書きとして残しておきます。

----

[2018/1/1] 本文の内容が古くなっておりそのままでは動かないところがあるようです。最新の方法についてはざぎんさんが以下の記事でまとめてくださっているのでこちらも参照下さい。
[Haskell で relational-record を使って MySQL に繋いでみた](http://na4zagin3.hatenablog.com/entry/2017/12/28/224653)

----

##Stack

以下では

```bash
$ stack new hrr-test
```

のようにプロジェクトを作った前提で進めていきます。まず`relational-record`を入れるために`stack.yaml`と`hrr-test.cabal`を以下のように書き換えます。

```yaml:stack.yaml
resolver: lts-3.11
packages:
- '.'
- location:
    git: git@github.com:bos/hdbc-mysql.git
    commit: d43ea057019ff683f278f36af410f4d3cbc731bc
extra-deps:
- HDBC-2.4.0.1
- HDBC-session-0.1.0.0
- names-th-0.1.0.1
- persistable-record-0.1.0.1
- relational-schemas-0.1.0.2
- sql-words-0.1.3.1
- relational-query-0.6.0.0
- relational-query-HDBC-0.1.0.1
- relational-record-0.1.2.0
```

```:hrr-test.cabal
name:                 hrr-test
version:              0.1.0.0
build-type:           Simple
cabal-version:        >=1.10

executable hrr-test
  main-is:              Main.hs
  other-modules:        DataSource
                      , Fruit
                      , MarketHistory
  build-depends:        base >= 4.7 && < 5
                      , template-haskell
                      , relational-record
                      , relational-query
                      , relational-query-HDBC
                      , HDBC
                      , HDBC-mysql
                      , persistable-record
  hs-source-dirs:       app
                      , src
  default-language:     Haskell2010
```

HDBC-mysql を入れる場合は Hackage からではなくGithubの最新のものをビルドする必要があります（Hackageから直接入れようとするとビルドに失敗します）。

もし`stack build`時に

```
Preprocessing library HDBC-mysql-0.6.6.2...
ld: library not found for -lmysqlclient
clang: error: linker command failed with exit code 1 (use -v to see invocation)
```

このようなエラーが出る場合は MySQL のライブラリが入っているディレクトリを指定してビルドしてください。

```zsh
$ stack build --extra-lib-dirs=/usr/local/lib
```

##DBの準備
`stack build`が無事完了したらDBの方を準備していきます。使うデータはちゅーんさんの[ブログ記事](http://tune.hateblo.jp/entry/2014/06/21/161745)から勝手に拝借して少し変えたものです。`create database tutorial`をしてから以下のSQLを流し込んでください。

```sql:tutorial.sql
DROP TABLE IF EXISTS tutorial.fruit;
CREATE TABLE tutorial.fruit (
  id int primary key,
  name varchar(10) not null,
  price int not null
);

DROP TABLE IF EXISTS tutorial.market_history;
CREATE TABLE tutorial.market_history (
  id int primary key,
  product int not null,
  quantity int not null
);
```

##DataSource.hs
DBの準備が終わったら[Tutorial](http://khibino.github.io/haskell-relational-record/tutorial.html)に倣って`DataSource.hs`を作っていきます。

```hs:src/DataSource.hs
{-# LANGUAGE TemplateHaskell #-}

module DataSource (
    connect
  , convTypes
  , defineTable
) where

import Data.Int (Int32)
import Database.HDBC.Query.TH (defineTableFromDB')
import Database.HDBC.Schema.Driver (typeMap)
import Database.HDBC.MySQL
import Database.HDBC.Schema.MySQL (driverMySQL)
import Database.Record.TH (derivingShow)
import Database.Relational.Query.Component (defaultConfig, normalizedTableName)
import Language.Haskell.TH (Q, Dec, TypeQ)

connect :: IO Connection
connect = connectMySQL defaultMySQLConnectInfo { mysqlDatabase = "INFORMATION_SCHEMA" }

convTypes :: [(String, TypeQ)]
convTypes = [("MEDIUMINT", [t|Int32|])]

defineTable :: String -> Q [Dec]
defineTable tableName =
  defineTableFromDB'
    connect
    (defaultConfig { normalizedTableName = False })
    (driverMySQL { typeMap = convTypes })
    "tutorial"
    tableName
    [derivingShow]
```

HRRがコンパイル時にDBの情報を取得しに行く関係で`connect`にて選択する`mysqlDatabase`は"INFORMATION_SCHEMA"にしています。そのあとSQLを流す対象のDatabaseは`defineTable`の中で指定しています。この時`defineTableFromDB`のデフォルト設定だとテーブル名が全て大文字になってしまうので`normalizedTableName`を`False`にしてこの設定を無効にしています。

あと今のHRRのMySQLのスキーマにはなぜかmediumintの定義が無いので`typeMap`を使って上書きしています。

ここまで出来たら簡単な`Main.hs`を書いて実行してみましょう。

```hs:app/Main.hs
{-# LANGUAGE FlexibleContexts #-}

module Main where

import GHC.Int
import Database.HDBC.Record (runQuery)
import Database.Record (FromSql, ToSql)
import Database.Relational.Query

import DataSource

hello :: Relation () (Int32, String)
hello = relation $ pure (value 0 >< value "Hello")

main :: IO ()
main = do
  conn <- connect
  putStrLn $ "SQL: " ++ show hello
  result <- runQuery conn (relationalQuery hello) ()
  mapM_ print result

```

動きましたか？以上でHRRでMySQLを使う時の手順は終わりです。ですがせっかくここまで環境を作ったのでここからはHRRで遊んでみたいと思います。

##データの準備

まずテーブルに対応するデータ構造をモジュールに分けて定義していきます。

```hs:src/Fruit.hs
{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-}

module Fruit where

import DataSource (defineTable)

$(defineTable "fruit")
```

```hs:src/MarketHistory.hs
{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-}

module MarketHistory where

import DataSource (defineTable)

$(defineTable "market_history")
```

次に`Main.hs`にHRRを使ってデータを挿入するプログラムを書きます。

```hs:app/Main.hs
{-# LANGUAGE FlexibleContexts #-}

module Main where

import GHC.Int
import Database.HDBC (IConnection, SqlValue, commit)
import Database.HDBC.Record (mapInsert)
import Database.Record (FromSql, ToSql)
import Database.Relational.Query

import DataSource
import Fruit (Fruit(..), insertFruit)
import qualified Fruit as Fruit
import MarketHistory (MarketHistory(..), insertMarketHistory)
import qualified MarketHistory as MarketHistory

fruits :: [Fruit]
fruits = map (\(x, y, z) -> Fruit x y z) $
    [ (1, "Apple",     100)
    , (2, "Grape",     200)
    , (3, "Orange",    300)
    , (4, "Banana",    400)
    , (5, "Pineapple", 500)
    ]

marketHistories :: [MarketHistory]
marketHistories = map (\(x, y, z) -> MarketHistory x y z) $
    [ (1,  1, 10)
    , (2,  1, 5)
    , (3,  1, 3)
    , (4,  1, 6)
    , (5,  2, 6)
    , (6,  2, 5)
    , (7,  2, 8)
    , (8,  2, 4)
    , (10, 3, 3)
    , (11, 3, 5)
    , (12, 3, 4)
    , (13, 3, 9)
    , (14, 4, 10)
    , (15, 4, 14)
    , (16, 4, 12)
    , (17, 4, 11)
    , (18, 5, 1)
    , (19, 5, 3)
    , (20, 5, 2)
    , (21, 5, 4)
    ]

main :: IO ()
main = do
  conn <- connect
  mapInsert conn insertFruit fruits
  mapInsert conn insertMarketHistory marketHistories
  commit conn
```

最後に`commit`するのを忘れないようにしましょう。実行してDBにデータが入っているのを確認してみてください。

##遊んでみる

```hs:app/Main.hs
{-# LANGUAGE FlexibleContexts #-}

module Main where

import GHC.Int
import Database.HDBC.Record (runQuery)
import Database.Record (FromSql, ToSql)
import Database.Relational.Query

import DataSource
import Fruit (Fruit(..), fruit)
import qualified Fruit as Fruit
import MarketHistory (MarketHistory(..), marketHistory)
import qualified MarketHistory as MarketHistory

selectHistory :: Relation () (Fruit, MarketHistory)
selectHistory = relation $ do
  f <- query fruit
  m <- query marketHistory
  on $ f ! Fruit.id' .=. m ! MarketHistory.product'
  pure $ (,) |$| f |*| m

main :: IO ()
main = do
  conn <- connect
  result <- runQuery conn (relationalQuery selectHistory) ()
  mapM_ print result
```

##参考
* [Haskell Relational Record](http://khibino.github.io/haskell-relational-record/)
* [Haskell-rerational-recordでDB操作するのが楽しすぎる件〜その１〜](http://tune.hateblo.jp/entry/2014/06/21/161745)
* [haskell-relational-recordとMySQLの識別子の大文字小文字](http://yunomu.hatenablog.jp/entry/2014/02/01/121659)
* [haskell-relational-record-の調査.md](https://github.com/worksap-ate/demo/blob/master/haskell-relational-record-%E3%81%AE%E8%AA%BF%E6%9F%BB.md)