型安全な Persistent を使う

(2017.1 新規作成。)

Webアプリケーションフレームワーク Yesod 用のO/Rマッパ, Persistent を単体で使う。

テーブルごとに別のデータ型になる。ActiveRecord のようなイメージ。

それぞれのテーブルのidフィールドは, SQLまで落ちると単なる整数などになる。そこを, Haskell の世界では別々の型にマッピングすることで, コンパイル時に, 異なるテーブルのidを混ぜたり比較したりできないようにする。

インストール

cabal でインストール.

依存関係がとても多い。

Database.Persist.TH モジュールは別パッケージになっている。persistent-template パッケージ.

バックエンドも別パッケージ。sqlite なら persistent-sqlite パッケージ。

# cabal install --dry-run --global persistent
Resolving dependencies...
In order, the following would be installed (use -v for more details):
auto-update-0.1.4
base-compat-0.9.1
blaze-builder-0.4.0.2
blaze-markup-0.7.1.1
blaze-html-0.8.1.3
bytestring-builder-0.10.8.1.0
dlist-0.8.0.2
easy-file-0.2.1
fail-4.9.0.0
mmorph-1.0.9
monad-loops-0.4.3
path-pieces-0.2.1
semigroups-0.18.2
silently-1.2.5
stm-chans-3.0.0.4
streaming-commons-0.1.16
time-locale-compat-0.1.1.3
transformers-base-0.4.4
monad-control-1.0.1.0
lifted-base-0.2.3.8
resource-pool-0.2.3.2
resourcet-1.1.9
conduit-1.2.8
conduit-extra-1.1.15
unix-time-0.3.7
fast-logger-2.4.7
monad-logger-0.3.20.1
uri-bytestring-0.2.2.1
uuid-types-1.0.3
aeson-1.1.0.0
http-api-data-0.3.3
persistent-2.6
# cabal install --dry-run --global persistent-template
Resolving dependencies...
In order, the following would be installed (use -v for more details):
nats-1.1.1
aeson-compat-0.3.6
persistent-template-2.5.1.6

最初のプログラム

テーブルを作って, 挿入したり問い合わせたりするサンプル。

テーブル定義

テーブル定義ファイルを読み込み, 各テーブルと同名のデータ型を作ります。

Model.hs ファイル

