Linuxを日常的に使う実験ブログ

HaskellでDBを操作しよう Beamチュートリアル Part 5

 2024-01-14

 2024-01-24

 プログラミング

今回はBeamチュートリアル第5回目の最終回です。前回までのチュートリアルでデータベースを操作するモデルとデータベースの準備は整いました。さて、今回はデータの挿入、更新、削除を学んでいきましょう。

単純なデータの挿入

まずは単純なデータの挿入をしてみましょう。データベースを操作するHandler.hsファイルを作成します。ここでは新たにカテゴリーを追加してみます。

InsertSample.hs

sample25 :: Connection -> IO ()
sample25 c = do
  u1 <- nextRandom
  u2 <- nextRandom
  tz  <- getZonedTime
  let l = zonedTimeToLocalTime tz
  runBeamPostgresDebug putStrLn c $ runInsert $ insert (categories blogDatabase) $ do
    insertValues [ Category u1 "Linux" "linux" l l
                 , Category u2 "News" "news" l l
                 ]

生成されるSQL

INSERT INTO "categories"
    ("id", "name", "slug", "created_at", "updated_at")
VALUES
    ('4445cc64-b9f5-4396-b272-04a0b547d226'::uuid, 'Linux', 'linux', '2024-01-13 17:15:45.859397567', '2024-01-13 17:15:45.859397567'),
    ('56610e56-c0c8-435b-b5d0-2590eac4e97f'::uuid, 'News', 'news', '2024-01-13 17:15:45.859397567', '2024-01-13 17:15:45.859397567')

注意 : この場合はUUIDをHaskellで生成しているので、毎回同じSQLが生成されるとは限りません。

式と値

データの挿入には「値」を扱う場合と「式」を扱う場合があります。usersテーブルにデータを挿入することを考える場合、すべての値を持ったUserデータを挿入する場合は値として扱います。ここまで見てきたケースはすべて値で扱うケースです。

反対に、一部の情報が欠損した状態でデータを挿入する場合は「式」として扱います。一部の情報が欠損した状態とはどういう状況でしょうか?例えば、idにオートインクリメントでint型で値を入れたい場合やタイムスタンプをデータベース側で入れてほしい場合などです。この場合はデータ挿入時にはHaskell側では値を用意できません。よってその場合はinsertExpressions関数を使って情報が一部欠損したデータを挿入します。具体的には次の項で見ていきましょう。

DBのデフォルト値を使う

データ挿入時にHaskellプログラムですべての値を用意せず、データベースの機能によって値を入れてほしいこともあります。例えば、UUIDの生成やidのオートインクリメントやタイムスタンプなどです。これらのデータベースで用意された関数を使う場合はデータを式(expressions)として挿入します。

まずタグデータの挿入を考えます。前回は日時データとUUIDはHaskellプログラムで生成しましたが、今回はデータベースの機能を使います。以下のコードをご覧ください。tagsテーブルに新たなタグを登録するコードです。

InsertSample.hs

sample26 :: Connection -> IO ()
sample26 c = do
  runBeamPostgresDebug putStrLn c $ runInsert $ insert (tags blogDatabase) $ do
    insertExpressions [ Tag default_ (val_ "Rails") (val_ "rails") default_ default_
                      , Tag default_ (val_ "Erlang") (val_ "erlang") default_ default_
                      , Tag default_ (val_ "LISP") (val_ "lisp") currentTimestamp_ currentTimestamp_
                      ]

生成されるSQL

INSERT INTO "tags"
    ("id", "name", "slug", "created_at", "updated_at")
VALUES
    (DEFAULT, 'Rails', 'rails', DEFAULT, DEFAULT),
    (DEFAULT, 'Erlang', 'erlang', DEFAULT, DEFAULT),
    (DEFAULT, 'LISP', 'lisp', CURRENT_TIMESTAMP, CURRENT_TIMESTAMP)

ポイントとしてはinsertExpressons関数を使うことです。もう一つは値を扱う際にはval_関数で包みます。これによりdefault_currentTimestamp_などの関数を使うことができます。

今回、タイムスタンプの部分ではdefault_currentTimestamp_の二種類で書いてみました。データベースのデフォルト値がnow()関数なので、今回の場合はどちらでもOKということになります。

データ挿入時に値を得る

