问题描述
这可能是一个愚蠢的问题，我以某种程度的Google-fu技巧忽略了现有内容，但是有一种方法可以使用Persistent创建一个新的Text字段，该字段具有唯一性约束，因此该唯一性不区分大小写吗？例如，假设我要创建一个唯一的用户名字段，且没有重复项，以使四个不同的用户无法创建Satan，Satan，satan和Satan用户名记录？
还是我必须依靠Postgres特有的功能并使用原始sql来实现这一目标？还是可以在esqueleto中完成而无需使用原始sql？
更新1：
我尝试在新的 scaffolded Yesod网站中将@MaxGabriel的修订版本添加为src/ModelTypes.hs，并将其导入src/Model.hs中。为此，我似乎不得不添加import Database.Persist.sql来摆脱一个编译器错误，现在我在运行yesod devel时遇到了3次此错误：
Not in scope: type constructor or class ‘Text’
Perhaps you meant ‘T.Text’ (imported from Data.Text)
在config/models.persistentmodels中尚未更新脚手架的用户模型（由虚拟身份验证使用）以使用新的Username类型...
User
ident Text
password Text Maybe
UniqueUser ident
deriving Typeable
...但是在先前尝试简单地将ident更改为使用citext的情况下，将新记录插入db是可行的，但随后似乎在检索和转换尝试对用户进行身份验证时该记录。
更新2：
将import Data.Text (Text)添加到ModelTypes.hs
>>> stack exec -- yesod devel
Yesod devel server. Enter 'quit' or hit Ctrl-C to quit.
Application can be accessed at:
http://localhost:3000
https://localhost:3443
If you wish to test https capabilities,you should set the following variable:
export APPROOT=https://localhost:3443
uniqueci> configure (lib)
Configuring uniqueci-0.0.0...
uniqueci> build (lib)
Preprocessing library for uniqueci-0.0.0..
Building library for uniqueci-0.0.0..
[ 4 of 13] Compiling ModelTypes
/zd/pj/yesod/uniqueci/src/ModelTypes.hs:16:10: error:
• Illegal instance declaration for ‘PersistField (CI Text)’
(All instance types must be of the form (T a1 ... an)
where a1 ... an are *distinct type variables*,and each type variable appears at most once in the instance head.
Use FlexibleInstances if you want to disable this.)
• In the instance declaration for ‘PersistField (CI Text)’
|
16 | instance PersistField (CI Text) where
| ^^^^^^^^^^^^^^^^^^^^^^
/zd/pj/yesod/uniqueci/src/ModelTypes.hs:21:10: error:
• Illegal instance declaration for ‘PersistFieldsql (CI Text)’
(All instance types must be of the form (T a1 ... an)
where a1 ... an are *distinct type variables*,and each type variable appears at most once in the instance head.
Use FlexibleInstances if you want to disable this.)
• In the instance declaration for ‘PersistFieldsql (CI Text)’
|
21 | instance PersistFieldsql (CI Text) where
| ^^^^^^^^^^^^^^^^^^^^^^^^^
-- While building package uniqueci-0.0.0 using:
/zd/hngnr/.stack_sym_ngnr/setup-exe-cache/x86_64-linux-tinfo6/Cabal-simple_mPHDZzAJ_3.0.1.0_ghc-8.8.4 --builddir=.stack-work/dist/x86_64-linux-tinfo6/Cabal-3.0.1.0 build lib:uniqueci --ghc-options ""
Process exited with code: ExitFailure 1
Type help for available commands. Press enter to force a rebuild.
更新3：
将{-# LANGUAGE FlexibleInstances #-}添加到ModelType.hs之后，上述错误消失了。尝试在脚手架Username模型中使用新的User类型
-- config/models.persistentmodels
User
ident Username -- default is ident Text
password Text Maybe
UniqueUser ident
deriving Typeable
Email
email Text
userId UserId Maybe
verkey Text Maybe
UniqueEmail email
Comment json -- Adding "json" causes ToJSON and FromJSON instances to be derived.
message Text
userId UserId Maybe
deriving Eq
deriving Show
发生新错误：
[ 2 of 13] Compiling Model [config/models.persistentmodels changed]
[ 7 of 13] Compiling Foundation
/zd/pj/yesod/uniqueci/src/Foundation.hs:251:35: error:
• Couldn't match expected type ‘ModelTypes.Username’
with actual type ‘Text’
• In the second argument of ‘($)’,namely ‘credsIdent creds’
In the second argument of ‘($)’,namely
‘UniqueUser $ credsIdent creds’
In a stmt of a 'do' block:
x <- getBy $ UniqueUser $ credsIdent creds
|
251 | x <- getBy $ UniqueUser $ credsIdent creds
| ^^^^^^^^^^^^^^^^
/zd/pj/yesod/uniqueci/src/Foundation.hs:255:31: error:
• Couldn't match expected type ‘ModelTypes.Username’
with actual type ‘Text’
• In the ‘userIdent’ field of a record
In the first argument of ‘insert’,namely
‘User {userIdent = credsIdent creds,userPassword = nothing}’
In the second argument of ‘(<$>)’,namely
‘insert
User {userIdent = credsIdent creds,userPassword = nothing}’
|
255 | { userIdent = credsIdent creds
| ^^^^^^^^^^^^^^^^
解决方法
是的，那是可能的。从上面使用卡尔的注释（使用citext列类型作为不区分大小写的字符串类型）中，您可以使用类似的内容。
首先，为CI Text添加PersistField和PersistFieldSql实例，该实例不区分大小写Text。这必须在一个单独的文件中完成，该文件与使用Template Haskell声明持久模型的位置不同。在此文件中，您可以为Username添加新类型，也可以在持久性模型中直接使用CI Text。我建议使用新型方法以提高可读性。
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
module ModelTypes where
import Database.Persist
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
-- Add the case-insensitive package for this:
import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI
instance PersistField (CI Text) where
toPersistValue ciText = PersistDbSpecific $ TE.encodeUtf8 (CI.original ciText)
fromPersistValue (PersistDbSpecific bs) = Right $ CI.mk (TE.decodeUtf8 bs)
fromPersistValue x = Left . T.pack $ "When Expected PersistDbSpecific,received: " ++ show x
instance PersistFieldSql (CI Text) where
sqlType _ = SqlOther "citext"
newtype Username = Username {unUsername :: CI Text}
deriving stock (Show)
deriving newtype (Eq,Ord,PersistField,PersistFieldSql)
然后，将该文件导入到使用模板Haskell加载持久性模型的文件中：
#!/usr/bin/env stack
{- stack
--resolver lts-15
--install-ghc
runghc
--package persistent
--package persistent-postgresql
--package persistent-template
--package network
--package mtl
-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runStderrLoggingT)
import Database.Persist
import Database.Persist.Postgresql
import Database.Persist.TH
import ModelTypes
share
[mkPersist sqlSettings,mkMigrate "migrateAll"]
[persistLowerCase|
Person
name Username
UniqueName name
deriving Show
|]
connStr = "host=localhost dbname=test user=postgres password=postgres port=5433"
main :: IO ()
main =
runStderrLoggingT $
withPostgresqlPool connStr 10 $
\pool ->
liftIO $
do flip runSqlPersistMPool pool $
do runMigration migrateAll
johnId <- insert $ Person (Username "John Doe")
liftIO $ print johnId
return ()
但是请注意，在执行代码之前，您需要为数据库创建扩展名：
test=# \c test
test=# CREATE EXTENSION citext;
CREATE EXTENSION
然后您可以执行代码：
$ stack postgres.hs
Migrating: CREATe TABLE "person"("id" SERIAL8 PRIMARY KEY UNIQUE,"name" citext NOT NULL)
[Debug#SQL] CREATe TABLE "person"("id" SERIAL8 PRIMARY KEY UNIQUE,"name" citext NOT NULL); []
Migrating: ALTER TABLE "person" ADD CONSTRAINT "unique_name" UNIQUE("name")
[Debug#SQL] ALTER TABLE "person" ADD CONSTRAINT "unique_name" UNIQUE("name"); []
[Debug#SQL] INSERT INTO "person"("name") VALUES(?) RETURNING "id"; [PersistText "John Doe"]
SqlBackendKey {unSqlBackendKey = 1}
然后您可以去检查数据库以确认确实创建了citext列：
test=# \d person;
Table "public.person"
Column | Type | Collation | Nullable | Default
--------+--------+-----------+----------+------------------------------------
id | bigint | | not null | nextval('person_id_seq'::regclass)
name | citext | | not null |
Indexes:
"person_pkey" PRIMARY KEY,btree (id)
"unique_name" UNIQUE CONSTRAINT,btree (name)