База: persistent и esqueleto

Обработчики из прошлого урока возвращают заглушки. Пора дать им данные. persistent описывает схему базы декларативно и сам генерирует типы и миграции, а простые запросы пишутся его типобезопасным API. Когда нужен join или агрегация, в дело вступает esqueleto, EDSL поверх SQL. И снова работает приём раздела: меняешь схему, компилятор показывает все места, которые надо поправить.

Схема как декларация

В персистентном слое мы не пишем CREATE TABLE руками. Описываем сущности в специальном блоке, а persistent через Template Haskell разворачивает блок в типы, ключи, селекторы столбцов и функцию миграции.

{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
-- ... ещё несколько расширений для генерации

module Meeple.Db.Schema where

import Database.Persist.TH

share
  [mkPersist sqlSettings, mkMigrate "migrateAll"]
  [persistLowerCase|
GameRow sql=games
    title       Text
    minPlayers  Int
    maxPlayers  Int
    deriving Show Eq

MemberRow sql=members
    name   Text
    email  Text
    UniqueEmail email
    deriving Show Eq

CopyRow sql=copies
    game    GameRowId
    status  Text
    holder  MemberRowId Maybe
    due     Day         Maybe
    deriving Show Eq
|]

Из этого блока persistent генерирует тип GameRow, его ключ GameRowId (это Key GameRow), селекторы столбцов (GameRowTitle и так далее) и функцию migrateAll. UniqueEmail email это уникальный индекс: двух участников с одним email база не примет. CopyRow ссылается на игру через GameRowId, и persistent сам сделает внешний ключ.

Сущности базы это не доменные типы

Заметь: я назвал таблицы GameRow, а не Game. Это сознательно. В уроке 42 богатый статус экземпляра был sum-типом CopyStatus, где Rented несёт арендатора и срок. В базе же это три плоских столбца: status (строка), holder (необязательный ключ участника), due (необязательная дата). Реляционная таблица не умеет хранить sum-тип так же изящно, как Haskell.

Поэтому между базой и доменом есть граница. На ней плоские столбцы собираются обратно в CopyStatus:

toStatus :: Text -> Maybe MemberRowId -> Maybe Day -> CopyStatus
toStatus "available" _ _ = Available
toStatus "rented" (Just h) (Just d) =
  Rented (orDie (mkMemberId (fromSqlKey h))) (dueDateFromDay d)
toStatus "reserved" (Just h) _ =
  Reserved (orDie (mkMemberId (fromSqlKey h)))
toStatus other _ _ = error ("неизвестный статус в базе: " <> Text.unpack other)

fromSqlKey достаёт Int64 из ключа persistent, mkMemberId прогоняет его через smart constructor домена, а dueDateFromDay это та самая доверенная реконструкция: данные пришли из нашей же базы, не снаружи. Обратная сторона границы раскладывает статус на столбцы:

statusColumns :: CopyStatus -> (Text, Maybe MemberRowId, Maybe Day)
statusColumns Available = ("available", Nothing, Nothing)
statusColumns (Rented m d) = ("rented", Just (toSqlKey (unMemberId m)), Just (unDueDate d))
statusColumns (Reserved m) = ("reserved", Just (toSqlKey (unMemberId m)), Nothing)

Миграции

Функция migrateAll, сгенерированная из схемы, приводит базу в соответствие со схемой: создаёт недостающие таблицы и столбцы. Запускаем её при старте, до приёма трафика:

runMigrations :: MonadIO m => SqlPersistT m ()
runMigrations = runMigration migrateAll

При первом запуске она напечатает и выполнит CREATE TABLE games (...), CREATE TABLE members (...) и так далее. Добавишь поле в схему, перезапустишь, persistent догенерирует ALTER TABLE.

CRUD через persistent

Простые операции пишутся типобезопасным API persistent. Каждый запрос это значение типа Db a, то есть SqlPersistT IO a, выполняемое потом через пул соединений (его соберём в уроке 45).

type Db a = SqlPersistT IO a

listGames :: Db [Game]
listGames = map toGame <$> selectList [] []

getGame :: Int64 -> Db (Maybe Game)
getGame gid = fmap toGame <$> getEntity (toSqlKey gid :: GameRowId)

insertGame :: NewGame -> Db Game
insertGame ng = do
  let row = GameRow (newGameTitle ng) (newGameMinPlayers ng) (newGameMaxPlayers ng)
  key <- insert row
  pure (toGame (Entity key row))

selectList [] [] это SELECT * FROM games (пустой список фильтров, пустой список сортировок). insert возвращает свежий ключ, из которого вместе с записью собирается доменный Game. getEntity достаёт Maybe (Entity GameRow), а fmap toGame превращает его в Maybe Game.