次にUserテーブルとProfileテーブルにデータを挿入することを考えます。UserテーブルとProfileテーブルは一対一関係のなので、Userデータ挿入と同時にUUDIを取得してProfileデータ挿入に用います。そこでデータ挿入時に値を返す関数runInsertRetruningListを使用します。では実装してみましょう。

runInsertReturningListを使用するにはDatabase.Beam.Backend.SQL.BeamExtensionsをインポートする必要があることに注意して下さい。

InsertSample.hs

sample27 :: Connection -> IO ()
sample27 c =
  runBeamPostgres c $ do
    li <- runInsertReturningList $ insert (users blogDatabase) $ do
      insertExpressions [ User default_ (val_ "mike@example.com") (val_ "Mike") default_ default_
                        ]
    let usr = Prelude.head li 
    runInsert $ insert (profiles blogDatabase) $ do
      insertExpressions [ Profile default_ (val_ $ primaryKey usr) (val_ $ Just "Nagoya") (val_ $ Just "Hello, world") ]

生成されるSQL

INSERT INTO "users"
    ("id", "email", "name", "created_at", "updated_at")
VALUES (DEFAULT, 'mike@example.com', 'Mike', DEFAULT, DEFAULT)
RETURNING "id", "email", "name", "created_at", "updated_at"

INSERT INTO "profiles"
    ("id", "user__id", "location", "message")
VALUES (DEFAULT, '05ef117a-566f-4e1b-be1c-f397b20df8de'::uuid, 'Nagoya', 'Hello, world')

Selectと組み合わせたデータ挿入

ここまででデータ取得の方法を学んできたので、postsテーブルへのデータ挿入が可能となりました。ポストを登録し、タグを紐付けるコードを見てみます。

InsertSample.hs

sample28 :: Connection -> IO ()
sample28 c = do
  runBeamPostgresDebug putStrLn c $ do
    Just u <- getUser "Tora"
    Just ca <- getCategory "web"
    li <- runInsertReturningList $ insert (posts blogDatabase) $ do
      insertExpressions [ Post { postId = default_
                               , postSlug = val_ "sample-post-04"
                               , postTitle = val_ "Sample Post Title 04"
                               , postMarkdown = val_ "## Sample"
                               , postCategory = val_ (primaryKey ca)
                               , postUser = val_ (primaryKey u)
                               , postCreatedAt = default_
                               , postUpdatedAt = default_
                               }
                        ]
    Just t <- runSelectReturningOne $ select $ filter_ (\t -> tagSlug t ==. "haskell") $ all_ (tags blogDatabase)
    runInsert $ insert (posts_tags blogDatabase) $ do
      insertExpressions [ PostTag default_ (val_ $ primaryKey (Prelude.head li)) (val_ $ primaryKey t) ]
  where
    getUser :: Text -> Pg (Maybe User)
    getUser s = runSelectReturningOne $ select $
      filter_ (\u -> userName u ==. val_ s) $ all_ (users blogDatabase)

    getCategory :: Text -> Pg (Maybe Category)
    getCategory s = runSelectReturningOne $ select $
      filter_ (\ca -> categorySlug ca ==. val_ s) $ all_ (categories blogDatabase)

生成されるSQL

SELECT
    "t0"."id" AS "res0", "t0"."email" AS "res1", "t0"."name" AS "res2", "t0"."created_at" AS "res3", "t0"."updated_at" AS "res4"
FROM
    "users" AS "t0"
WHERE
    ("t0"."name") = ('Tora')

SELECT
    "t0"."id" AS "res0", "t0"."name" AS "res1", "t0"."slug" AS "res2", "t0"."created_at" AS "res3", "t0"."updated_at" AS "res4"
FROM
    "categories" AS "t0"
WHERE
    ("t0"."slug") = ('web')

INSERT INTO
    "posts"("id", "slug", "title", "markdown", "user__id", "category__id", "created_at", "updated_at")
VALUES
    (DEFAULT, 'sample-post-04', 'Sample Post Title 04', '## Sample', '6b5e357b-3c4f-424e-acb0-f641067a4bcc'::uuid, '8506d426-b444-4e95-9bac-afb4004ac891'::uuid, DEFAULT, DEFAULT)
