From af7183bffd9cca31bdff7e5f10de42c6e9dc076b Mon Sep 17 00:00:00 2001 From: Riuga Date: Thu, 13 Apr 2023 05:19:58 -0500 Subject: [PATCH 01/15] Update test case Check for idempotency of collate= migrations --- persistent-test/src/MigrationColumnLengthTest.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/persistent-test/src/MigrationColumnLengthTest.hs b/persistent-test/src/MigrationColumnLengthTest.hs index ac5ffed89..6224979a8 100644 --- a/persistent-test/src/MigrationColumnLengthTest.hs +++ b/persistent-test/src/MigrationColumnLengthTest.hs @@ -10,10 +10,11 @@ share [mkPersist sqlSettings, mkMigrate "migration"] [persistLowerCase| VaryingLengths field1 Int field2 T.Text sqltype=varchar(5) + field3 T.Text collate=en_US.utf8 |] specsWith :: MonadIO m => RunDb SqlBackend m -> Spec -specsWith runDb = +specsWith runDb = do it "is idempotent" $ runDb $ do again <- getMigration migration liftIO $ again @?= [] From 52470bb8b3bfa9a3b464aea0298124bb68f81d63 Mon Sep 17 00:00:00 2001 From: Riuga Date: Thu, 13 Apr 2023 05:22:54 -0500 Subject: [PATCH 02/15] Add collation field to `Column` type --- .../Database/Persist/Postgresql.hs | 27 ++++++++++++++----- persistent/Database/Persist/Sql/Internal.hs | 7 +++++ persistent/Database/Persist/Sql/Types.hs | 1 + 3 files changed, 28 insertions(+), 7 deletions(-) diff --git a/persistent-postgresql/Database/Persist/Postgresql.hs b/persistent-postgresql/Database/Persist/Postgresql.hs index 4dd2dcad5..1ca0b1dc5 100644 --- a/persistent-postgresql/Database/Persist/Postgresql.hs +++ b/persistent-postgresql/Database/Persist/Postgresql.hs @@ -771,6 +771,7 @@ getColumns getter def cols = do , ",numeric_precision " , ",numeric_scale " , ",character_maximum_length " + , ",collation_name " , "FROM information_schema.columns " , "WHERE table_catalog=current_database() " , "AND table_schema=current_schema() " @@ -903,6 +904,7 @@ getColumn getter tableName' [ PersistText columnName , numericPrecision , numericScale , maxlen + , collation ] refName_ = runExceptT $ do defaultValue' <- case defaultValue of @@ -943,6 +945,7 @@ getColumn getter tableName' [ PersistText columnName , cGenerated = fmap stripSuffixes generationExpression' , cDefaultConstraintName = Nothing , cMaxLen = Nothing + , cCollation = parseCollation collation , cReference = fmap (\(a,b,c,d) -> ColumnReference a b (mkCascade c d)) ref } @@ -954,6 +957,9 @@ getColumn getter tableName' [ PersistText columnName , fcOnDelete = parseCascade delText } + parseCollation (PersistText n) = Just (CollationName n) + parseCollation _ = Nothing + parseCascade txt = case txt of "NO ACTION" -> @@ -1084,11 +1090,11 @@ findAlters -- ^ The column that we're searching for potential alterations for. -> [Column] -> ([AlterColumn], [Column]) -findAlters defs edef col@(Column name isNull sqltype def _gen _defConstraintName _maxLen ref) cols = +findAlters defs edef col@(Column name isNull sqltype def _gen _defConstraintName _maxLen collation ref) cols = case List.find (\c -> cName c == name) cols of Nothing -> ([Add' col], cols) - Just (Column _oldName isNull' sqltype' def' _gen' _defConstraintName' _maxLen' ref') -> + Just (Column _oldName isNull' sqltype' def' _gen' _defConstraintName' _maxLen' collation' ref') -> let refDrop Nothing = [] refDrop (Just ColumnReference {crConstraintName=cname}) = [DropReference cname] @@ -1124,8 +1130,8 @@ findAlters defs edef col@(Column name isNull sqltype def _gen _defConstraintName Just s -> (:) (Update' col s) in up [NotNull col] _ -> [] - modType - | sqlTypeEq sqltype sqltype' = [] + modTypeAndCollation + | sqlTypeEq sqltype sqltype' && collation == collation' = [] -- When converting from Persistent pre-2.0 databases, we -- need to make sure that TIMESTAMP WITHOUT TIME ZONE is -- treated as UTC. @@ -1135,7 +1141,7 @@ findAlters defs edef col@(Column name isNull sqltype def _gen _defConstraintName , escapeF name , " AT TIME ZONE 'UTC'" ]] - | otherwise = [ChangeType col sqltype ""] + | otherwise = [ChangeType col sqltype collateExpr] modDef = if def == def' || isJust (T.stripPrefix "nextval" =<< def') @@ -1144,12 +1150,16 @@ findAlters defs edef col@(Column name isNull sqltype def _gen _defConstraintName case def of Nothing -> [NoDefault col] Just s -> [Default col s] + collateExpr + | collation == collation' = mempty + | otherwise = + maybe mempty (\c -> " COLLATE " <> escapeCl c) $ collation dropSafe = if safeToRemove edef name then error "wtf" [Drop col True] else [] in - ( modRef ++ modDef ++ modNull ++ modType ++ dropSafe + ( modRef ++ modDef ++ modNull ++ modTypeAndCollation ++ dropSafe , filter (\c -> cName c /= name) cols ) @@ -1194,7 +1204,7 @@ getAddReference allDefs entity cname cr@ColumnReference {crTableName = s, crCons return $ NEL.toList $ Util.dbIdColumnsEsc escapeF entDef showColumn :: Column -> Text -showColumn (Column n nu sqlType' def gen _defConstraintName _maxLen _ref) = T.concat +showColumn (Column n nu sqlType' def gen _defConstraintName _maxLen _collation _ref) = T.concat [ escapeF n , " " , showSqlType sqlType' @@ -1352,6 +1362,9 @@ fieldName = escapeF . fieldDBName escapeC :: ConstraintNameDB -> Text escapeC = escapeWith escape +escapeCl :: CollationName -> Text +escapeCl = escapeWith escape + escapeE :: EntityNameDB -> Text escapeE = escapeWith escape diff --git a/persistent/Database/Persist/Sql/Internal.hs b/persistent/Database/Persist/Sql/Internal.hs index c8e099fee..7947ca308 100644 --- a/persistent/Database/Persist/Sql/Internal.hs +++ b/persistent/Database/Persist/Sql/Internal.hs @@ -129,6 +129,7 @@ mkColumns allDefs t overrides = , cGenerated = fieldGenerated fd , cDefaultConstraintName = Nothing , cMaxLen = maxLen $ fieldAttrs fd + , cCollation = collation $ fieldAttrs fd , cReference = mkColumnReference fd } @@ -148,6 +149,7 @@ mkColumns allDefs t overrides = , cGenerated = fieldGenerated fd , cDefaultConstraintName = Nothing , cMaxLen = maxLen $ fieldAttrs fd + , cCollation = collation $ fieldAttrs fd , cReference = mkColumnReference fd } @@ -156,6 +158,11 @@ mkColumns allDefs t overrides = FieldAttrMaxlen n -> Just n _ -> Nothing + collation :: [FieldAttr] -> Maybe CollationName + collation = findMaybe $ \case + FieldAttrCollate n -> Just (CollationName n) + _ -> Nothing + refNameFn = fromMaybe refName (backendSpecificForeignKeyName overrides) mkColumnReference :: FieldDef -> Maybe ColumnReference diff --git a/persistent/Database/Persist/Sql/Types.hs b/persistent/Database/Persist/Sql/Types.hs index a9f592d86..8793f0362 100644 --- a/persistent/Database/Persist/Sql/Types.hs +++ b/persistent/Database/Persist/Sql/Types.hs @@ -27,6 +27,7 @@ data Column = Column , cGenerated :: !(Maybe Text) , cDefaultConstraintName :: !(Maybe ConstraintNameDB) , cMaxLen :: !(Maybe Integer) + , cCollation :: !(Maybe CollationName) , cReference :: !(Maybe ColumnReference) } deriving (Eq, Ord, Show) From ea4c1f2681aa825be747df26ce20370d6e810432 Mon Sep 17 00:00:00 2001 From: Riuga Date: Thu, 13 Apr 2023 05:24:17 -0500 Subject: [PATCH 03/15] Comment on sqltype/automigration type desync bug --- .../Database/Persist/Postgresql.hs | 3 ++- persistent/Database/Persist/TH.hs | 14 ++++++++++++++ 2 files changed, 16 insertions(+), 1 deletion(-) diff --git a/persistent-postgresql/Database/Persist/Postgresql.hs b/persistent-postgresql/Database/Persist/Postgresql.hs index 1ca0b1dc5..0c9ceedb0 100644 --- a/persistent-postgresql/Database/Persist/Postgresql.hs +++ b/persistent-postgresql/Database/Persist/Postgresql.hs @@ -1031,7 +1031,8 @@ getColumn getter tableName' [ PersistText columnName , " but got: " , show xs ] - + -- TODO: Refactor this for reuse outside of migration + -- autogenerator getType "int4" = pure SqlInt32 getType "int8" = pure SqlInt64 getType "varchar" = pure SqlString diff --git a/persistent/Database/Persist/TH.hs b/persistent/Database/Persist/TH.hs index a6ac5d7a0..8124fbd46 100644 --- a/persistent/Database/Persist/TH.hs +++ b/persistent/Database/Persist/TH.hs @@ -605,6 +605,20 @@ bindCompositeDef ued ucd = do } |] +-- | TODO: This should call the same `getType` used +-- in the migration autogenerator before assigning +-- something as SqlOther, ex.: +-- +-- > email Text +-- ...is assigned to SqlString, whereas: +-- +-- > email Text sqltype=text +-- ...is assigned to (SqlOther "text") because of this function. +-- +-- ...even though all `text` columns get parsed to SqlString +-- anyway during migration autogeneration. +-- +-- ...thereby perpetually forcing an unnecessary migration. getSqlType :: M.Map EntityNameHS a -> EntityMap -> UnboundFieldDef -> SqlTypeExp getSqlType emEntities entityMap field = maybe From 09db8f08a1608c6dee717deb672a50956d2d313b Mon Sep 17 00:00:00 2001 From: Riuga Date: Thu, 13 Apr 2023 05:25:46 -0500 Subject: [PATCH 04/15] Add `CollationName` type --- persistent/Database/Persist/Names.hs | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/persistent/Database/Persist/Names.hs b/persistent/Database/Persist/Names.hs index 5616e627c..18ea8a724 100644 --- a/persistent/Database/Persist/Names.hs +++ b/persistent/Database/Persist/Names.hs @@ -29,6 +29,17 @@ newtype FieldNameDB = FieldNameDB { unFieldNameDB :: Text } instance DatabaseName FieldNameDB where escapeWith f (FieldNameDB n) = f n +-- | A 'CollationName' represents the name of a collation that @persistent@ +-- will associate with a particular field. +-- +-- @since 2.15.0.0 +newtype CollationName = CollationName { unCollatioName :: Text } + deriving (Show, Eq, Read, Ord, Lift) + +-- | @since 2.15.0.0 +instance DatabaseName CollationName where + escapeWith f (CollationName n) = f n + -- | A 'FieldNameHS' represents the Haskell-side name that @persistent@ -- will use for a field. -- From 6d680a258d5dfb2fd321f1c53b67faab29114f31 Mon Sep 17 00:00:00 2001 From: Riuga Date: Thu, 13 Apr 2023 05:26:18 -0500 Subject: [PATCH 05/15] Add `collate=` field attribute flag --- persistent/Database/Persist/Types/Base.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/persistent/Database/Persist/Types/Base.hs b/persistent/Database/Persist/Types/Base.hs index b17def38b..f4a77a9cd 100644 --- a/persistent/Database/Persist/Types/Base.hs +++ b/persistent/Database/Persist/Types/Base.hs @@ -349,6 +349,13 @@ data FieldAttr -- User -- uuid Text sqltype="UUID" -- @ + | FieldAttrCollate Text + -- ^ Specify the (custom) collation used for the column. + -- + -- @ + -- Email + -- address Text collate="lowercase" + -- @ | FieldAttrMaxlen Integer -- ^ Set a maximum length for a column. Useful for VARCHAR and indexes. -- @@ -389,6 +396,7 @@ parseFieldAttrs = fmap $ \case | Just x <- T.stripPrefix "constraint=" raw -> FieldAttrConstraint x | Just x <- T.stripPrefix "default=" raw -> FieldAttrDefault x | Just x <- T.stripPrefix "sqltype=" raw -> FieldAttrSqltype x + | Just x <- T.stripPrefix "collate=" raw -> FieldAttrCollate x | Just x <- T.stripPrefix "maxlen=" raw -> case reads (T.unpack x) of [(n, s)] | all isSpace s -> FieldAttrMaxlen n _ -> error $ "Could not parse maxlen field with value " <> show raw From e00be59d64606280f92473c58012015df9d1e041 Mon Sep 17 00:00:00 2001 From: Riuga Date: Thu, 13 Apr 2023 06:00:09 -0500 Subject: [PATCH 06/15] Add MySQL collation support --- persistent-mysql/Database/Persist/MySQL.hs | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/persistent-mysql/Database/Persist/MySQL.hs b/persistent-mysql/Database/Persist/MySQL.hs index 76e01a81a..3307859c9 100644 --- a/persistent-mysql/Database/Persist/MySQL.hs +++ b/persistent-mysql/Database/Persist/MySQL.hs @@ -618,7 +618,8 @@ getColumns connectInfo getter def cols = do , "NUMERIC_PRECISION, " , "NUMERIC_SCALE, " , "COLUMN_DEFAULT, " - , "GENERATION_EXPRESSION " + , "GENERATION_EXPRESSION, " + , "COLLATION_NAME " , "FROM INFORMATION_SCHEMA.COLUMNS " , "WHERE TABLE_SCHEMA = ? " , "AND TABLE_NAME = ? " @@ -690,6 +691,7 @@ getColumn connectInfo getter tname [ PersistText cname , colScale , default' , generated + , collation ] cRef = fmap (either (Left . pack) Right) $ runExceptT $ do @@ -752,9 +754,13 @@ getColumn connectInfo getter tname [ PersistText cname , cGenerated = generated_ , cDefaultConstraintName = Nothing , cMaxLen = maxLen + , cCollation = parseCollation collation , cReference = ref } where + parseCollation (PersistText n) = Just (CollationName n) + parseCollation _ = Nothing + getRef Nothing = return Nothing getRef (Just refName') = do -- Foreign key (if any) @@ -916,7 +922,7 @@ findAlters -> Column -> [Column] -> ([AlterColumn], [Column]) -findAlters edef allDefs col@(Column name isNull type_ def gen _defConstraintName maxLen ref) cols = +findAlters edef allDefs col@(Column name isNull type_ def gen _defConstraintName maxLen collation ref) cols = case filter ((name ==) . cName) cols of -- new fkey that didn't exist before [] -> @@ -928,7 +934,7 @@ findAlters edef allDefs col@(Column name isNull type_ def gen _defConstraintName cnstr = [addReference allDefs cname tname name (crFieldCascade cr)] in (Add' col : cnstr, cols) - Column _ isNull' type_' def' gen' _defConstraintName' maxLen' ref' : _ -> + Column _ isNull' type_' def' gen' _defConstraintName' maxLen' collation ref' : _ -> let -- Foreign key refDrop = case (ref == ref', ref') of @@ -985,7 +991,7 @@ showAlterColumn :: Column -> String showAlterColumn = showColumn True showColumn :: Bool -> Column -> String -showColumn showReferences (Column n nu t def gen _defConstraintName maxLen ref) = concat +showColumn showReferences (Column n nu t def gen _defConstraintName maxLen _collation ref) = concat [ escapeF n , " " , showSqlType t maxLen True @@ -1078,14 +1084,14 @@ showAlterTable table (DropUniqueConstraint cname) = concat -- | Render an action that must be done on a column. showAlter :: EntityNameDB -> AlterColumn -> String -showAlter table (Change (Column n nu t def gen defConstraintName maxLen _ref)) = +showAlter table (Change (Column n nu t def gen defConstraintName maxLen collation _ref)) = concat [ "ALTER TABLE " , escapeE table , " CHANGE " , escapeF n , " " - , showAlterColumn (Column n nu t def gen defConstraintName maxLen Nothing) + , showAlterColumn (Column n nu t def gen defConstraintName maxLen collation Nothing) ] showAlter table (Add' col) = concat From 369c330ed7209c8912478293043a49627c9c11ba Mon Sep 17 00:00:00 2001 From: Riuga Date: Thu, 13 Apr 2023 06:08:02 -0500 Subject: [PATCH 07/15] Add collation support for SQLite --- persistent-sqlite/Database/Persist/Sqlite.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/persistent-sqlite/Database/Persist/Sqlite.hs b/persistent-sqlite/Database/Persist/Sqlite.hs index ccfecd605..d186ad4cd 100644 --- a/persistent-sqlite/Database/Persist/Sqlite.hs +++ b/persistent-sqlite/Database/Persist/Sqlite.hs @@ -625,7 +625,7 @@ mayGenerated gen = case gen of Just g -> " GENERATED ALWAYS AS (" <> g <> ") STORED" sqlColumn :: Bool -> Column -> Text -sqlColumn noRef (Column name isNull typ def gen _cn _maxLen ref) = T.concat +sqlColumn noRef (Column name isNull typ def gen _cn _maxLen _collation ref) = T.concat [ "," , escapeF name , " " From 20a0265ee776336b4c2132c48d4103dc58309683 Mon Sep 17 00:00:00 2001 From: Isaac van Bakel Date: Fri, 24 Mar 2023 12:43:11 +0000 Subject: [PATCH 08/15] Bump persistent-sqlite version, add @since tags --- persistent-sqlite/Database/Persist/Sqlite.hs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/persistent-sqlite/Database/Persist/Sqlite.hs b/persistent-sqlite/Database/Persist/Sqlite.hs index d186ad4cd..ad3f6c844 100644 --- a/persistent-sqlite/Database/Persist/Sqlite.hs +++ b/persistent-sqlite/Database/Persist/Sqlite.hs @@ -938,6 +938,22 @@ data RawSqlite backend = RawSqlite , _rawSqliteConnection :: Sqlite.Connection -- ^ The underlying `Sqlite.Connection` } +-- | Open a @'RawSqlite' 'SqlBackend'@ connection from a 'SqliteConnectionInfo'. +-- +-- When using this function, the caller has to accept the responsibility of +-- cleaning up the resulting connection. To do this, use 'close' with the +-- 'rawSqliteConnection' - it's enough to simply drop the 'persistBackend' +-- afterwards. +-- +-- @since 2.13.2 +openRawSqliteConn + :: (MonadUnliftIO m, MonadLoggerIO m) + => SqliteConnectionInfo + -> m (RawSqlite SqlBackend) +openRawSqliteConn connInfo = do + logFunc <- askLoggerIO + liftIO $ openWith RawSqlite connInfo logFunc + instance BackendCompatible b (RawSqlite b) where projectBackend = _persistentBackend From 14fd7a0145c3d561412e5e95631693fb2e295441 Mon Sep 17 00:00:00 2001 From: Isaac van Bakel Date: Fri, 24 Mar 2023 12:43:11 +0000 Subject: [PATCH 09/15] Run stylish-haskell on Database.Persist.Sqlite --- persistent-sqlite/Database/Persist/Sqlite.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/persistent-sqlite/Database/Persist/Sqlite.hs b/persistent-sqlite/Database/Persist/Sqlite.hs index ad3f6c844..81d26ef37 100644 --- a/persistent-sqlite/Database/Persist/Sqlite.hs +++ b/persistent-sqlite/Database/Persist/Sqlite.hs @@ -94,8 +94,8 @@ import qualified Data.Conduit.Combinators as C import qualified Data.Conduit.List as CL import Data.Foldable (toList) import qualified Data.HashMap.Lazy as HashMap -import Data.Int (Int64) import Data.IORef (newIORef) +import Data.Int (Int64) import Data.Maybe import Data.Pool (Pool) import Data.Text (Text) From 39a6469b108601d2e158fc7454bb1f8297dd352e Mon Sep 17 00:00:00 2001 From: Isaac van Bakel Date: Fri, 24 Mar 2023 12:43:11 +0000 Subject: [PATCH 10/15] Add openRawSqliteConn to persistent-sqlite ChangeLog.md --- persistent-sqlite/ChangeLog.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/persistent-sqlite/ChangeLog.md b/persistent-sqlite/ChangeLog.md index fcfbcf3b7..26e18d138 100644 --- a/persistent-sqlite/ChangeLog.md +++ b/persistent-sqlite/ChangeLog.md @@ -11,6 +11,11 @@ * Add `SqlBackendHooks` to allow for instrumentation of queries. * [#1327](https://github.com/yesodweb/persistent/pull/1327) * Update backend to support new `StatementCache` interface +* [#1488](https://github.com/yesodweb/persistent/pull/1488) + * Add `openRawSqliteConn` for creating `RawSqlite SqlBackend` connections + that aren't automatically cleaned-up. +* [#1459](https://github.com/yesodweb/persistent/pull/1459) + * Make use of `CautiousMigration` type alias for clarity. ## 2.13.0.4 From 00f6e9b51576c4592a380ecc206e37b6ec7924d7 Mon Sep 17 00:00:00 2001 From: Riuga Date: Thu, 13 Apr 2023 10:03:30 -0500 Subject: [PATCH 11/15] Expose openRawSqliteConn --- persistent-sqlite/Database/Persist/Sqlite.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/persistent-sqlite/Database/Persist/Sqlite.hs b/persistent-sqlite/Database/Persist/Sqlite.hs index 81d26ef37..4501bbdb4 100644 --- a/persistent-sqlite/Database/Persist/Sqlite.hs +++ b/persistent-sqlite/Database/Persist/Sqlite.hs @@ -50,6 +50,7 @@ module Database.Persist.Sqlite , RawSqlite , persistentBackend , rawSqliteConnection + , openRawSqliteConn , withRawSqliteConnInfo , createRawSqlitePoolFromInfo , createRawSqlitePoolFromInfo_ From 531def11ac58157201a1ea2886efecd5664d809a Mon Sep 17 00:00:00 2001 From: Riuga Date: Fri, 14 Apr 2023 04:57:03 -0500 Subject: [PATCH 12/15] Add collate clause support to showColumn This lets the initial CREATE TABLE expression generate correctly with the collate clause, eliding the need for an immediate automigration to collate columns. --- persistent-postgresql/Database/Persist/Postgresql.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/persistent-postgresql/Database/Persist/Postgresql.hs b/persistent-postgresql/Database/Persist/Postgresql.hs index 0c9ceedb0..b915cef83 100644 --- a/persistent-postgresql/Database/Persist/Postgresql.hs +++ b/persistent-postgresql/Database/Persist/Postgresql.hs @@ -1205,10 +1205,11 @@ getAddReference allDefs entity cname cr@ColumnReference {crTableName = s, crCons return $ NEL.toList $ Util.dbIdColumnsEsc escapeF entDef showColumn :: Column -> Text -showColumn (Column n nu sqlType' def gen _defConstraintName _maxLen _collation _ref) = T.concat +showColumn (Column n nu sqlType' def gen _defConstraintName _maxLen collation _ref) = T.concat [ escapeF n , " " , showSqlType sqlType' + , maybe mempty (\c -> " COLLATE " <> escapeCl c) collation , " " , if nu then "NULL" else "NOT NULL" , case def of From 67fa4d97ab6b75400bebce4ff6358e38da6d4239 Mon Sep 17 00:00:00 2001 From: Riuga Date: Thu, 11 May 2023 01:48:08 -0500 Subject: [PATCH 13/15] Add collate support to sqlite --- persistent-sqlite/Database/Persist/Sqlite.hs | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/persistent-sqlite/Database/Persist/Sqlite.hs b/persistent-sqlite/Database/Persist/Sqlite.hs index 4501bbdb4..8c360d5b3 100644 --- a/persistent-sqlite/Database/Persist/Sqlite.hs +++ b/persistent-sqlite/Database/Persist/Sqlite.hs @@ -609,12 +609,18 @@ mkCreateTable isTemp entity (cols, uniqs, fdefs) = , " " , showSqlType $ fieldSqlType fd , " PRIMARY KEY" + , mayCollate $ collation $ fieldAttrs fd , mayDefault $ defaultAttribute $ fieldAttrs fd , T.concat $ map (sqlColumn isTemp) nonIdCols ] nonIdCols = filter (\c -> Just (cName c) /= fmap fieldDB (getEntityIdField entity)) cols +mayCollate :: Maybe CollationName -> Text +mayCollate c = case c of + Nothing -> "" + Just c -> " COLLATE " <> escapeCl c + mayDefault :: Maybe Text -> Text mayDefault def = case def of Nothing -> "" @@ -626,12 +632,13 @@ mayGenerated gen = case gen of Just g -> " GENERATED ALWAYS AS (" <> g <> ") STORED" sqlColumn :: Bool -> Column -> Text -sqlColumn noRef (Column name isNull typ def gen _cn _maxLen _collation ref) = T.concat +sqlColumn noRef (Column name isNull typ def gen _cn _maxLen collation ref) = T.concat [ "," , escapeF name , " " , showSqlType typ , if isNull then " NULL" else " NOT NULL" + , mayCollate collation , mayDefault def , mayGenerated gen , case ref of @@ -682,6 +689,9 @@ sqlUnique (UniqueDef _ cname cols _) = T.concat escapeC :: ConstraintNameDB -> Text escapeC = escapeWith escape +escapeCl :: CollationName -> Text +escapeCl = escapeWith escape + escapeE :: EntityNameDB -> Text escapeE = escapeWith escape From 648281122551d450136203f3fec74a557c023dfa Mon Sep 17 00:00:00 2001 From: Riuga Date: Thu, 11 May 2023 01:49:10 -0500 Subject: [PATCH 14/15] Expose collation field attr extraction --- persistent/Database/Persist/Sql.hs | 1 + persistent/Database/Persist/Sql/Internal.hs | 11 ++++++----- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/persistent/Database/Persist/Sql.hs b/persistent/Database/Persist/Sql.hs index 32bba1021..5c9ba7a77 100644 --- a/persistent/Database/Persist/Sql.hs +++ b/persistent/Database/Persist/Sql.hs @@ -53,6 +53,7 @@ module Database.Persist.Sql , getBackendSpecificForeignKeyName , setBackendSpecificForeignKeyName , defaultAttribute + , collation -- * Internal , IsolationLevel(..) , decorateSQLWithLimitOffset diff --git a/persistent/Database/Persist/Sql/Internal.hs b/persistent/Database/Persist/Sql/Internal.hs index 7947ca308..3c0cb717e 100644 --- a/persistent/Database/Persist/Sql/Internal.hs +++ b/persistent/Database/Persist/Sql/Internal.hs @@ -7,6 +7,7 @@ module Database.Persist.Sql.Internal ( mkColumns , defaultAttribute + , collation , BackendSpecificOverrides(..) , getBackendSpecificForeignKeyName , setBackendSpecificForeignKeyName @@ -74,6 +75,11 @@ defaultAttribute = findMaybe $ \case FieldAttrDefault x -> Just x _ -> Nothing +collation :: [FieldAttr] -> Maybe CollationName +collation = findMaybe $ \case + FieldAttrCollate n -> Just (CollationName n) + _ -> Nothing + -- | Create the list of columns for the given entity. mkColumns :: [EntityDef] @@ -158,11 +164,6 @@ mkColumns allDefs t overrides = FieldAttrMaxlen n -> Just n _ -> Nothing - collation :: [FieldAttr] -> Maybe CollationName - collation = findMaybe $ \case - FieldAttrCollate n -> Just (CollationName n) - _ -> Nothing - refNameFn = fromMaybe refName (backendSpecificForeignKeyName overrides) mkColumnReference :: FieldDef -> Maybe ColumnReference From dd9ecee0094f265eaf868eb49b26bbd8b03387de Mon Sep 17 00:00:00 2001 From: Isaac van Bakel Date: Fri, 24 Mar 2023 12:43:11 +0000 Subject: [PATCH 15/15] Add openRawSqliteConn to Database.Persist.Sqlite This new function allows for creating a `RawSqlite SqlBackend` manually (without exposing the `RawSqlite` constructor) for code that wants to open such a connection without having to opt-in to the resource management of `withRawSqliteConnInfo` and co. This is useful in my particular use case for creating a custom pool, since I am not constrained by the `resource-pool` API re-exposed by `persistent-sqlite`. --- persistent-sqlite/Database/Persist/Sqlite.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/persistent-sqlite/Database/Persist/Sqlite.hs b/persistent-sqlite/Database/Persist/Sqlite.hs index 8c360d5b3..d1ffce9ea 100644 --- a/persistent-sqlite/Database/Persist/Sqlite.hs +++ b/persistent-sqlite/Database/Persist/Sqlite.hs @@ -48,6 +48,7 @@ module Database.Persist.Sqlite , ForeignKeyViolation(..) , checkForeignKeys , RawSqlite + , openRawSqliteConn , persistentBackend , rawSqliteConnection , openRawSqliteConn