Блог

Я новичок в Haskell и Yesod.

Я хочу использовать тип массива в серверной части PostgreSQL, и я нашел это в запросе на извлечениеhttps://github.com/yesodweb/persistent/pull/884 У Persistent теперь есть поддержка типа массива postgres через конструктор данных PersistArray (вместо интерпретации массива по умолчанию в Persistent как строки json), но я не смог найти, как его правильно использовать с помощью строительных лесов Yesod. Я собрал решение, которое позволяет мне иметь массив примитивных типов, но я не могу понять, как включить поддержку типов «внешнего ключа», например, типа ProductID, который генерируется из первичного ключа таблицы Product.

Я знаю, что могут использоваться простые списки (например, list [Text]), но persistent сохраняет его как строку 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