Opaleye 中跨 link-table 的数组聚合

Array-aggregation across a link-table in Opaleye

我正在尝试构建一个符合以下条件的 Opaleye 查询 SQL:

select * ,
    (select array_agg(tags.tagname)
     from articles_tags
     inner join tags on tags.id = articles_tags.tag_fk
         where articles_tags.article_fk = articles.id
    )
from articles

涉及(简化)的表格有:

articles: (id, title, content)
articles_tags: (article_fk, tag_fk)
tags: (id, tagname)

我的目标是查询附加了一个或多个标签的文章,并将所有附加标签检索为一个数组。

到目前为止,我得到了以下基本查询:

-- | Query all article-tag relations.
allTaggedArticlesQ :: OE.Select TaggedArticleR
allTaggedArticlesQ = OE.selectTable taggedArticlesTable

-- | Query article-tag relations for the given articles.
taggedArticlesQ :: OE.SelectArr PA.ArticleIdField TaggedArticleR
taggedArticlesQ = proc articleId -> do
  ta <- allTaggedArticlesQ -< ()
  OE.restrict -< articleFk ta .=== articleId
  returnA -< ta

-- | Join article-ids and tag names for the given subset of articles.
articleTagNamesQ :: OE.SelectArr PA.ArticleIdField ArticleTagR
articleTagNamesQ = proc articleIds -> do
  ta <- taggedArticlesQ -< articleIds
  tags <- PT.allTagsQ -< ()
  OE.restrict -< PT.tagKey tags .=== tagFk ta
  returnA -< ArticleTag (articleFk ta) (PT.tagName tags)

但是,我无法使聚合工作:以下不进行类型检查,我不明白如何使用上述查询组合此聚合:

-- | Aggregate all tag names for all given articles
articleTagsQ :: PA.ArticleIdField -> OE.Select (PA.ArticleIdField, F (OE.SqlArray OE.SqlText))
articleTagsQ = OE.aggregate
          ( pArticleTag
              ArticleTag
                { atArticleFk = OE.groupBy,
                  atTagname = OE.arrayAgg
                }
          ) OE.selectTable articleTagNamesQ

在一些博客文章和 GitHub 问题中,我发现了一个评论,即聚合不能很好地与 Product-Profunctors 和 Arrows 一起使用,因此不能包含在箭头查询中。然而,我对 Haskell 比较陌生,还没有真正理解这两个库背后的理论(似乎没有适合初学者的文档);因此,我无法想出如何将查询与聚合结合起来的一般结构。 William Yao 提供了一些示例 here,但我不了解一般概念,因此无法将这些示例应用到我的问题中。

如果有人可以提供有关如何在 Opaleye 中使用常规查询组合聚合的见解,我将不胜感激,谢谢!

在 运行 浏览了几个示例之后,这是我最终设法构建的解决方案 运行:

import           Control.Arrow
import qualified Opaleye as OE
import qualified Data.Profunctor.Product as PP

type F field = OE.Field field 

-- | Query all tags.
allTagsQ :: OE.Select TagR
allTagsQ = OE.selectTable tagsTable

-- | Query all article-tag relations.
allTaggedArticlesQ :: OE.Select TaggedArticleR
allTaggedArticlesQ = OE.selectTable taggedArticlesTable

-- | Join article-ids and tag names for all articles.
articleTagNamesQ :: OE.Select (F OE.SqlInt8, F OE.SqlText)
articleTagNamesQ = proc () -> do
  TaggedArticle {articleFk = aId, tagFk = tFk} <- allTaggedArticlesQ -< ()
  Tag {tagKey = tId, tagName = tn} <- allTagsQ -< ()
  OE.restrict -< tFk OE.(.===) tId -- INNER JOIN ON
  returnA -< (aId, tn)

-- | Aggregate all tag names for all articles
articleTagsQ :: OE.Select (F OE.SqlInt8, F (OE.SqlArray OE.SqlText))
articleTagsQ =
  OE.aggregate (PP.p2 (OE.groupBy, OE.arrayAgg)) $
    arr (first) <<< articleTagNamesQ

articles_tags table 的一行在 Haskell 中由多态 TaggedArticle* Opaleye 类型表示,类似地 Tag* 用于标记行。

重点是select两个table的所有行,然后进行join,最后做聚合。因为 Opaleye 中的聚合函数既不是 Arrow 也不是 ProductProfunctor,但 OE.aggregate 函数需要 Select a,所以我无法将聚合包含在编写的查询中在箭头符号中。相反,我不得不编写一个单独的函数,将 Select a 作为输入。

请注意,无法对更一般的 SelectArr 执行聚合。来自 pacakge 文档:“按照设计,没有 Aggregator b b' -> \S.SelectArr a b -> S.SelectArr a b' 类型的聚合函数。这样的函数将允许违反 SQL 的范围规则并导致无效查询。”。 =35=]

我上面的代码有些简化。我尝试对键使用多态类型。但是,我无法弄清楚如何根据这些新型包装器编写所有代码;相反,我不得不多次打开和重新包装这些字段。

我 运行 关注的另一个问题是 JOIN 产生的行类型的定义。最初,我定义了一个新的多态行类型。但是后来我没有设法正确解开该类型的字段,因此我无法将它们输入 OE.Aggregator。因此,我选择了上面更冗长的元组表示法。

我对您答案中的代码做了一些更改,以便将其编译为独立文件:

  • 运算符需要 OE..=== 而不是 OE.(.===)
  • arr first 需要删除
  • 我添加了一些数据类型定义、table 定义和扩展
{-# LANGUAGE Arrows #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}

import           Control.Arrow
import qualified Opaleye as OE
import qualified Data.Profunctor.Product as PP
import           Data.Profunctor.Product.TH (makeAdaptorAndInstance')

type F field = OE.Field field

data TaggedArticle a b = TaggedArticle { articleFk :: a, tagFk :: b }
type TaggedArticleR = TaggedArticle (F OE.SqlInt8) (F OE.SqlInt8)

data Tag a b = Tag { tagKey :: a, tagName :: b }
type TagR = Tag (F OE.SqlInt8) (F OE.SqlText)

$(makeAdaptorAndInstance' ''TaggedArticle)
$(makeAdaptorAndInstance' ''Tag)

tagsTable :: OE.Table TagR TagR
tagsTable = error "Fill in the definition of tagsTable"

taggedArticlesTable :: OE.Table TaggedArticleR TaggedArticleR
taggedArticlesTable = error "Fill in the definition of taggedArticlesTable"

-- | Query all tags.
allTagsQ :: OE.Select TagR
allTagsQ = OE.selectTable tagsTable

-- | Query all article-tag relations.
allTaggedArticlesQ :: OE.Select TaggedArticleR
allTaggedArticlesQ = OE.selectTable taggedArticlesTable

-- | Join article-ids and tag names for all articles.
articleTagNamesQ :: OE.Select (F OE.SqlInt8, F OE.SqlText)
articleTagNamesQ = proc () -> do
  TaggedArticle {articleFk = aId, tagFk = tFk} <- allTaggedArticlesQ -< ()
  Tag {tagKey = tId, tagName = tn} <- allTagsQ -< ()
  OE.restrict -< tFk OE..=== tId -- INNER JOIN ON
  returnA -< (aId, tn)

-- | Aggregate all tag names for all articles
articleTagsQ :: OE.Select (F OE.SqlInt8, F (OE.SqlArray OE.SqlText))
articleTagsQ =
  OE.aggregate (PP.p2 (OE.groupBy, OE.arrayAgg)) articleTagNamesQ