Haskell
[POPUP]
  1. {-# LANGUAGE TypeFamilies #-} -- Illegal family instance
  2. {-# LANGUAGE TemplateHaskell #-} -- Parse error: naked expression at top level
  3. {-# LANGUAGE GADTs #-} -- Data constructor ‘UserId’ has existential
  4. {-# LANGUAGE MultiParamTypeClasses #-} -- Illegal instance declaration
  5. {-# LANGUAGE GeneralizedNewtypeDeriving #-} -- Can't make a derived instance of ...
  6. {-# LANGUAGE EmptyDataDecls #-}
  7. module Model where
  8. import Database.Persist.TH -- share, mkPersist, persistFileWith
  9. import Database.Persist.Quasi -- lowerCaseSettings
  10. import Data.Text -- UTF-16. String よりこちらを使う.
  11. -- ファイルから読み込み、スキーマを定義する
  12. -- ここでも TemplateHaskell の機能で, migrateMyAll という識別子が作られる.
  13. share [mkPersist sqlSettings, mkMigrate "migrateMyAll"]
  14. $(persistFileWith lowerCaseSettings "config/models")

config/models ファイル

Haskell
[POPUP]
  1. User -- テーブル名、かつデータ型の名前
  2. email Text -- フィールド名とその型
  3. name Text
  4. age Int Maybe -- ナル値を許可
  5. UniqueUser email -- 制約を付ける
  6. -- deriving できる型クラスは, Show, Read, Eq, Typeable, Ord か?
  7. deriving Show
  8. -- このファイルに, 複数のテーブルを書ける
  9. BlogPost
  10. -- id Int
  11. title Text
  12. authorId UserId -- 参照制約. テーブル名Tblから TblIdを自動生成
  13. -- UniqueBlogPost id
  14. deriving Show

TemplateHaskell の機能で, User, BlogPost というデータ型が宣言される

idというフィールドが自動作成される?

フィールドに使える型は, 型クラス PersistField のインスタンス (拡張可).

SQL Persistent
データ型 (VARCHAR, INTEGER, etc.) PersistValue
PersistField
PersistEntity

データ操作

これを利用して, データを投入したりする。

Application.hs ファイル

Haskell
[POPUP]
  1. {-# LANGUAGE OverloadedStrings #-} -- Couldn't match expected type 'Data.Text.Internal.Text
  2. module Application where
  3. import Database.Persist -- insert, selectList, LimitTo, entityVal, get, delete, deleteWhere
  4. import Database.Persist.Sql (runMigration, runSqlConn)
  5. import Database.Persist.Sqlite (withSqliteConn)
  6. import Control.Monad.Trans.Resource (runResourceT)
  7. import Control.Monad.Logger (runNoLoggingT)
  8. import Control.Monad.IO.Class (liftIO) -- liftIO :: IO a -> m a
  9. import System.IO -- hPutStrLn
  10. -- Model.hs
  11. import Model
  12. -- この例では、ファイルではなくメモリ内にデータベースを作成する
  13. database = ":memory:"
  14. appMain :: IO ()
  15. -- runSqlConn から例外で抜けると roll back される
  16. appMain = runNoLoggingT $ runResourceT $ withSqliteConn database $ runSqlConn $ do
  17. -- テーブルの作成など、データベースを初期化する
  18. runMigration migrateMyAll
  19. -- データを登録する
  20. -- { } 内で列名を指定する. テーブル名が頭に付く
  21. johnId <- insert $ User { userName = "John Doe", userAge = Just 35,
  22. userEmail = "x" }
  23. -- 挿入に失敗する。ErrorConstraint (data Error の値) が発生.
  24. -- janeId <- insert $ User { userName = "Jane Doe", userAge = Nothing,
  25. -- userEmail = "x" }
  26. insert $ BlogPost { blogPostTitle = "My first post", blogPostAuthorId = johnId }
  27. insert $ BlogPost { blogPostTitle = "2つ目の投稿", blogPostAuthorId = johnId }
  28. insert $ BlogPost { blogPostTitle = "One more for good measure",
  29. blogPostAuthorId = johnId }
  30. -- データを検索する (問い合わせ)
  31. oneJohnPost <- selectList [BlogPostAuthorId ==. johnId] [LimitTo 2]
  32. liftIO $ print $ map (blogPostTitle . entityVal) oneJohnPost
  33. -- IDからレコードを取得
  34. -- DBにレコードがなければ見つからないので, Maybeで返ってくる.
  35. maybeJohn <- get johnId
  36. case maybeJohn of
  37. Nothing -> liftIO $ putStrLn "Just kidding, not really there"
  38. Just john -> liftIO $ print $ userName $ john
  39. -- データを削除する
  40. -- delete janeId
  41. deleteWhere [BlogPostAuthorId ==. johnId]
  42. return ()

Database.Persist.insert の型は, 次のようになっている. idを返す。

Database.Persist.insert
  :: (Database.Persist.Class.PersistEntity.PersistEntity val,
      Control.Monad.IO.Class.MonadIO m,
      Database.Persist.Class.PersistStore.PersistStore
        (Database.Persist.Class.PersistEntity.PersistEntityBackend val)) =>
     val
     -> Control.Monad.Trans.Reader.ReaderT
          (Database.Persist.Class.PersistEntity.PersistEntityBackend val)
          m
          (Database.Persist.Class.PersistEntity.Key val)

getはこう; maybeJohn は 型 Maybe User になる。

Database.Persist.get
  :: (Database.Persist.Class.PersistEntity.PersistEntity val,
      Control.Monad.IO.Class.MonadIO m,
      Database.Persist.Class.PersistStore.PersistStore
        (Database.Persist.Class.PersistEntity.PersistEntityBackend val)) =>
     Database.Persist.Class.PersistEntity.Key val
     -> Control.Monad.Trans.Reader.ReaderT
          (Database.Persist.Class.PersistEntity.PersistEntityBackend val)
          m
          (Maybe val)

上のサンプルではコメントアウトしているが、挿入に失敗すると, 例外が発生する。TODO: 例外への対処方法.

最後, main 関数.

app/main.hs ファイル

Haskell
[POPUP]
  1. import Application (appMain)
  2. main :: IO ()
  3. main = appMain