LoginSignup
7
2

More than 1 year has passed since last update.

@nekonibox(Kenta Inoue)

Haskell Persistentで直和型を含むデータをそのままデータベースに保存する

Last updated at Posted at 2021-08-03

はじめに

Haskell Persistentで直和型を含むデータをデータベースに保存する際、デフォルトではそのままデータベースに保存するのではなく、公式ドキュメントのSumTypesにあるように、型X,Yに対し、直和型(X+Y)を保存するためにまずXとY単体のテーブルを作成し、そのどちらかのID値を保存する形で間接的に保存します。

しかしながら、この方法では後述するようなデメリットがあり、ID値を保存するための型に型変換等を行う必要があるなどプログラムの記述が複雑になります。

そこで本記事は、Haskell Persistentで直和型を含むデータも直積型などと同様に型変換等を行わずにそのまま1つのテーブルで保存する方法について記述します。

本記事のソースコードはこちらにあります。

直和型をID値でデータベースに保存するデメリット

直和型をID値でデータベースに保存する手法には以下のようなデメリットがあります。(X,Yを型とする。)

  • 直和型(X+Y)をデータベースに保存するための(XId + YId)型に変換する必要がある。
  • データを保存するときに2段階の手間がかかる。すなわち、(X+Y)型のデータを保存するためにまずXやYのデータを保存してそのID値を取得してから本体の直和型データを保存する必要がある。
  • データを削除するときに本体の直和型データを削除しただけではXやYのデータが残ってしまう。すなわち、Garbage Collectionなどを用意する必要がある。

Either型の場合

まずはEither型を含むデータをデータベースに保存する方法をみていきます。

まず、目標として以下のようなメインプログラムが通るようなものを作成します。

メインプログラム

以下に定義されるEither型を含むMyData型をデータベースに保存する場合を考えます。

--import文などは省略

type MySum = Either Int String

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
MyData
  value MySum
  deriving Show
|]

-- main
startApp :: IO ()
startApp = do
  pool <- readyPool dbPath migrateAll  -- ConnectionPoolの準備
  runSqlPool dbOperation pool

dbOperation :: DatabaseIO ()
dbOperation = do
  leftDataId <- insert $ MyData $ Left 4
  rightDataId <- insert $ MyData $ Right "hello"
  leftData <- get leftDataId
  rightData <- get rightDataId
  liftIO $ print leftData  -- Just (MyData {myDataValue = Left 4})
  liftIO $ print rightData -- Just (MyData {myDataValue = Right "hello"})

type DatabaseIO a = ReaderT SqlBackend IO a


-- ConnectionPool

dbPath :: FilePath
dbPath = "sqlite.db"

poolSize :: Int
poolSize = 5

readyPool :: FilePath -> Migration -> IO ConnectionPool
readyPool dbPath migration = do
  pool <- mkPool dbPath
  runSqlPool (runMigration migration) pool
  return pool

mkPool :: FilePath -> IO ConnectionPool
mkPool filePath =
  runStdoutLoggingT $ createSqlitePool (cs filePath) poolSize

dbOperation :: DatabaseIO ()が実際にデータベースにアクセスする部分で、Either Int String型であるLeft 4とRight "hello"をそのままデータベースに保存して、それを取り出しているコードになっています。

このコードは、公式ドキュメントのID値を保存する方法とは異なり、データベースのテーブルが本体の1つのみであり、Int型やString型をデータベースのID値に変換するのではなく直和型データのまま記述できるため、ここで型変換の記述を行う必要がありません。
また、後述するようにデータ削除時も不要なデータが残ることがなくなります。

しかしながら、このようなコードを通すためには以下のようなファイルを用意する必要があります。

PersistFieldとPersistFieldSqlを作成

Persistentでは、データベースに保存する値をPersistField型に変換し、それをデータベース上で、データベースにおける型に対応するPersistFieldSql型として保存します。
したがって、直和型からこれら2つへの変換を与えます。

