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

编程问答 2022-08-15

问题描述

我是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,...] [ ... ]
...

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

arraysarrayshaskellhaskellpersistentyesod