如何编写查询，使用Haskell中的Beam库返回嵌套列表？

Question

我需要重写myQuery的帮助，以便可以检索与购买的课程证相关的所有课程类型。我想要的查询将具有签名：

myQuery :: Text -> Pg [(PurchasedClassPass, [ClassType])]

我使用Beam库具有以下postgres模式：

import           Database.Beam
import           Database.Beam.Migrate
import           Database.Beam.Postgres
import           Data.Text                      ( Text )


data MyDb f = MyDb
  {   _class_types :: f (TableEntity ClassTypeT)
    , _class_pass_types :: f (TableEntity ClassPassTypeT)
    , _class_passes :: f (TableEntity ClassPassT)
    , _purchased_class_passes :: f (TableEntity PurchasedClassPassT)
    } deriving (Generic, Database Postgres)


data ClassTypeT f = ClassType
  { _id :: Columnar f Text
  , _name :: Columnar f Text
  }
  deriving (Generic, Beamable)

instance Table ClassTypeT where
  data PrimaryKey ClassTypeT f = ClassTypeId {
       unClassTypeId :: Columnar f Text 
    } deriving (Generic, Beamable)
  primaryKey = ClassTypeId . _id

type ClassType = ClassTypeT Identity

type ClassTypeId = PrimaryKey ClassTypeT Identity


data ClassPassT f = ClassPass
  { _class_type_id :: PrimaryKey ClassType.ClassTypeT f
  , _class_pass_type_id :: PrimaryKey ClassPassTypeT f
  , _created_at :: Columnar f LocalTime
  , _updated_at :: Columnar f LocalTime
  } deriving (Generic, Beamable)


-- the kinds of class passes which can be purchased
data ClassPassTypeT f = ClassPassType
  {   _id :: Columnar f Text
    , _name :: Columnar f Text
  }
  deriving (Generic, Beamable)

instance Table ClassPassTypeT where
    data PrimaryKey ClassPassTypeT f = ClassPassTypeId { unClassPassTypeId :: Columnar f Text } deriving (Generic, Beamable)
    primaryKey = ClassPassTypeId . _id

type ClassPassType = ClassPassTypeT Identity

type ClassPassTypeId = PrimaryKey ClassPassTypeT Identity

-- purchases
data PurchasedClassPassT f = PurchasedClassPass
  { _id :: Columnar f Text
  , _student_email :: Columnar f Text
  , _class_pass_type_id :: PrimaryKey ClassPassTypeT f
  } deriving (Generic, Beamable)

instance Table PurchasedClassPassT where
  data PrimaryKey PurchasedClassPassT f = PurchasedClassPassId { unPurchasedClassPassId :: Columnar f Text } deriving (Generic, Beamable)
  primaryKey = PurchasedClassPassId . _id

type PurchasedClassPass = PurchasedClassPassT Identity

type PurchasedClassPassId = PrimaryKey PurchasedClassPassT Identity


-- join table which expresses the many <-> many relation between 
-- class pass types and the Class types.
-- A row here linking a class pass type and the class type says that
-- the class pass can be redeemed as credit against the given class type
instance Table ClassPassT where
    data PrimaryKey ClassPassT f
      = ClassPassId
          (PrimaryKey ClassType.ClassTypeT f)
          (PrimaryKey ClassPassTypeT f)
      deriving Generic
    primaryKey =
        ClassPassId
        <$> _class_type_id
        <*> _class_pass_type_id

type ClassPass = ClassPassT Identity

instance Beamable (PrimaryKey ClassPassT)


classPassTypeClassTypeRelationship ::  
  Q Postgres
  MyDb
  s
  (ClassPassTypeT (QExpr Postgres s))
  -> Q Postgres MyDb s (ClassTypeT (QExpr Postgres s))
  -> Q Postgres
     MyDb
     s
     (ClassPassT (QExpr Postgres s), ClassPassTypeT (QExpr Postgres s),
      ClassTypeT (QExpr Postgres s))
classPassTypeClassTypeRelationship =
  manyToManyPassthrough_ (_class_passes MyDb)
    _class_pass_type_id
    _class_type_id

对于purchased_class_passes表中的每一行，在（_class_pass_type_id）中都有一个外键链接到class_pass_types table。

class_pass_type然后，此实体在class_passes表中具有许多条目 ，然后表又具有class_type与其相关联的许多实体。该class_passes表是一个连接表，表示class_pass_types和之间的这种多对多关系 class_types。

我需要编写查询的帮助，该查询可以返回给定的所有购买的类通行证的student_email 列表，以及购买的类通行证涉及的所有类类型的另一个嵌套列表-换句话说，所有购买的类通行证的所有类类型（已过滤通过student_email）。

所以这是我目前的失败尝试。

getPurchasedClassPassSummaries studentEmail = do
  purchasedClassPasses <- all_ (_purchased_class_passes MyDb)
  guard_ $ _student_email purchasedClassPasses ==. val_ studentEmail  

  classPassTypes <- related_ (MyDb ^. class_pass_types) (_class_pass_type_id purchasedClassPasses)

  classPasses <- leftJoin_ (all_ (MyDb ^. class_passes))
    (\classPass -> _class_pass_type_id classPass `references_` classPassTypes)

  classTypes <- related_ (MyDb ^. class_types) (_class_type_id classPasses)

  pure (purchasedClassPasses, classTypes)

虽然此类型检查为

getPurchasedClassPassSummaries :: 
  Text -> 
  Q Postgres MyDb s           
    [(
      PurchasedClassPassT (QExpr Postgres s),
      ClassTypeT (QExpr Postgres s)
    )]

myQuery :: Text -> Pg [(PurchasedClassPass, ClassType)]
myQuery studentEmail =
  runSelectReturningList $ do 
    select $ getPurchasedClassPassSummaries studentEmail

这是不足够的，因为我真的很想重写查询，以便获得以下类型签名。

getPurchasedClassPassSummaries ::
  Text -> 
  Q Postgres MyDb s           
    [ 
      (  PurchasedClassPassT (QExpr Postgres s)
        , [ClassTypeT (QExpr Postgres s)] )
    ]
getPurchasedClassPassSummaries studentEmail = undefined

myQuery :: Text -> Pg [(PurchasedClassPass, [ClassType])]
myQuery studentEmail =
  runSelectReturningList $ do 
    select $ getPurchasedClassPassSummaries studentEmail