relational-recordは型安全にSQLを生成できるライブラリで、コンパイルが通れば正しいSQLが生成されます。とても便利そうだったので早速自分のMySQL環境で使ってみようと思ったのですが導入する時にいくつか試行錯誤した点があったのでメモ書きとして残しておきます。
[2018/1/1] 本文の内容が古くなっておりそのままでは動かないところがあるようです。最新の方法についてはざぎんさんが以下の記事でまとめてくださっているのでこちらも参照下さい。
Haskell で relational-record を使って MySQL に繋いでみた
Stack
以下では
$ stack new hrr-test
のようにプロジェクトを作った前提で進めていきます。まずrelational-recordを入れるためにstack.yamlとhrr-test.cabalを以下のように書き換えます。
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 のライブラリが入っているディレクトリを指定してビルドしてください。
$ stack build --extra-lib-dirs=/usr/local/lib
DBの準備
stack buildが無事完了したらDBの方を準備していきます。使うデータはちゅーんさんのブログ記事から勝手に拝借して少し変えたものです。create database tutorialをしてから以下の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に倣ってDataSource.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を書いて実行してみましょう。
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で遊んでみたいと思います。
データの準備
まずテーブルに対応するデータ構造をモジュールに分けて定義していきます。
src/Fruit.hs
{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-}
module Fruit where
import DataSource (defineTable)
$(defineTable "fruit")
src/MarketHistory.hs
{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-}
module MarketHistory where
import DataSource (defineTable)
$(defineTable "market_history")
次にMain.hsにHRRを使ってデータを挿入するプログラムを書きます。
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にデータが入っているのを確認してみてください。
遊んでみる
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