Haskell で relational-record を使って MySQL に繋いでみた
Haskell で SQL を函数型的に構築する方法としては、relational-record(以下、HRR と称す)と opaleye があるようだ。 今回は relational-record を選択してみた。
以下の記事が参考になるが、本稿執筆時点(2017年12月28日)では、少々変更があったり、嵌ったことがあったので、差分を記述する。 qiita.com
インストール
Stack を前提とする。以上のコマンドで、hrr-test なる名のパッケージが作られる。
$ stack new hrr-test
新し目の Stack ではデフォルトで hpack を利用したテンプレートが使われる。HRR は Stackage に登録されているために、package.yaml の dependencies 節に HRR 関連のパッケージを追加するだけでよい。
dependencies: - base >= 4.7 && < 5 # ここより下を追加 # HRR - relational-record - relational-query - relational-query-HDBC - persistable-record # データベース - HDBC - HDBC-mysql # その他必要なパッケージ - template-haskell - time - bytestring
DataSource.hs
DataSource.hs は以下のようになるだろう。
{-# LANGUAGE TemplateHaskell, TypeSynonymInstances #-} module DataSource import Data.ByteString (ByteString) import Data.Time.Clock.POSIX (POSIXTime, posixSecondsToUTCTime) import Data.Time.LocalTime (TimeZone, utcToLocalTime, hoursToTimeZone) import Database.HDBC.Query.TH (defineTableFromDB) import Database.HDBC.MySQL (MySQLConnectInfo, Connection, connectMySQL, defaultMySQLConnectInfo, mysqlUser, mysqlPassword, mysqlDatabase, mysqlHost, mysqlPort) import Database.HDBC.Schema.MySQL (driverMySQL) import Database.HDBC.Schema.Driver (driverConfig, typeMap) import Database.Relational.Config (normalizedTableName, defaultConfig) import Database.Relational.ProjectableClass (ShowConstantTermsSQL(..), showConstantTermsSQL) import Language.Haskell.TH (Q, Dec, TypeQ) connect :: IO Connection connect = connectMySQL defaultMySQLConnectInfo { mysqlHost = "<mysql-host>" , mysqlDatabase = "INFORMATION_SCHEMA" } -- haskell-relational-record-0.1.4.0 には MEDIUMINT の定義はあるが、SET や ENUM はない。 typeMap :: [(String, TypeQ)] typeMap = [ ("SET", [t| ByteString |]) , ("ENUM", [t| ByteString |]) ] defineTable :: String -> String -> Q [Dec] defineTable schemaName tableName = defineTableFromDB connect (driverMySQL { driverConfig = defaultConfig { normalizedTableName = False } , typeMap = typeMap }) schemaName tableName [''Show,] -- データベースとの接続に使うタイムゾーンを指定する必要がある。 dbTimeZone :: TimeZone dbTimeZone = hoursToTimeZone 9 -- relational-query-0.9.4.1 では、ShowConstantTermsSQL POSIXTime のインスタンスが定義されていないため、自分で定義する必要がありそう。 instance ShowConstantTermsSQL POSIXTime where showConstantTermsSQL' = showConstantTermsSQL' . utcToLocalTime dbTimeZone . posixSecondsToUTCTime
Main.hs は以下のようになる。
{-# LANGUAGE FlexibleContexts #-} module Main where import GHC.Int (Int32) import Database.HDBC (disconnect) import Database.HDBC.Record (runQuery') -- Database.Relational.Query は廃用になった import Database.Relational 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 disconnect conn
ここで、遅延評価版の runQuery ではなく runQuery' を使わないと、複数のクエリを発行した際に死ぬことがあるので注意すること。
これですけど、 runQuery が lazy read なのが関係しているかも。lazy read で必要になる度に fetch されるのが気になります。runQuery' にすると改善したりしませんか?
— 日比野 啓 (Kei Hibino) (@khibino) 2017年3月16日
その他嵌った点
COUNT の引数として列を一つ渡すことに気を付けなければならないようだ。
-- これは駄目 numberOfFruitsWrong :: (MonadQualify ConfigureQuery m) => m (Record Flat (Maybe Int64)) numberOfFruitsWrong = queryScalar $ aggregatedUnique (relation $ query fruit) id' count -- こうする numberOfFruits :: (MonadQualify ConfigureQuery m) => m (Record Flat (Maybe Int64)) numberOfFruits = queryScalar $ aggregatedUnique (relation $ query fruit >>= \j -> return (j ! Fruit.id')) id' count