如何用Beam库在Haskell中实现带JSONB过滤与子查询的SQL

问题背景 #

现有一张名为mytable的表，结构如下：

details列的样例数据：

{
    "x": [
        {"x1": "a", "x2": "b"},
        {"x1": "c", "x2": "d"}
    ],
    "y": {
        "y1": ["d", "e", "f"],
        "y2": ["l", "m", "n"]
    }
}

需要过滤满足以下条件的行：

• details.x中至少有一条记录的x1='value1'
• details.y.y1不为空

对应的SQL查询语句：

SELECT *
FROM mytable AS currentRow
WHERE 'value1' = ANY (
          SELECT (jsonb_array_elements(details->'x')->>'x1')::text
          FROM mytable
          WHERE mytable.id = currentRow.id
      )
  AND EXISTS (
          SELECT jsonb_array_elements(details->'y'->'y1')
          FROM mytable
          WHERE mytable.id = currentRow.id
      );

尝试用Haskell的Database.Beam库编写对应代码，原代码如下：

import Database.Beam
import Database.Beam.Postgres

loadAllOffersByMerchantId :: HasCallStack => Flow [MyTable]
loadAllOffersByMerchantId = do
  runDB $ -- A local function 
    do
      findRows -- Uses runReturningList
          $ select
          $ do
              myTable <- all_ (schema.myTable)
              let subquery1 =
                      subselect_ $ pgJsonArrayElements (myTable.details ->$ x_)
                  subquery2 =
                      subselect_ $ pgJsonArrayElements (myTable.details ->$ y_) ->$ y1_
              guard_ ((val_ "value1") `in_` subquery1)
              guard_ (exists_ subquery2)
              return (od, rdsl)
  where
    x_ :: QGenExpr ctxt Postgres s Text
    x_ = "x"

    y_ :: QGenExpr ctxt Postgres s Text
    y_ = "y"

    y1_ :: QGenExpr ctxt Postgres s Text
    y1_ = "y1"

出现的编译错误：

1.  In line: subselect_ $ pgJsonArrayElements (myTable.details ->$ x_)
    1.1 Error: Couldn't match expected type ‘Q be db (Database.Beam.Query.Internal.QNested s) r’
            with actual type ‘QGenExpr QValueContext Postgres
                                ( Database.Beam.Query.Internal.QNested QBaseScope)
                                ( beam-postgres-0.5.0.0:Database.Beam.Postgres.PgSpecific.PgSetOf
                                  ( beam-postgres-0.5.0.0:Database.Beam.Postgres.PgSpecific.PgJSONElement
                                    (json0 aeson-1.5.6.0:Data.Aeson.Types.Internal.Value)
                                  )
                                )’

    1.2 Error: Couldn't match type ‘aeson-1.5.6.0:Data.Aeson.Types.Internal.Value’
                          with ‘json0 a1’
            arising from a use of ‘GHC.Records.Extra.getField’
2.  In line: guard_ ((val_ "value1") `in_` subquery1)
    2.1 Error: Couldn't match expected type ‘[a0]’
                           with actual type ‘Q be0 db0 s0
                                              ( Database.Beam.Query.Internal.WithRewrittenThread
                                                (Database.Beam.Query.Internal.QNested s0)
                                                s0 r0
                                              )’
3. In line:  subselect_ $ pgJsonArrayElements (myTable.details ->$ y_) ->$ y1_
    3.1 Error: Couldn't match kind ‘(* -> *) -> *’
                              with ‘*’
    3.2 Error: Couldn't match expected type ‘Q be db (Database.Beam.Query.Internal.QNested s) r’
                           with actual type ‘QGenExpr QValueContext Postgres
                                              (Database.Beam.Query.Internal.QNested QBaseScope)
                                              (json0 b0)’
    3.3 Error: Couldn't match type ‘aeson-1.5.6.0:Data.Aeson.Types.Internal.Value’
                              with ‘json1 a1’
                arising from a use of ‘GHC.Records.Extra.getField’

错误原因分析 #

1. pgJsonArrayElements使用错误：该函数返回PgSetOf类型表达式，不能直接用subselect_包裹，需用unpgSetOf展开后才能在子查询中遍历。
2. JSON字段访问逻辑错误：原代码用->$直接访问字段，但未正确处理JSON类型转换，需用Beam提供的pgJsonGetField/pgJsonGetFieldText函数提取字段。
3. 类型不匹配：in_需要列表或合法子查询结果，原代码子查询构造方式错误导致类型不兼容；第二个子查询的链式调用不符合Beam查询语法。
4. 返回值错误：原代码return (od, rdsl)无意义，应返回查询到的表行对象。

修正后的代码 #

import Database.Beam
import Database.Beam.Postgres
import Data.Aeson (Value)
import qualified Data.Text as T

loadAllOffersByMerchantId :: HasCallStack => Flow [MyTable]
loadAllOffersByMerchantId = do
  runDB $
    findRows $ select $ do
      myTable <- all_ (schema.myTable)
      
      -- 条件1：details.x中存在x1='value1'的元素
      let xArray = pgJsonGetField (myTable.details) (val_ "x") :: QGenExpr QValueContext Postgres s (PgJSONB Value)
          xElements = pgJsonArrayElements xArray
          subquery1 = subselect_ $ select $ do
              elem <- unpgSetOf xElements
              return $ pgJsonGetFieldText elem (val_ "x1")
      
      guard_ (val_ (T.pack "value1") `in_` subquery1)
      
      -- 条件2：details.y.y1不为空数组
      let yY1Array = pgJsonGetField (pgJsonGetField (myTable.details) (val_ "y")) (val_ "y1") :: QGenExpr QValueContext Postgres s (PgJSONB Value)
          yY1Elements = pgJsonArrayElements yY1Array
          subquery2 = subselect_ $ select $ unpgSetOf yY1Elements
      
      guard_ (exists_ subquery2)
      
      return myTable

关键修改说明 #

1. 正确提取JSON字段：用pgJsonGetField提取JSON对象字段（对应SQL的->），pgJsonGetFieldText直接提取文本类型字段（对应SQL的->>），确保类型匹配。
2. 展开集合类型：用unpgSetOf将pgJsonArrayElements返回的PgSetOf转换为子查询可遍历的数据源。
3. 子查询构造：为每个条件构造合法子查询，确保in_和exists_的参数类型符合要求。
4. 类型对齐：将字符串"value1"转换为Text类型（Beam中数据库文本字段对应Data.Text.Text）。
5. 返回值修正：返回查询到的myTable行对象，替换原代码中无意义的返回值。

内容的提问来源于stack exchange，提问作者Nivedita Thakur