如何在 Yesod Persistent 中将 PostgreSql 数组类型用于外键数组？答案

【问题标题】：How to use PostgreSql array type for foreign key arrays in Yesod Persistent?如何在 Yesod Persistent 中将 PostgreSql 数组类型用于外键数组？
【发布时间】：2020-12-10 16:44:53
【问题描述】：

我是 Haskell 和 Yesod 的新手。

我想在 PostgreSql 后端使用 Array 类型，我发现在 pull request https://github.com/yesodweb/persistent/pull/884 Persistent 现在通过 PersistArray 数据构造函数支持 postgres 数组类型，（而不是 Persistent 的默认解释数组作为 json 字符串），但是 我找不到如何正确使用它 与 Yesod 的脚手架。我拼凑了一个解决方案，允许我拥有原始类型数组，但我无法弄清楚如何启用对“外键”类型的支持，例如输入从表 Product 的主键生成的 ProductId。

我知道可以使用简单的列表（例如 list [Text]），但将其持久存储为 json 字符串，这可能会引入开销并禁止原生 sql 数组操作。

请帮助我找到如何将 PostgreSql 数组类型与原始类型以及“外键”类型一起使用的正确解决方案。

这是我想出的代码（我正在使用 Yesod 的脚手架模板 yesodweb/postgres）：

-- Util/PostgreSqlTypes.hs
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}

module Util.PostgreSqlTypes where

import ClassyPrelude
import qualified Data.Text as T
import Database.Persist.Types

-- https://github.com/yesodweb/persistent/blob/master/persistent-postgresql/Database/Persist/Postgresql.hs#L1109
showSqlType :: SqlType -> Text
showSqlType SqlString = "TEXT"
showSqlType SqlInt32 = "INT4"
showSqlType SqlInt64 = "INT8"
showSqlType SqlReal = "DOUBLE PRECISION"
showSqlType (SqlNumeric s prec) = concat [ "NUMERIC(", pack (show s), ",", pack (show prec), ")" ]
showSqlType SqlDay = "DATE"
showSqlType SqlTime = "TIME"
showSqlType SqlDayTime = "TIMESTAMPTZ"
showSqlType SqlBlob = "BYTEA"
showSqlType SqlBool = "BOOLEAN"
showSqlType (SqlOther (T.toLower -> "integer")) = "INT4"
showSqlType (SqlOther t) = t

-- Util/SqlArray.hs
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}

module Util.SqlArray where

import ClassyPrelude
import Database.Persist.Class
import Database.Persist.Sql
import Database.Persist.Types()
import Data.Proxy

import Util.PostgreSqlTypes(showSqlType)

newtype SqlArray a = SqlArray [a]
   deriving (Eq, Show)

unbox :: SqlArray a -> [a]
unbox (SqlArray a) = a

instance PersistField a => PersistField (SqlArray a) where
   toPersistValue (SqlArray array) = PersistArray $ map toPersistValue array

   fromPersistValue (PersistArray array) = Right $ SqlArray $ rights $ map fromPersistValue array
   fromPersistValue (PersistList array) = Right $ SqlArray $ rights $ map fromPersistValue array
   fromPersistValue _ = Left "SqlArray values must be converted from PersistArray or PersistList"

instance PersistFieldSql a => PersistFieldSql (SqlArray a) where
   sqlType :: forall v. PersistFieldSql v => Proxy (SqlArray v) -> SqlType
   sqlType _ = SqlOther $ showSqlType (sqlType (Proxy :: Proxy v)) <> " ARRAY"

-- Util/SqlArrayOperators.hs
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

module Util.SqlArrayOperators where

import ClassyPrelude
import Database.Persist.Class
import Database.Persist.Types
import Util.SqlArray

infix 4 @>., <@.
(@>.) :: PersistField a => EntityField record (SqlArray a) -> [a] -> Filter record
(@>.) field arr = Filter field (FilterValue $ SqlArray arr) $ BackendSpecificFilter " @> "

(<@.) :: PersistField a => EntityField record (SqlArray a) -> [a] -> Filter record
(<@.) field arr = Filter field (FilterValue $ SqlArray arr) $ BackendSpecificFilter " <@ "

示例用法：

-- Model.hs
import Util.SqlArray
share [mkPersist ...

-- models.persistentmodels
...
Options
    Id Text
    optType OptionTypeId
    list (SqlArray Text)
...

-- Request handler code
...
-- options :: [Text]
runDB $ selectList [ OptionsList @>. options, ...] [ ... ]
...

【问题讨论】：

标签： arrays postgresql haskell yesod persistent

【解决方案1】：

Persistent 的维护人员对 https://github.com/yesodweb/persistent/pull/884 的工作内容有些困惑。它仅用于过滤查询，不提供完全支持。这里讨论了一些限制：https://github.com/yesodweb/persistent/pull/1077

也就是说，如果您的方法适用于像 Text 这样的类型，我不确定为什么它不适用于像 ProductId 这样的类型

【讨论】：