1

这可能是一个愚蠢的问题，我以某种方式忽略了具有低于标准 Google-fu 技能的现有内容，但是有没有办法使用 Persistent 创建一个新的文本字段，对该字段有唯一性约束，唯一性就是案例-麻木不仁？例如，假设我想创建一个唯一且没有重复的用户名字段，以便四个不同的用户无法创建撒旦、SATAN、撒旦和 SaTaN 用户名记录？

还是我必须依靠 Postgres 特定的功能并使用原始 SQL 来实现这一点？或者它是否可能在不使用原始 SQL 的情况下在 esqueleto 中完成？

更新 1：src/ModelTypes.hs我尝试在新搭建的Yesod站点中 添加 @MaxGabriel 的修订版并将其导入src/Model.hs. 为此，我似乎必须添加import Database.Persist.Sql以消除一个编译器错误，现在我在运行时遇到此错误 3 次yesod devel：

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为 usecitext时，它​​可以将新记录插入到数据库中，但是在尝试对用户进行身份验证时似乎不愿检索和转换该记录的类型。

更新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
    |                               ^^^^^^^^^^^^^^^^
4

1 回答 1

1

是的，这是可能的。从上面的 Carl 的评论中，将citext列类型用于不区分大小写的字符串类型，您可以使用类似这样的东西。

首先，添加 PersistField 和 PersistFieldSql 实例CI Text，不区分大小写Text。这必须在您使用 Template Haskell 声明持久模型的单独文件中完成。在这个文件中，你可以为 增加一个新类型Username，或者你可以CI Text直接在你的持久模型中使用。我推荐 newtype 方法以提高可读性。

{-# 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)

然后，将该文件导入到使用 Template 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)
于 2020-09-07T05:54:46.387 回答