Help us understand the problem. What is going on with this article?

relational-record を MySQL で使ってみた

More than 1 year has passed since last update.

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


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


Stack

以下では

$ stack new hrr-test

のようにプロジェクトを作った前提で進めていきます。まずrelational-recordを入れるためにstack.yamlhrr-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のデフォルト設定だとテーブル名が全て大文字になってしまうのでnormalizedTableNameFalseにしてこの設定を無効にしています。

あと今の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

参考

Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
Comments
No comments
Sign up for free and join this conversation.
If you already have a Qiita account
Why do not you register as a user and use Qiita more conveniently?
You need to log in to use this function. Qiita can be used more conveniently after logging in.
You seem to be reading articles frequently this month. Qiita can be used more conveniently after logging in.
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
ユーザーは見つかりませんでした