Haskell製のデータベースライブラリで使い勝手の良いものがないかと探していたのですが、Beamというツールを試してみた結果なかなか使い勝手が良かったのでチュートリアル書いてみました。この記事がBeamを知るきっかけになれば幸いです。

今回のPart 1としてモデルの生成とデータベースの定義について扱います。尚、このチュートリアルではDBとしてPostgreSQLを使います。

Beamについて

BeamはHaskell用のRDBインターフェースライブラリでありORMのように使うことができます。Beamの競合ライブラリとしてはPersistentなどがあります。しかしPersistentはTemplate Haskellを使用しています。

Beamの開発者はYesodで採用されているPersistentのEsqueletoの簡便性に注目しながらも、EsqueletoがTemplate Haskellを使用していることでコンパイルに時間がかかることや初心者にとってコードの見通しが悪くなることを欠点として捉え、Template Hakellを使用せず、高機能なRDB用のインターフェースの開発を始めました。Template Haskellの代わりにDeriveGeneric、DeriveDataTypeable、TypeFamilies、MultiParamTypeClassesなどの言語拡張を用いて、「よりHaskellらしい」型安全性を確保しています。(参考：travis.athougies.net)

今回のチュートリアルではBeamの全機能を紹介することはできませんので、公式ユーザーガイドにも目を通すと理解が深まると思います。

このチュートリアルの対象者

HaskellでWebアプリを作りたいと考えている方、Haskell製のスマートなRDBインターフェースライブラリを探している方に読んでいただきたいと思っています。技術的にはHaskellの基本文法が頭に入っていることが望ましいです。またRDBに関する基本的なCRUD操作についても一通り理解が必要です。特にPostgreSQLを使った経験は必要かと思います。

このチュートリアルのゴール

Beamの機能は多岐に渡るのですべてを紹介することはできません。本チュートリアルでは一対一、一対多、多対多の関連テーブルにおいて基本的なCRUD操作が出来るようにすることをゴールとします。更に複雑なケースについては冒頭で紹介したガイドを参照下さい。

チュートリアルで使うサンプルソースコード

このチュートリアルで取り上げるサンプルコードはGithubにあります。全てのサンプルコードはコマンドで実行可能ですので、実際に動かしてみる参考にしてみて下さい。

データベースの準備

まず今回のチュートリアルを行っていくにあたってのデータベースを準備していきましょう。今回はPostgreSQLを使っていきます。尚、以下コマンドのDBのユーザーネームとDBネームはサンプルですのでお好みの名前に変えて下さい。

psql -U postgres postgres

psql内で以下コマンドでユーザーを作成します。

create user beamuser createdb login password '{password}';

データベースの作成

新しく作ったユーザーでデータベースにアクセスして以下を実行しデータベースを作成します。

CREATE DATABASE beam;

テーブルの作成

では作成したデータベースにアクセスしてテーブルを作成していきましょう。githubにはテーブル作成用のSQLを用意しています。以下のSQL文を発行して必要なテーブルを作成します。

psql -U beamuser beam < migrations/0001_craete_user_table.sql

各テーブルのER図は以下に示します。シンプルなブログを作るためのテーブル構成です。

プロジェクトの作成

Haskellプロジェクトを作るツールとしてはCabalとStackがありますが、今回はStackを利用しましょう。

stack new beam-tutorial

モデルの生成

Beamにおけるモデルの生成は少々独特ですが、慣れてしまえばルーチン作業となります。では早速Userモデルを作ってみましょう。まずはusersテーブルに関するモデルについて見ていきましょう。

Schema.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}

module DB.Model.User
where

import Database.Beam
import Data.Text
import Data.UUID
import Data.Aeson
import Data.Time

data UserT f
  = User
    { userId        :: C f UUID
    , userEmail     :: C f Text
    , userName      :: C f Text
    , userPassword  :: C f Text
    , userCreatedAt :: C f LocalTime
    , userUpdatedAt :: C f LocalTime
    } deriving Generic

