💻
HaskellのPostgresQLドライバhasqlのサンプルコード
hasqlとは
hasqlとは柔軟なマッピング API を備えた効率的な PostgreSQL ドライバです。
ORM と異なり、SQL を書くのが特徴です。
また、最近の ORM にはトランザクションやコネクションプールを扱う機能が含まれていますが、hasql 単体には含まれていません。hasql は、hasql というエコシステムのうちのコアライブラリであり、トランザクションやコネクションプールに関する機能は別ライブラリに切り出されています。
本記事ではhasql エコシステムのうち以下のライブラリを使用します。（説明はライブラリより引用）
- hasql
- the root of the ecosystem, which provides the essential abstraction over the PostgreSQL client functionality and mapping of values. Everything else revolves around that library.
- hasql-pool
- a Hasql-specialized abstraction over the connection pool.
- hasql-th
- Template Haskell utilities, providing compile-time syntax checking and easy statement declaration.
- hasql-transaction
- an STM-inspired composable abstraction over database transactions providing automated conflict resolution.
hasql の主なデータ型の紹介
- Pool
- コネクションプールを表現する型
- Statement params queryResult
- 発行したい単一のクエリを表現する型
- Session queryResult
- 実行予定のクエリを表現する型
- Monad のインスタンスなので複数クエリを合成できる
- Transaction queryResult
- 実行予定のトランザクションを表現する型
- Monad のインスタンスなので複数クエリを合成できる
準備
以下の sql で事前にテーブルを作成し、一件以上データを登録しておきます。
CREATE TABLE Person (
person_id VARCHAR(26) PRIMARY KEY,
full_name VARCHAR(50),
age Int
);
以下のように Person 型を定義します。
data Person = Person
{ personId :: Text
, age :: Int
, fullName :: Text
}
deriving (Show)
module を import しておきます。
import Data.Maybe
import Data.Profunctor
import Data.Text
import Data.Time
import Data.Vector qualified as Vec
import Data.Word
import Hasql.Connection (settings)
import Hasql.Pool qualified as HasqlPool
import Hasql.Session qualified as HasqlSession
import Hasql.TH qualified as HasqlTh
import Hasql.Transaction qualified as Tx
import Hasql.Transaction.Sessions qualified as Txs
import System.Environment (getEnv)
import System.Posix.Env.ByteString qualified as PEB
以下のようにコネクションプールを作成する関数を用意します。
事前に環境変数を設定しておいてください。
getPool :: IO HasqlPool.Pool
getPool = do
host <- getEnv' "HOST"
port <- read @Word16 <$> getEnv "POSTGRES_PORT"
user <- getEnv' "PGUSER"
password <- getEnv' "PGPASSWORD"
database <- getEnv' "PGDATABASE"
poolSize <- read @Int <$> getEnv "CONNECTION_POOL_SIZE"
lifetime <- read @Integer <$> getEnv "MAXIMAL_CONNECTION_LIFETIME"
idletime <- read @Integer <$> getEnv "MAXIMAL_CONNECTION_IDLE_TIME"
HasqlPool.acquire poolSize (secondsToDiffTime lifetime) (secondsToDiffTime idletime) $ settings host port user password database
where
getEnv' s = fromMaybe (error "does not exist (no environment variable)") <$> PEB.getEnv s
サンプルコード
exec :: IO () という関数を用意して、これを修正しながら repl でリロードしてコードを試してください。
データを一件取得
findOne :: Text -> HasqlSession.Session (Maybe Person)
findOne t = HasqlSession.statement t $ rmap (fmap decode) query
where
query =
[HasqlTh.maybeStatement|
select
person_id :: text
,full_name :: text
, age :: int4
from person
where person_id = $1 :: text
|]
decode (personId, fullName, age) = Person{age = fromIntegral age, ..}
exec :: IO ()
exec = do
pool <- getPool
result <- HasqlPool.use pool $ findOne "事前に用意したデータのperson_id"
print result
データを複数件取得
findMany :: [Text] -> HasqlSession.Session (Vec.Vector Person)
findMany ids = HasqlSession.statement ids $ dimap Vec.fromList (fmap decode) query
where
query =
[HasqlTh.vectorStatement|
select
person_id :: text
,full_name :: text
, age :: int4
from person
where person_id = any($1 :: text[])
|]
decode (personId, fullName, age) = Person{age = fromIntegral age, ..}
exec :: IO ()
exec = do
pool <- getPool
result <- HasqlPool.use pool $ findMany ["事前に用意したデータのperson_id"]
print result
hasql には where in の構文がないため、where person_id = any($1 :: text[])の箇所がwhere person_id in (a, b, .., z)の役割を果たしています。
データを複数件挿入
createMany :: [Person] -> HasqlSession.Session ()
createMany ps = HasqlSession.statement ps $ lmap encode query
where
query =
[HasqlTh.resultlessStatement|
insert into
person (person_id, age, full_name)
select * from unnest($1 :: text[], $2 :: int4[], $3 :: text[] )
|]
encode = foldl (\(a, b, c) Person{..} -> (Vec.snoc a personId, Vec.snoc b (fromIntegral age), Vec.snoc c fullName)) mempty
exec :: IO ()
exec = do
pool <- getPool
result <- HasqlPool.use pool $ createMany []
print result
データを複数件更新
updateMany :: [Person] -> HasqlSession.Session ()
updateMany ps = HasqlSession.statement ps $ lmap encode query
where
query =
[HasqlTh.resultlessStatement|
update person set
person_id = newdata.person_id,
age = newdata.age,
full_name = newdata.full_name
from (select unnest($1 :: text[]) person_id, unnest($2 :: int4[]) age,unnest($3 :: text[]) full_name) newdata
where
person.person_id = newdata.person_id
|]
encode = foldl (\(a, b, c) Person{..} -> (Vec.snoc a personId, Vec.snoc b (fromIntegral age), Vec.snoc c fullName)) mempty
exec :: IO ()
exec = do
pool <- getPool
result <- HasqlPool.use pool $ updateMany []
print result
データを複数件アップサート
upsertMany :: [Person] -> HasqlSession.Session ()
upsertMany ps = HasqlSession.statement ps $ lmap encode query
where
query =
[HasqlTh.resultlessStatement|
insert into
person (person_id, age, full_name)
select * from unnest($1 :: text[], $2 :: int4[], $3 :: text[] )
on conflict (person_id) do update
set
person_id = excluded.person_id,
age = excluded.age,
full_name = excluded.full_name
|]
encode = foldl (\(a, b, c) Person{..} -> (Vec.snoc a personId, Vec.snoc b (fromIntegral age), Vec.snoc c fullName)) mempty
exec :: IO ()
exec = do
pool <- getPool
result <- HasqlPool.use pool $ upsertMany []
print result
トランザクション使用例
upsertMany' :: [Person] -> Tx.Transaction ()
upsertMany' ps = Tx.statement ps $ lmap encode query
where
query =
[HasqlTh.resultlessStatement|
insert into
person (person_id, age, full_name)
select * from unnest($1 :: text[], $2 :: int4[], $3 :: text[] )
on conflict (person_id) do update
set
person_id = excluded.person_id,
age = excluded.age,
full_name = excluded.full_name
|]
encode = foldl (\(a, b, c) Person{..} -> (Vec.snoc a personId, Vec.snoc b (fromIntegral age), Vec.snoc c fullName)) mempty
exec :: IO ()
exec = do
pool <- getPool
result <- HasqlPool.use pool $ Txs.transaction Txs.RepeatableRead Txs.Write do
upsertMany' []
upsertMany' []
upsertMany' []
print result
Discussion