Haskell-rerational-recordでDB操作するのが楽しすぎる件〜その１〜
どーも、いつものちゅーんさんです。
一ヶ月くらい前に、もくもくHaskell会というハッカソンで日比野さん(@khibino)とご一緒したので、 日比野さんの開発したhaskell-rerational-record(以下HRR)というライブラリを（色々教わりまくりつつ）いじいじしていました。 お仕事のちゅーんさんはわりとゴリゴリSQLを書くわけですけど、あの、あれですよ、辛いんです。 もくもく会でも日比野さんと只管愚痴りまくってましたけど、SQLとかね、こんなもの人間の書くものじゃないです。
ね？
そんなわけで、Haskellを用いて如何に苦しまず楽しくRDBと戯れるか、というのが本日のお題です。
HRRの特徴
基本的にはSQLをモナディックに生成するためのライブラリで。 普通のアプリケーションで必要になるようなほとんどのクエリはこれだけで書く事ができます。 HRRには、ざっと次のような特徴があります。
強い静的型付け
他のこの手のライブラリをご存知の型は解ると思いますが、SQLの構文に型を付けるのってものすごい難しいです。
その点HRRは業務で良く書くようなSQLはほぼ型安全に書くことができ、
実行時に構文や型のエラーを悩ます心配はありません。
THによる自動的なデータ型生成
テーブルの定義は、TemplateHaskellによってコンパイル時に自動的にスキーマ情報を読みに行き、
勝手に生成してくれます。
そのため、DB上でテーブル定義が変更され、プログラムとの整合性が取れなくなった場合は、
即座にコンパイルエラーが発生するようになります。
高い再利用性
複雑なSQLを書く場合、同じサブクエリを何度も書かなくてはいけない事が多々あります。 HRRは一度書いたクエリを再利用する事が出来るので、複雑なクエリもDRYを意識しながら効率的に作成して行く事ができます。
HRRのインストールとか
RDBといっても色々ありますが、もともとPostgresをターゲットにしたライブラリなので、Postgresqlが圧倒的に導入が楽です。 いちお、MySQLとかのドライバもあるっぽいですが、インストールにつらみが溜まったので、素直にPostgresqlに乗り換えました。 MySQLに出会って約半年、たいして使わなかったし、未練なんてねーしな！！
で、Postgresqlの環境作りが一通り終わったら、以下のチュートリアルを元にちょこちょこインストール。
Hackageには上がっていないそうなので、githubのリポジトリをcloneしてcabal installするのが基本。
基本的にこの通りにやれば動かせるようになってる・・・はず。
テーブルの準備
CreateしてInsert
まず、練習用に適当なデータを作ってやります。
DROP TABLE TUTORIAL.product; CREATE TABLE TUTORIAL.product ( id int primary key, name varchar(10) not null, price int not null ); INSERT INTO TUTORIAL.product VALUES (1, 'Apple', 100); INSERT INTO TUTORIAL.product VALUES (2, 'Grape', 200); INSERT INTO TUTORIAL.product VALUES (3, 'Orange', 300); INSERT INTO TUTORIAL.product VALUES (4, 'Banana', 400); INSERT INTO TUTORIAL.product VALUES (5, 'Pineapple', 500); DROP TABLE TUTORIAL.marketHistory; CREATE TABLE TUTORIAL.marketHistory ( id int primary key, product int not null, quantity int not null ); INSERT INTO TUTORIAL.marketHistory VALUES (1, 1, 10); INSERT INTO TUTORIAL.marketHistory VALUES (2, 1, 5); INSERT INTO TUTORIAL.marketHistory VALUES (3, 1, 3); INSERT INTO TUTORIAL.marketHistory VALUES (4, 1, 6); INSERT INTO TUTORIAL.marketHistory VALUES (5, 2, 6); INSERT INTO TUTORIAL.marketHistory VALUES (6, 2, 5); INSERT INTO TUTORIAL.marketHistory VALUES (7, 2, 8); INSERT INTO TUTORIAL.marketHistory VALUES (8, 2, 4); INSERT INTO TUTORIAL.marketHistory VALUES (10, 3, 3); INSERT INTO TUTORIAL.marketHistory VALUES (11, 3, 5); INSERT INTO TUTORIAL.marketHistory VALUES (12, 3, 4); INSERT INTO TUTORIAL.marketHistory VALUES (13, 3, 9); INSERT INTO TUTORIAL.marketHistory VALUES (14, 4, 10); INSERT INTO TUTORIAL.marketHistory VALUES (15, 4, 14); INSERT INTO TUTORIAL.marketHistory VALUES (16, 4, 12); INSERT INTO TUTORIAL.marketHistory VALUES (17, 4, 11); INSERT INTO TUTORIAL.marketHistory VALUES (18, 5, 1); INSERT INTO TUTORIAL.marketHistory VALUES (19, 5, 3); INSERT INTO TUTORIAL.marketHistory VALUES (20, 5, 2); INSERT INTO TUTORIAL.marketHistory VALUES (21, 5, 4);
THに型を生成させる
チュートリアルに書かれているのそのまんまです。
フィールドの定義とか書かなくても、コンパイル時に勝手にDBにアクセスしてテーブル情報を持ってきてくれるので、
スキーマ名とテーブル名だけ指定してやればおｋ
productという関数がPreludeに定義されていて、名前が被ってしまうため、 Product.hsではPreludeからShowのみImportしています。
Product.hs
{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} module Product where import Database.HDBC.Query.TH (defineTableFromDB) import Database.HDBC.Schema.PostgreSQL (driverPostgreSQL) import Database.Record.TH (derivingShow) import DataSource (connect) import Prelude (Show) defineTableFromDB connect driverPostgreSQL "TUTORIAL" "product" [derivingShow]
MarketHistory.hs
{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances #-} module MarketHistory where import Database.HDBC.Query.TH (defineTableFromDB) import Database.HDBC.Schema.PostgreSQL (driverPostgreSQL) import Database.Record.TH (derivingShow) import DataSource (connect) defineTableFromDB connect driverPostgreSQL "TUTORIAL" "marketHistory" [derivingShow]
簡単なSelect文を書いてみる
クエリを作成する
基本的な書き方はチュートリアルにもありますし、仕組みを理解してるワケでは無いので、
詳細な説明は割愛します。（実装理解したらそのうち解説記事とか書くかも）
最初は見様見真似でも、モナドの型のあわせ方とかが解っていれば大体コンパイル通せるようになります。
Query.hs
module Query where import Database.Relational.Query import GHC.Int import Product (Product) import qualified Product as P selectProduct :: Relation () Product selectProduct = relation $ query P.product
で、これをShowすると、生成されたSQL文を見る事ができます。
*Query> selectProduct SELECT ALL T0.id AS f0, T0.name AS f1, T0.price AS f2 FROM TUTORIAL.product T0
exsampleとかチュートリアルとか見ると、(><)とかいう演算子(勝手に「女子力演算子」って呼んでる)を使ってSelectしてたりますが、 これは２引数のタプルを構築していくライブラリなので、結果の型がけっこうダサい事になってたりします。
今は(|$|)と(|*|)とかいう演算子を使って良い感じに描けます。(projectable-applicativeとかいうらしい、よく解ってない) 使い方は基本的に普通のApplicativeと同じような感じ。
Query.hs
module Query where import Database.Relational.Query import GHC.Int import Product (Product) import qualified Product as P selectProduct :: Relation () (String, Int32) selectProduct = relation $ do p <- query P.product return $ (,) |$| p ! P.name' |*| p ! P.price'
注意点としては、(!)演算子の左辺を忘れない事と、フィールド名の後ろのアポストロフィー(')を忘れない事。
P.nameやP.priceは、生成されたレコード型のフィールド名として生成されているので、わりとややこしい型エラーになります。
*Query> :t P.name P.name :: Product -> String *Query> :t P.name' P.name' :: Pi Product String
生成されたSQL：
SELECT ALL T0.name AS f0 , T0.price AS f1 FROM TUTORIAL.product T0
作成したクエリを発行する
基本的には先のチュートリアルに書かれていた事そのまんまです。まずDBコネクションを作ってやります。
DataSource.hs
module DataSource(connect) where import Database.HDBC.PostgreSQL (connectPostgreSQL, Connection) connect :: IO Connection connect = connectPostgreSQL "dbname=testdb"
んで、relationQuery関数を使いーの、runQuery関数で作成したクエリを発行します。
DataSource.hs
DataSource.hs init.sql Main.hs Query.hs Product.hs MarketHistory.hs DataSource.hs X module Main where import Database.Relational.Query (relationalQuery) import Database.HDBC.Session (withConnectionIO, handleSqlError') import Database.HDBC.Record.Query (runQuery) import DataSource (connect) import Query main :: IO () main = handleSqlError' $ withConnectionIO connect $ \conn -> do products <- runQuery conn (relationalQuery selectProduct) () mapM_ print products
実行結果：
("Apple",100)
("Grape",200)
("Orange",300)
("Banana",400)
("Pineapple",500)
クエリの結果を任意の型に格納する
次のように独自の型を使って名称と金額をSelectする事を考えた時、この型をHRRで使うためにいくつかの型クラスのインスタンスにする必要があります。
だだ、それを毎回やるのはだいぶ面倒です。
data ProductAmount = ProductAmount String Int32 deriving (Show, Read, Eq, Ord)
そこで以下のTHを使って、必要な型クラスのインスタンスを自動的に導出してやります。
-- import Database.HDBC.Query.TH しておく $(makeRecordPersistableDefault ''ProductAmount)
後は、タプルの時と同じように(|$|)とか(|*|)を使って書いてやればおｋ
selectProduct :: Relation () ProductAmount selectProduct = relation $ do p <- query P.product return $ ProductAmount |$| p ! P.name' |*| p ! P.price'
実行結果：
ProductAmount "Apple" 100 ProductAmount "Grape" 200 ProductAmount "Orange" 300 ProductAmount "Banana" 400 ProductAmount "Pineapple" 500
多相な型で扱いたい場合
ただ現状、上記のTHを使ってインスタンスを導出できるのは、単相な型の場合のみらしいです。
どうやら、kindが合わなかったりとか、型変数の型クラス制約とかの関係で、多相な型からインスタンスを導出するのは難しいもよう。
なので、どーしても多相な型を使いたいんだっ！ という場合は、自力でProductConstructor、FromSql、ToSqlのインスタンスを書いてやる必要があるみたい。
module Query where import Control.Applicative import Database.Record import Database.Record.ToSql import Database.Relational.Query import Database.HDBC (SqlValue) import Database.HDBC.Query.TH import Product (Product) import qualified Product as P import GHC.Int data MyTuple a b c = MyTuple a b c deriving (Show, Read, Eq, Ord) instance ProductConstructor (a -> b -> c -> MyTuple a b c) where productConstructor = MyTuple instance (FromSql SqlValue a, FromSql SqlValue b, FromSql SqlValue c) => FromSql SqlValue (MyTuple a b c) where recordFromSql = MyTuple <$> recordFromSql <*> recordFromSql <*> recordFromSql instance (ToSql SqlValue a, ToSql SqlValue b, ToSql SqlValue c) => ToSql SqlValue (MyTuple a b c) where recordToSql = createRecordToSql (\(MyTuple a b c) -> fromRecord a ++ fromRecord b ++ fromRecord c) selectProduct'' :: Relation () (MyTuple Int32 String Int32) selectProduct'' = relation $ do p <- query P.product return $ MyTuple |$| p ! P.id' |*| p ! P.name' |*| p ! P.price'
実行結果：
MyTuple 1 "Apple" 100 MyTuple 2 "Grape" 200 MyTuple 3 "Orange" 300 MyTuple 4 "Banana" 400 MyTuple 5 "Pineapple" 500
３要素のタプルとか４要素のタプルとか
デフォルトで上記インスタンスになってて欲しいところですが、現状は無いらしい（無くてもどうにでもなりますし）ので、 自分で書く必要がありました。近々実装されるっぽいです。
instance ProductConstructor (a -> b -> c -> (a, b, c)) where productConstructor = (,,) instance (FromSql SqlValue a, FromSql SqlValue b, FromSql SqlValue c) => FromSql SqlValue (a, b, c) where recordFromSql = (,,) <$> recordFromSql <*> recordFromSql <*> recordFromSql instance (ToSql SqlValue a, ToSql SqlValue b, ToSql SqlValue c) => ToSql SqlValue (a, b, c) where recordToSql = createRecordToSql (\(a, b, c) -> fromRecord a ++ fromRecord b ++ fromRecord c) selectProduct' :: Relation () (Int32, String, Int32) selectProduct' = relation $ do p <- query P.product return $ (,,) |$| p ! P.id' |*| p ! P.name' |*| p ! P.price'
JOINは楽ちん
単純に参照しに行くテーブルを増やせば、勝手にJOIN句を生成してくれます。
Monadic join styleと言うらしいです。
selectHistory :: Relation () (Product, MarketHistory) selectHistory = relation $ do p <- query P.product m <- query M.marketHistory return $ (,) |$| p |*| m
生成されたSQL：
SELECT ALL T0.id AS f0 , T0.name AS f1 , T0.price AS f2 , T1.id AS f3 , T1.product AS f4 , T1.quantity AS f5 FROM TUTORIAL.product T0 INNER JOIN TUTORIAL.markethistory T1 ON (0=0)
ON句の書き方
ON句を指定したい場合はon関数を使います。
この時、ONがどのJOIN句にくっつくかは、on関数の書かれた位置によって決まるらしい。
selectHistory :: Relation () (Product, MarketHistory) selectHistory = relation $ do p <- query P.product m <- query M.marketHistory on $ p ! P.id' .=. m ! M.product' return $ (,) |$| p |*| m
生成されたSQL：
SELECT ALL T0.id AS f0 , T0.name AS f1 , T0.price AS f2 , T1.id AS f3 , T1.product AS f4 , T1.quantity AS f5 FROM TUTORIAL.product T0 INNER JOIN TUTORIAL.markethistory T1 ON (T0.id = T1.product)
比較演算子は両側にコロンが付いたものが用意されています。ANDはon演算子を書き連ねていけば良いっぽい。
*Query> :t (.=.)
(.=.)
:: (SqlProjectable p, ProjectableShowSql p) =>
p ft -> p ft -> p (Maybe Bool)
*Query> :t (.<.)
(.<.)
:: (SqlProjectable p, ProjectableShowSql p) =>
p ft -> p ft -> p (Maybe Bool)
*Query> :t (.>.)
(.>.)
:: (SqlProjectable p, ProjectableShowSql p) =>
p ft -> p ft -> p (Maybe Bool)
*Query> :t (.<=.)
(.<=.)
:: (SqlProjectable p, ProjectableShowSql p) =>
p ft -> p ft -> p (Maybe Bool)
*Query> :t (.>=.)
(.>=.)
:: (SqlProjectable p, ProjectableShowSql p) =>
p ft -> p ft -> p (Maybe Bool)
*Query> :t (.<>.)
(.<>.)
:: (SqlProjectable p, ProjectableShowSql p) =>
p ft -> p ft -> p (Maybe Bool)
*Query> :t (.||.)
(.||.)
:: (Data.String.IsString a, SqlProjectable p,
ProjectableShowSql p) =>
p a -> p a -> p a
四則演算とかもありますね。
*Query> :t (.+.)
(.+.)
:: (Num a, SqlProjectable p, ProjectableShowSql p) =>
p a -> p a -> p a
*Query> :t (.-.)
(.-.)
:: (Num a, SqlProjectable p, ProjectableShowSql p) =>
p a -> p a -> p a
*Query> :t (.*.)
(.*.)
:: (Num a, SqlProjectable p, ProjectableShowSql p) =>
p a -> p a -> p a
*Query> :t (./.)
(./.)
:: (Num a, SqlProjectable p, ProjectableShowSql p) =>
p a -> p a -> p a
WHERE句の書き方
WHERE句はwheres関数。 この後さらにJOINしたりとかしようとすると、副問い合わせになるっぽい？
selectHistory :: Relation () (Product, MarketHistory) selectHistory = relation $ do p <- query P.product m <- query M.marketHistory wheres $ p ! P.id' .=. m ! M.product' return $ (,) |$| p |*| m
生成されたSQL：
SELECT ALL T0.id AS f0 , T0.name AS f1 , T0.price AS f2 , T1.id AS f3 , T1.product AS f4 , T1.quantity AS f5 FROM TUTORIAL.product T0 INNER JOIN TUTORIAL.markethistory T1 ON (0=0) WHERE (T0.id = T1.product)
OUTER JOINやLEFT／RIGHT JOINもqueryMaybeとかいうの使って簡単に出来ます、が、まだ試してないのでいずれ記事にします。 あと、もうちょっとSQLっぽく書けるDirect Join Styleなんてのもありますが、こっちはあんまり格好よく無いなーとか思ったので割愛。
Group By句の書き方
GroupBy句を書くと、Select出来る要素が変わってくるため、 とは言っても、ほとんど書き方は同じですし、型推論されるので得にその事を意識する必要は無いです。
data MarketHisoryWithNameGrouped = MarketHisoryWithNameGrouped { mhgProductName :: String , mhgQuantity :: Maybe Int32 } deriving (Show, Read, Eq, Ord) $(makeRecordPersistableDefault ''MarketHisoryWithNameGrouped) selectHistoryGroupBy :: Relation () MarketHisoryWithNameGrouped selectHistoryGroupBy = aggregateRelation $ do --relationの代わりにaggregateRelationを使う --Group元のテーブルをSelect p <- query P.product m <- query M.marketHistory on $ p ! P.id' .=. m ! M.product' --idとnameでGroup化、nameは後ほど使うので束縛 groupBy $ p ! P.id' g <- groupBy $ p ! P.name' --pやmのフィールドは集約関数を適用させないと使えない return $ MarketHisoryWithNameGrouped |$| g |*| sum' (m ! M.quantity')
sum'関数はクエリを記述するために用意された集約関数です。 集約関数には以下のようなものがあります。
*Query> :t sum'
sum'
:: (Num a, SqlProjectable (p ac),
Database.Relational.Query.ProjectableExtended.AggregatedContext
ac) =>
Projection Flat a -> p ac (Maybe a)
*Query> :t sumMaybe
sumMaybe
:: (Num a, SqlProjectable (p ac),
Database.Relational.Query.ProjectableExtended.AggregatedContext
ac) =>
Projection Flat (Maybe a) -> p ac (Maybe a)
*Query> :t avg
avg
:: (Fractional b, Num a, SqlProjectable (p ac),
Database.Relational.Query.ProjectableExtended.AggregatedContext
ac) =>
Projection Flat a -> p ac (Maybe b)
*Query> :t avgMaybe
avgMaybe
:: (Fractional b, Num a, SqlProjectable (p ac),
Database.Relational.Query.ProjectableExtended.AggregatedContext
ac) =>
Projection Flat (Maybe a) -> p ac (Maybe b)
*Query> :t max'
max'
:: (Ord a, SqlProjectable (p ac),
Database.Relational.Query.ProjectableExtended.AggregatedContext
ac) =>
Projection Flat a -> p ac (Maybe a)
*Query> :t maxMaybe
maxMaybe
:: (Ord a, SqlProjectable (p ac),
Database.Relational.Query.ProjectableExtended.AggregatedContext
ac) =>
Projection Flat (Maybe a) -> p ac (Maybe a)
*Query> :t min'
min'
:: (Ord a, SqlProjectable (p ac),
Database.Relational.Query.ProjectableExtended.AggregatedContext
ac) =>
Projection Flat a -> p ac (Maybe a)
*Query> :t minMaybe
minMaybe
:: (Ord a, SqlProjectable (p ac),
Database.Relational.Query.ProjectableExtended.AggregatedContext
ac) =>
Projection Flat (Maybe a) -> p ac (Maybe a)
*Query> :t every
every
:: (SqlProjectable (p ac),
Database.Relational.Query.ProjectableExtended.AggregatedContext
ac) =>
Projection Flat (Maybe Bool) -> p ac (Maybe Bool)
*Query> :t any'
any'
:: (SqlProjectable (p ac),
Database.Relational.Query.ProjectableExtended.AggregatedContext
ac) =>
Projection Flat (Maybe Bool) -> p ac (Maybe Bool)
*Query> :t some'
some'
:: (SqlProjectable (p ac),
Database.Relational.Query.ProjectableExtended.AggregatedContext
ac) =>
Projection Flat (Maybe Bool) -> p ac (Maybe Bool)
そして、このクエリをShowすると、以下のようなSQLを得る事ができます。
生成されたSQL：
SELECT ALL T0.name AS f0 , SUM (T1.quantity) AS f1 FROM TUTORIAL.product T0 INNER JOIN TUTORIAL.markethistory T1 ON (T0.id = T1.product) GROUP BY T0.id , T0.name
また、今回のクエリの場合、Productテーブルを基底に集約されれば良いので、次のような書き方をする事も出来ます。
selectHistoryGroupBy :: Relation () MarketHisoryWithNameGrouped selectHistoryGroupBy = aggregateRelation $ do p <- query P.product m <- query M.marketHistory on $ p ! P.id' .=. m ! M.product' g <- groupBy p return $ MarketHisoryWithNameGrouped |$| g ! P.name' |*| sum' (m ! M.quantity')
生成されたSQL：
SELECT ALL T0.name AS f0 , SUM (T1.quantity) AS f1 FROM TUTORIAL.product T0 INNER JOIN TUTORIAL.markethistory T1 ON (T0.id = T1.product) GROUP BY T0.id , T0.name , T0.price
複数のクエリを組み合わせる
以上、HRRによってSELECT文を書く方法を紹介してきました。 ここまでだと単なる型安全なクエリの記法（といっても、型安全である事がとても大きいのですが）ですが、 複数のクエリを組み合わせる事ができるのは、ただのSQLにはないHRRの強みです。
ここでは、先程作ったproductテーブルとmarketHistoryテーブルを結合するクエリを、 再利用する事を考えてみましょう。
selectHistory :: Relation () (Product, MarketHistory) selectHistory = relation $ do p <- query P.product m <- query M.marketHistory on $ p ! P.id' .=. m ! M.product' return $ (,) |$| p |*| m
先程から、テーブルを指定する際にquery関数を使用しています。 この関数はRelation型を引数に取る関数です。
*Query> :t query
query
:: Database.Relational.Query.Monad.Class.MonadQualify
ConfigureQuery m =>
Relation () r -> m (Projection Flat r)
もう分かりますね、作成したクエリはRelation型になっているためquery関数によって、 一度作成したクエリを使用する事ができます。
selectHistoryGroupBy'' :: Relation () MarketHisoryWithNameGrouped selectHistoryGroupBy'' = aggregateRelation $ do sh <- query selectHistory' g <- groupBy $ sh ! fst' return $ MarketHisoryWithNameGrouped |$| g ! P.name' |*| sum' (sh ! snd' ! M.quantity')
生成されたSQL：
SELECT ALL T2.f1 AS f0 , SUM (T2.f5) AS f1 FROM (SELECT ALL T0.id AS f0 , T0.name AS f1 , T0.price AS f2 , T1.id AS f3 , T1.product AS f4 , T1.quantity AS f5 FROM TUTORIAL.product T0 INNER JOIN TUTORIAL.markethistory T1 ON (T0.id = T1.product) ) T2 GROUP BY T2.f0 , T2.f1 , T2.f2
この記事を読んでる皆さんならお分かり頂けるかと思いますが、 このような書き方が出来るのが、HRRのシンプルながら強力な所です。
DRYを意識して上手く部品化しながら組み合わせる事によって、 ただのSQLではメンテナンスが困難になってしまうほど複雑なクエリも、 体系的に解りやすく記述する事ができるわけです。
まとめ
というわけで、今回は、
- HRRの特徴
- 入手方法
- SELECT文の書き方
- クエリの再利用
等を紹介してきました。 次回（いつになるかわかりませんが・・・）は、INSERT文やUPDATE文、Null許容なフィールドの扱い等について、 （調べつつｗ）書いていこうかと思います。
いじょ