MyPersistField.hs
{-# LANGUAGE TemplateHaskell #-}

module MyPersistField where

import Database.Persist
import Database.Persist.TH
import Database.Persist.Class
import Database.Persist.Sql
import Data.Text as T

-- PersistField
instance (PersistField a, PersistField b) => PersistField (Either a b) where
  toPersistValue (Left a) = PersistList [PersistBool True, toPersistValue a]
  toPersistValue (Right b) = PersistList [PersistBool False, toPersistValue b]
  fromPersistValue v =
    case fromPersistValue v of
      Right [PersistBool True,va] -> Left <$> fromPersistValue va
      Right [PersistBool False,vb] -> Right <$> fromPersistValue vb
      Left e -> Left e
      _ -> Left $ T.pack $ "Expected 2 item PersistList, recieved: " ++ show v

-- PersistFieldSql
instance (PersistFieldSql a, PersistFieldSql b) => PersistFieldSql (Either a b) where
  sqlType _ = SqlString

PersistFieldの方はtoPersistValue :: a -> PersistValueとfromPersistValue :: PersistValue -> Either Text aをfromPersistValue . toPersistValueがRightと等価になるように定義します。
具体的にはPersistValue型にはリストを表すコンストラクタがあるので、これを使って長さ2のリストを作り1つ目にLeftであるかRightであるかの情報を表すPersistBool型、2つ目にその値を格納します。

fromPersistValueの定義の中で、case fromPersistValue v ofという記述があり、引数vをそのままの形で再帰呼び出しを行なっているように見えますが、実はこのcase文内のfromPersistValueはPersistField (Either a b)に対するものではなくPersistField [PersistValue]のものとして適用されます。
よって、その返り値の型はEither Text [PersistValue]となるため、それ以降の場合分けが可能になります。
このような記述は直積型に対するPersistField (a,b)の定義でも使われています。

また、PersistFieldSqlの定義にあるように、直和型はデータベース上では直積型などと同様にSqlStringで保存します。
例えば、Haskell上でのLeft 4 :: Either Int String"はデータベース上では\"[true,4]\"として保存されます。
あくまで1つの文字列として保存するので、直和型のデータを削除した場合にも不要なデータがデータベースに残ることはありません。

ここで定義したMyPersistField.hsをimportすると、先ほどのメインプログラムが動くようになります。

一般の直和型の場合

上記のEitherの例を応用して、一般の直和型に対してもPersistFieldとPersistFieldSqlを定義します。

例として、以下のような異なる引数を持つ3つのコンストラクタを持つ直和型MySumTypeに対してこれらを定義します。

data MySumType a b1 b2
  = Constructor1
  | Constructor2 a
  | Constructor3 b1 b2
  deriving Show

このMySumType型に対するPersistField、PersistFieldSqlは以下のように定義できます。

instance (PersistField a, PersistField b1, PersistField b2) => PersistField (MySumType a b1 b2) where
  toPersistValue Constructor1 =
    PersistList [PersistInt64 1]
  toPersistValue (Constructor2 a) =
    PersistList [PersistInt64 2, toPersistValue a]
  toPersistValue (Constructor3 b1 b2) =
    PersistList [PersistInt64 3, toPersistValue b1, toPersistValue b2]
  fromPersistValue v =
    case fromPersistValue v of
      Right [PersistInt64 1] -> Right Constructor1
      Right [PersistInt64 2,va] -> Constructor2 <$> fromPersistValue va
      Right [PersistInt64 3,vb1,vb2] ->
        Constructor3 <$> fromPersistValue vb1 <*> fromPersistValue vb2
      Left e -> Left e
      _ -> Left $ T.pack $ "Expected PersistList [1], [2,_] or [3,_,_], recieved: " ++ show v

instance (PersistFieldSql a, PersistFieldSql b1, PersistFieldSql b2) => PersistFieldSql (MySumType a b1 b2) where
  sqlType _ = SqlString

今回はコンストラクタの識別をInt型で行なっていますが、要はfromPersistValue . toPersistValueがRightと等価になるように定義できればどのように定義しても大丈夫です。
このようにPersistListを利用して定義すれば、コンストラクタの引数が0でも複数でも対応ができます。

また、PersistFieldSqlはEitherの時と同様にSqlStringとして保存します。

これで以下のようにMuSumType型をデータベースに保存することが可能です。

type MySum3 = MySumType Int Int String

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
MyData3
  value MySum3
  deriving Show
|]

startApp :: IO ()
startApp = do
  pool <- readyPool dbPath migrateAll  -- ConnectionPoolの準備
  runSqlPool dbOperation3 pool

dbOperation3 :: MyDatabaseIO ()
dbOperation3 = do
  dataId1 <- insert $ MyData3 Constructor1
  dataId2 <- insert $ MyData3 $ Constructor2 4
  dataId3 <- insert $ MyData3 $ Constructor3 7 "world"
  data1 <- get dataId1
  data2 <- get dataId2
  data3 <- get dataId3
  liftIO $ print data1
  liftIO $ print data2
  liftIO $ print data3
-- Just (MyData3 {myData3Value = Constructor1})
-- Just (MyData3 {myData3Value = Constructor2 4})
-- Just (MyData3 {myData3Value = Constructor3 7 "world"})

まとめ

Haskell Persistで直和型を含むデータを型変換などを行わずにそのままデータベースに保存する方法について記述しました。

この方法は公式ドキュメントのやり方とは異なり、直和型データを別の型に変換したり、データベースに2度アクセスする必要がなく、直接やりとりできる点に優位性があります。

7
2
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
7
2