persistent で JOIN

Haskell persistent

persistent という、Haskell で永続データを扱うためのライブラリがあります。基本的には non-relational なのですが、どうやら 0.5 以降の persistent では JOIN が一応取り扱えるようになっているようなので試してみました*1。この記事では、現時点での最新版 http://hackage.haskell.org/package/persistent-0.6.4 に準拠しています。

persistent の基本的な使い方は http://www.yesodweb.com/book/persistent を参照してください。

selectOneMany は、SelectOneMany 型を作る関数で、その中身は

selectOneMany filts get' = SelectOneMany [] [] [] [] filts get' False

data SelectOneMany backend one many = SelectOneMany
    { somFilterOne :: [Filter one]
    , somOrderOne :: [SelectOpt one]
    , somFilterMany :: [Filter many]
    , somOrderMany :: [SelectOpt many]
    , somFilterKeys :: [Key backend one] -> Filter many
    , somGetKey :: many -> Key backend one
    , somIncludeNoMatch :: Bool
    }

となっています。

selectOneMany の型は

selectOneMany
  :: ([Key backend one] -> Filter many)
     -> (many -> Key backend one)
     -> SelectOneMany backend one many

ですが、これだけ見ていてもあまり参考にはなりません。というのも、第一引数の [Key backend one] -> Filter many は単に JOIN で結合するカラム名を指定するための型情報を得るためだけに使われているようです。実際の処理を見れば一目瞭然で、[Key backend one] に対しては undefined が渡されています。

runJoin (SelectOneMany oneF oneO manyF manyO eq _getKey isOuter) = do
    conn <- SqlPersist ask
    liftM go $ withStmt (sql conn) (getFiltsValues conn oneF ++ getFiltsValues conn manyF) $ loop id
  where
    {- ... snip ... -}
    sql conn = pack $ concat
        [ "SELECT "
        , intercalate "," $ colsPlusId conn one ++ colsPlusId conn many
        , " FROM "
        , escapeName conn $ rawTableName $ entityDef one
        , if isOuter then " LEFT JOIN " else " INNER JOIN "
        , escapeName conn $ rawTableName $ entityDef many
        , " ON "
        , escapeName conn $ rawTableName $ entityDef one
        , ".id = "
        , escapeName conn $ rawTableName $ entityDef many
        , "."
        , escapeName conn $ RawName $ filterName $ eq undefined
        , filts
        , if null ords
            then ""
            else " ORDER BY " ++ intercalate ", " ords
        ]

実例を挙げながら説明します。データベースのスキーマが

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persist|
Image
  name String
Tag
  name String
ImageTag
  imageId ImageId
  tagId TagId
|]

のように定義されている場合を考えます。ここで

	SELECT * FROM Image INNER JOIN ImageTag ON Image.id = ImageTag.imageId WHERE ImageTag.tagId = ?

のようなクエリを投げる場合は、

do
  Just (k, _) <- selectFirst [TagName ==. "tag1"] []
  results <- runJoin (selectOneMany (ImageTagImageId <-.) imageTagImageId)
    { somFilterMany = [ImageTagTagId ==. k]
    }

とすれば results に検索結果が [((ImageId, Image), [(ImageTagId, ImageTag)])] 型で格納されます。
順番に見ていくと、まずはじめに Tag.name の値が "tag1" と等しい列をひとつ取ってきて、そのキーを k に束縛しています。k の型は Key backend Tag です。
次に selectOneMany (ImageTagImageId <-.) imageTagImageId として SelectOneMany 型の値を作成します。この場合は One が Image, Many が ImageTag にそれぞれ対応するので、第一引数に [Key backend Image] -> Filter ImageTag 型の値を指定します。第二引数は ON で指定されている ImageTag.imageId カラムに対応する imageTagImageId を指定します。
WHERE 節を指定するには SelectOneMany の somFilterOne, somFilterMany に [Filter a] 型の値を指定します。ここでは tagId が k と等しいの物を取得するためレコード構文を用いて somFilterMany に[ImageTagTagId ==. k] を指定しています。
最後に、(selectOneMany (ImageTagImageId <-.) imageTagImageId) { somFilterMany = [ImageTagTagId ==. k] } を runJoin に渡せばクエリが実行されます。

M:N はいまのところ対応していないようですし、今回紹介した方法も Yesod Book にも書かれていないようなので、まだまだこれからといったところでしょう。
また、今回の例にある ImageTag テーブルには、Image や Tag テーブルと同じく primary key として暗黙の id カラムが生成されていることに注意が必要です。

*1:いまのところ、selectOneMany という名前の通り 1:N の関係しか扱えないようです