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

问题描述

我是Haskell和Yesod的新手。

我想在Postgresql后端中使用数组类型，我发现在拉取请求https://github.com/yesodweb/persistent/pull/884中，Persistent现在通过 PersistArray 数据构造函数支持postgres数组类型，（而不是Persistent的默认设置）将数组解释为json字符串），但我无法在Yesod的脚手架上找到正确使用的方法。 我提出了一个解决方案，使我可以拥有原始类型的数组，但我不知道如何启用对“外键”类型的支持，例如类型ProductId，它是从表Product的主键生成的。

我知道可以使用简单列表（例如列表[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,...] [ ... ]
...

解决方法

Persistent的维护者对https://github.com/yesodweb/persistent/pull/884的成就感到困惑。它仅用于过滤查询，并不提供完全支持。这里讨论了一些限制：https://github.com/yesodweb/persistent/pull/1077

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