type User = UserT Identity
type UserId = PrimaryKey UserT Identity

deriving instance Show User
deriving instance ToJSON User

instance Beamable UserT
instance Table UserT where
  data PrimaryKey UserT f = UserId (Columnar f UUID) deriving (Generic, Beamable)
  primaryKey = UserId . userId

注目すべきポイントとしてはUserT fの各フィールドの型がColumnar f aになっていることです。このfにIdentity型を入れたUser型を定義することで、通常のHaskellで定義するUser型のように振る舞えるになります。

各データ型はBeamableとTableクラスのインスタンスとする必要があります。Tableクラスでは主キーを表すデータ型と主キーを返すprimaryKey関数を定義します。

言語にHaskell2010を使う場合は以下の言語拡張を使用することになります。もしGHC2021を使用する場合は標準で使用可能になってる言語拡張が多い分手動で有効にするのは少なくて済みます。

次に外部キーをもつモデルを作ってみましょう。profilesテーブルはusersテーブルと1対1の関係にあるので、ユーザーIDで外部キー制約を持っています。Profileモデルは以下のようになります。

data ProfileT f
  = Profile
    { profileId        :: C f UUID
    , profileUser      :: PrimaryKey UserT f
    , profileLocation   :: C f (Maybe Text)
    , profileMessage   :: C f (Maybe Text)
    } deriving Generic

type Profile = ProfileT Identity
type ProfileId = PrimaryKey ProfileT Identity

deriving instance Show (PrimaryKey UserT Identity)
deriving instance Show Profile

instance Beamable ProfileT
instance Table ProfileT where
  data PrimaryKey ProfileT f = ProfileId (Columnar f UUID) deriving (Generic, Beamable)
  primaryKey = ProfileId . profileId

ポイントはprofileUserの型宣言です。PrimaryKey UserT fとすることで外部キーを設定できます。尚、Profileをderivingする場合にはPrimaryKey UserT Identityも同じクラスにderivingする必要があります。

では、他のモデルについても同様に記述していきましょう。Schema.hsは以下の様になります。

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}

module Schema where

import Database.Beam
import Data.Text
import Data.UUID
import Data.Time

data UserT f = User
  { userId        :: C f UUID
  , userEmail     :: C f Text
  , userName      :: C f Text
  , userCreatedAt :: C f LocalTime
  , userUpdatedAt :: C f LocalTime
  } deriving Generic

type User = UserT Identity
type UserId = PrimaryKey UserT Identity

deriving instance Show User

instance Beamable UserT
instance Table UserT where
  data PrimaryKey UserT f = UserId (Columnar f UUID) deriving (Generic, Beamable)
  primaryKey = UserId . userId

data PostT f = Post
  { postId            :: C f UUID
  , postSlug          :: C f Text
  , postTitle         :: C f Text
  , postMarkdown      :: C f Text
  , postUser          :: PrimaryKey UserT f
  , postCategory      :: PrimaryKey CategoryT f
  , postCreatedAt    :: C f LocalTime
  , postUpdatedAt    :: C f LocalTime
  } deriving (Generic)

type Post = PostT Identity
type PostId = PrimaryKey PostT Identity

deriving instance Show (PrimaryKey CategoryT Identity)
deriving instance Show (PrimaryKey UserT Identity)
deriving instance Show Post
instance Beamable PostT
instance Table PostT where
  data PrimaryKey PostT f = PostId (Columnar f UUID) deriving (Generic, Beamable)
  primaryKey = PostId . postId

data CategoryT f = Category
  { categoryId        :: C f UUID
  , categoryName      :: C f Text 
  , categorySlug      :: C f Text
  , categoryCreatedAt :: C f LocalTime
  , categoryUpdatedAt :: C f LocalTime
  } deriving Generic

type Category = CategoryT Identity

deriving instance Show Category

instance Beamable CategoryT
instance Table CategoryT where
  data PrimaryKey CategoryT f = CategoryId (Columnar f UUID) deriving (Generic, Beamable)
  primaryKey = CategoryId . categoryId

