First stab on implementing schema support

Author: arrowd

persistent-sqlite/Database/Persist/Sqlite.hs

@@ -299,7 +299,7 @@ wrapConnectionInfo connInfo conn logFunc = do
             , connCommit = helper "COMMIT"
             , connRollback = ignoreExceptions . helper "ROLLBACK"
             , connEscapeFieldName = escape . unFieldNameDB
-            , connEscapeTableName = escape . unEntityNameDB . getEntityDBName
+            , connEscapeTableName = \entDef -> prependSchemaAndEscape entDef $ getEntityDBName entDef
             , connEscapeRawName = escape
             , connNoLimit = "LIMIT -1"
             , connRDBMS = "sqlite"
@@ -490,7 +490,7 @@ mockMigration mig = do
                 , connCommit = helper "COMMIT"
                 , connRollback = ignoreExceptions . helper "ROLLBACK"
                 , connEscapeFieldName = escape . unFieldNameDB
-                , connEscapeTableName = escape . unEntityNameDB . getEntityDBName
+                , connEscapeTableName = \entDef -> prependSchemaAndEscape entDef $ getEntityDBName entDef
                 , connEscapeRawName = escape
                 , connNoLimit = "LIMIT -1"
                 , connRDBMS = "sqlite"
@@ -695,6 +695,13 @@ escape s =
     go '"' = "\"\""
     go c = T.singleton c
 
+prependSchemaAndEscape :: EntityDef -> EntityNameDB -> Text
+prependSchemaAndEscape entDef entDBName = case getEntityDBSchema entDef of
+    Nothing -> escapeE entDBName
+    Just "main" -> escapeE entDBName
+    Just "temp" -> escape "temp" <> "." <> escapeE entDBName
+    Just schema -> escape (schema <> "_" <> unEntityNameDB entDBName)
+
 putManySql :: EntityDef -> Int -> Text
 putManySql ent n = putManySql' conflictColumns (toList fields) ent n
   where

persistent-sqlite/test/Database/Persist/Sqlite/CompositeSpec.hs

@@ -24,6 +24,8 @@ import Control.Monad.Trans.Resource (MonadResource)
 import qualified Data.Conduit.List as CL
 import Conduit
 import Database.Persist.Sqlite
+import Database.Persist.SqlBackend.Internal
+import Database.Persist.EntityDef.Internal
 import System.IO (hClose)
 import Control.Exception (handle, IOException, throwIO)
 import System.IO.Temp (withSystemTempFile)
@@ -83,6 +85,15 @@ spec = describe "CompositeSpec" $ do
         runSqliteInfo connInfo $ do
             void $ runMigrationSilent compositeMigrateTest
             validateForeignKeys
+    it "test schema handling (issues #93 and #1454)" $ asIO $ runSqliteInfo (mkSqliteConnectionInfo ":memory:") $ do
+        backend <- ask
+        let tableName rec = connEscapeTableName backend (entityDef $ Just rec)
+            tableNameWithSchema schema rec = connEscapeTableName backend ((entityDef (Just rec)) { entitySchema = Just schema })
+
+        tableName (undefined :: SimpleComposite) @== "\"simple_composite\""
+        tableNameWithSchema "main" (undefined :: SimpleComposite) @== "\"simple_composite\""
+        tableNameWithSchema "temp" (undefined :: SimpleComposite) @== "\"temp\".\"simple_composite\""
+        tableNameWithSchema "foo" (undefined :: SimpleComposite) @== "\"foo_simple_composite\""
 
 
 validateForeignKeys

persistent/Database/Persist/EntityDef.hs

@@ -9,6 +9,7 @@ module Database.Persist.EntityDef
       -- * Accessors
     , getEntityHaskellName
     , getEntityDBName
+    , getEntityDBSchema
     , getEntityFields
     , getEntityFieldsDatabase
     , getEntityForeignDefs
@@ -86,6 +87,14 @@ getEntityDBName
     -> EntityNameDB
 getEntityDBName = entityDB
 
+-- | Return the database schema name for the given entity.
+--
+-- @since 2.14.4.5
+getEntityDBSchema
+    :: EntityDef
+    -> Maybe Text
+getEntityDBSchema = entitySchema
+
 getEntityExtra :: EntityDef -> Map Text [[Text]]
 getEntityExtra = entityExtra
 

persistent/Database/Persist/Quasi/Internal.hs

@@ -693,6 +693,7 @@ mkUnboundEntityDef ps parsedEntDef =
             EntityDef
                 { entityHaskell = entNameHS
                 , entityDB = entNameDB
+                , entitySchema = Nothing
                 -- idField is the user-specified Id
                 -- otherwise useAutoIdField
                 -- but, adjust it if the user specified a Primary

persistent/Database/Persist/Types/Base.hs

@@ -131,6 +131,8 @@ data EntityDef = EntityDef
     -- ^ The name of the entity as Haskell understands it.
     , entityDB      :: !EntityNameDB
     -- ^ The name of the database table corresponding to the entity.
+    , entitySchema  :: !(Maybe Text)
+    -- ^ The schema name of the database table.
     , entityId      :: !EntityIdDef
     -- ^ The entity's primary key or identifier.
     , entityAttrs   :: ![Attr]

persistent/test/Database/Persist/THSpec.hs

@@ -318,6 +318,7 @@ spec = describe "THSpec" $ do
                         EntityDef
                             { entityHaskell = EntityNameHS "HasSimpleCascadeRef"
                             , entityDB = EntityNameDB "HasSimpleCascadeRef"
+                            , entitySchema = Nothing
                             , entityId =
                                 EntityIdField FieldDef
                                     { fieldHaskell = FieldNameHS "Id"