RETURNING
    "id", "slug", "title", "markdown", "user__id", "category__id", "created_at", "updated_at"

SELECT
    "t0"."id" AS "res0", "t0"."name" AS "res1", "t0"."slug" AS "res2", "t0"."created_at" AS "res3", "t0"."updated_at" AS "res4"
FROM
    "tags" AS "t0"
WHERE
    ("t0"."slug") = ('haskell')

INSERT INTO
    "posts_tags"("id", "post__id", "tag__id")
VALUES
    (DEFAULT, '1700013b-28b6-475f-9eff-6358bda68dc1'::uuid, 'fea736f7-fd6e-4e8f-8004-a8d02e9a134a'::uuid)

注意すべき点は取得したカテゴリー、ユーザーデータからprimaryKey関数を使ってPrimaryKey型のデータを入れているところです。データが外部キー制約を持つ場合にはこのようにデータを挿入します。もし外部キー制約で接合するデータも新規挿入する場合も、挿入時にモデルを取得し同様に処理できます。

複数フィールドのデータの更新

まずはsave関数を使ったフィールドの更新をしてみましょう。データベースから取得したオブジェクトの各フィールドに手を加えて保存をするという手法です。データベースからのデータ取得はまだ扱っていないですが、雰囲気を感じてもらえれば良いと思います。コードを見てみましょう。

InsertSample.hs

sample29 :: Connection -> IO ()
sample29 c =
  runBeamPostgres c $ do
    Just profile <- runSelectReturningOne $ select $ filter_ (\u -> userName u ==. "Tora") $ all_ (users blogDatabase)
    runUpdate $ save (users blogDatabase) (profile {userEmail = "kijitora@example.com", userName="Kijitora"})

生成されるSQL

SELECT
    "t0"."id" AS "res0", "t0"."email" AS "res1", "t0"."name" AS "res2", "t0"."created_at" AS "res3", "t0"."updated_at" AS "res4"
FROM
    "users" AS "t0"
WHERE
    ("t0"."name") = ('Tora')

UPDATE
    "users"
SET
    "email"='kijitora@example.com', "name"='Kijitora', "created_at"='2023-12-26 05:40:54.389197', "updated_at"='2023-12-26 05:40:54.389197'
WHERE
    ('6b5e357b-3c4f-424e-acb0-f641067a4bcc'::uuid) = ("id")

この手法のメリットは複数のフィールドを更新できることです。しかしデメリットもあります。もし更新に関係しない大きな容量のカラムがあったとしても、そのデータを読み書きすることになります。もし特定のフィールドのみを更新したい場合は後述するupdate関数を使うと良いでしょう。

一つのフィールドの更新

テーブルの一つのフィールドを更新するだけならばもっと簡単に更新することが可能です。Beamにはupdate関数が用意されています。

InsertSample.hs

sample30 :: Connection -> IO ()
sample30 c = do
  runBeamPostgres c $ do
    runUpdate $ update (categories blogDatabase)
                       (\ca -> categoryName ca <-. "Web Tech")
                       (\ca -> categorySlug ca ==. "web")

生成されるSQL

UPDATE "categories" SET "name"='Web Tech' WHERE ("slug") = ('web')

データの削除

データの削除は割と単純です。ここでは先程挿入したカテゴリーデータを一つ削除してみます。以下のように削除します。

sample31 :: Connection -> IO ()
sample31 c = do
  let targetSlug = "misc" :: Text
  runBeamPostgres c $ runDelete $ do
    delete (categories blogDatabase) (\ca -> categorySlug ca ==. val_ targetSlug)

生成されるSQL

DELETE FROM "categories" AS "delete_target" WHERE ("delete_target"."slug") = ('misc')

まとめ

全5回でお送りしたBeamチュートリアルも今回で完結です。多対多などの少し複雑なクエリにも対応できるようにデータ取得に関してはページを割いたつもりです。しかし、やはりBeamの高度な機能については紹介しきれない部分もあり消化不良だった方も多いかと思います。ぜひ公式マニュアルなどをご覧いただきHaskellでアプリケーションを構築する楽しみを味わっていただければと思います。

このチュートリアルでBeamの便利さやパワフルさが少しでも伝わり、使ってみようという方が現れればとても嬉しいです。ご意見や感想などもいただけると幸いです。