type CategoryId = PrimaryKey CategoryT Identity

data TagT f = Tag
  { tagId        :: C f UUID
  , tagName      :: C f Text
  , tagSlug      :: C f Text
  , tagCreatedAt :: C f LocalTime
  , tagUpdatedAt :: C f LocalTime
  } deriving (Generic)

type Tag = TagT Identity
type TagId = PrimaryKey TagT Identity

deriving instance Show Tag

instance Beamable TagT
instance Table TagT where
  data PrimaryKey TagT f = TagId (Columnar f UUID) deriving (Generic, Beamable)  
  primaryKey = TagId . tagId

data PostTagT f = PostTag
  { posttagId      :: Columnar f UUID
  , posttagPost :: PrimaryKey PostT f
  , posttagTag  :: PrimaryKey TagT f
  } deriving Generic

type PostTag = PostTagT Identity
deriving instance Show PostTag
deriving instance Show (PrimaryKey PostT Identity)
deriving instance Show (PrimaryKey TagT Identity)

instance Beamable PostTagT
instance Table PostTagT where
  data PrimaryKey PostTagT f = PostTagId (Columnar f UUID) deriving (Generic, Beamable)
  primaryKey = PostTagId . posttagId

data ProfileT f
  = Profile
    { profileId        :: C f UUID
    , profileUser      :: PrimaryKey UserT f
    , profileLocation   :: C f (Maybe Text)
    , profileMessage   :: C f (Maybe Text)
    } deriving Generic

type Profile = ProfileT Identity
type ProfileId = PrimaryKey ProfileT Identity

deriving instance Show Profile

instance Beamable ProfileT
instance Table ProfileT where
  data PrimaryKey ProfileT f = ProfileId (Columnar f UUID) deriving (Generic, Beamable)
  primaryKey = ProfileId . profileId

データベース

モデルの生成が終わったらデータベースの定義をしましょう。Schema.hsに追記します。

Schema.hs

data BlogDatabase f = BlogDatabase
  { users      :: f (TableEntity UserT)
  , categories :: f (TableEntity CategoryT)
  , posts   :: f (TableEntity PostT)
  , tags   :: f (TableEntity TagT)
  , posts_tags :: f (TableEntity PostTagT)
  } deriving (Generic, Database be)

blogDatabase :: DatabaseSettings be BlogDatabase
blogDatabase = defaultDbSettings

derivingする際に今回は汎用性を持たせるためDatabase beとしましたが、PostgreSQLに特化する場合はDatabase.Beam.PostgresをインポートしてDatabase Postgresとします。

フィールドのデフォルト名

BeamではHaskellモデルのフィールド名からDBのテーブルのフィールド名を決定する命名方法が決められています。まとめると以下の表のようになります。

Haskellのフィールド	DBのフィールド	解説
userMailAddress	mail_address	キャメルをスネークに変換し最初の単語を除去
_userMailAddress	mail_address	’_‘を除去しキャメルをスネークに変換し最初の単語を除去
user_email	user_email	スネーク場合は変換せず
_user_email	user_email	’_‘を除去しスネーク場合は変換せず
___user_email	___user_email	変換せず

デフォルトのフィールド名の変更

今回はデフォルトの命名法を使用していきますのでフィールド名を変更することはしませんが、もし変更したい場合はデータベース設定時に以下のように変更をします。

データベース接続用の設定

最後にデータベース接続に必要な設定を書いておきましょう。src/Config.hsを生成します。

Config.hs

module Config where

import Database.Beam.Postgres

-- | Settings of database connection
conn :: IO Connection
conn = connect defaultConnectInfo
  { connectUser     = "username" -- データベースユーザー名
  , connectDatabase = "beam"     -- データベース名
  , connectPassword = "password" -- データベースパスワードを設定
  }

まとめ

今回はデータベースの構造に対応したモデルの生成とデータベースの定義について記しました。次回は簡単なデータの取得を学んでいきます。