Merge branch 'master' into custom-keyword-modifier

persistent-mongoDB/persistent-mongoDB.cabal

@@ -26,7 +26,7 @@ library
                    , bytestring
                    , cereal             >= 0.5
                    , conduit            >= 1.2
-                   , http-api-data      >= 0.3.7     && < 0.6
+                   , http-api-data      >= 0.3.7     && < 0.7
                    , mongoDB            >= 2.3       && < 2.8
                    , network            >= 2.6
                    , path-pieces        >= 0.2

persistent-postgresql/ChangeLog.md

@@ -1,5 +1,19 @@
 # Changelog for persistent-postgresql
 
+## 2.13.6.1
+
+* [#1518](https://github.com/yesodweb/persistent/pull/1518)
+    * Normalize postgres type aliases to prevent noop migrations
+
+## 2.13.6
+
+* [#1511](https://github.com/yesodweb/persistent/pull/1511)
+   * Add the `createPostgresqlPoolTailored` function to support creating
+     connection pools with a custom connection creation function.
+   * Expose `getServerVersion` and `createBackend` for user's convenience.
+* [#1516](https://github.com/yesodweb/persistent/pull/1516)
+   * Support postgresql-simple 0.7 and postgresql-libpq 0.10
+
 ## 2.13.5.2
 
 * [#1471](https://github.com/yesodweb/persistent/pull/1471)

persistent-postgresql/Database/Persist/Postgresql.hs

@@ -37,6 +37,7 @@ module Database.Persist.Postgresql
     , createPostgresqlPool
     , createPostgresqlPoolModified
     , createPostgresqlPoolModifiedWithVersion
+    , createPostgresqlPoolTailored
     , createPostgresqlPoolWithConf
     , module Database.Persist.Sql
     , ConnectionString
@@ -52,6 +53,7 @@ module Database.Persist.Postgresql
     , upsertManyWhere
     , openSimpleConn
     , openSimpleConnWithVersion
+    , getServerVersion
     , getSimpleConn
     , tableName
     , fieldName
@@ -65,6 +67,7 @@ module Database.Persist.Postgresql
     , createRawPostgresqlPoolModified
     , createRawPostgresqlPoolModifiedWithVersion
     , createRawPostgresqlPoolWithConf
+    , createBackend
     ) where
 
 import qualified Database.PostgreSQL.LibPQ as LibPQ
@@ -82,8 +85,8 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Unlift (MonadIO(..), MonadUnliftIO)
 import Control.Monad.Logger (MonadLoggerIO, runNoLoggingT)
-import Control.Monad.Trans.Reader (ReaderT(..), asks, runReaderT)
 import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.Reader (ReaderT(..), asks, runReaderT)
 #if !MIN_VERSION_base(4,12,0)
 import Control.Monad.Trans.Reader (withReaderT)
 #endif
@@ -102,8 +105,8 @@ import qualified Data.Conduit.List as CL
 import Data.Data (Data)
 import Data.Either (partitionEithers)
 import Data.Function (on)
-import Data.IORef
 import Data.Int (Int64)
+import Data.IORef
 import Data.List (find, foldl', groupBy, sort)
 import qualified Data.List as List
 import Data.List.NonEmpty (NonEmpty)
@@ -122,12 +125,13 @@ import System.Environment (getEnvironment)
 #if MIN_VERSION_base(4,12,0)
 import Database.Persist.Compatible
 #endif
+import qualified Data.Vault.Strict as Vault
 import Database.Persist.Postgresql.Internal
 import Database.Persist.Sql
 import qualified Database.Persist.Sql.Util as Util
 import Database.Persist.SqlBackend
-import Database.Persist.SqlBackend.StatementCache (StatementCache, mkSimpleStatementCache, mkStatementCache)
-import qualified Data.Vault.Strict as Vault
+import Database.Persist.SqlBackend.StatementCache
+       (StatementCache, mkSimpleStatementCache, mkStatementCache)
 import System.IO.Unsafe (unsafePerformIO)
 
 -- | A @libpq@ connection string.  A simple example of connection
@@ -270,9 +274,31 @@ createPostgresqlPoolModifiedWithVersion
     -> ConnectionString -- ^ Connection string to the database.
     -> Int -- ^ Number of connections to be kept open in the pool.
     -> m (Pool SqlBackend)
-createPostgresqlPoolModifiedWithVersion getVerDouble modConn ci = do
+createPostgresqlPoolModifiedWithVersion = createPostgresqlPoolTailored open'
+
+-- | Same as 'createPostgresqlPoolModifiedWithVersion', but takes a custom connection-creation
+-- function.
+--
+-- The only time you should reach for this function is if you need to write custom logic for creating
+-- a connection to the database.
+--
+-- @since 2.13.6
+createPostgresqlPoolTailored
+    :: (MonadUnliftIO m, MonadLoggerIO m)
+    =>
+    (    (PG.Connection -> IO ())
+      -> (PG.Connection -> IO (NonEmpty Word))
+      -> ((PG.Connection -> SqlBackend) -> PG.Connection -> SqlBackend)
+      -> ConnectionString -> LogFunc -> IO SqlBackend
+    ) -- ^ Action that creates a postgresql connection (please see documentation on the un-exported @open'@ function in this same module.
+    -> (PG.Connection -> IO (Maybe Double)) -- ^ Action to perform to get the server version.
+    -> (PG.Connection -> IO ()) -- ^ Action to perform after connection is created.
+    -> ConnectionString -- ^ Connection string to the database.
+    -> Int -- ^ Number of connections to be kept open in the pool.
+    -> m (Pool SqlBackend)
+createPostgresqlPoolTailored createConnection getVerDouble modConn ci = do
   let getVer = oldGetVersionToNew getVerDouble
-  createSqlPool $ open' modConn getVer id ci
+  createSqlPool $ createConnection modConn getVer id ci
 
 -- | Same as 'createPostgresqlPool', but can be configured with 'PostgresConf' and 'PostgresConfHooks'.
 --
@@ -333,6 +359,8 @@ open' modConn getVer constructor cstr logFunc = do
     return $ constructor (createBackend logFunc ver smap) conn
 
 -- | Gets the PostgreSQL server version
+--
+-- @since 2.13.6
 getServerVersion :: PG.Connection -> IO (Maybe Double)
 getServerVersion conn = do
   [PG.Only version] <- PG.query_ conn "show server_version";
@@ -415,6 +443,8 @@ getSimpleConn = Vault.lookup underlyingConnectionKey <$> getConnVault
 
 -- | Create the backend given a logging function, server version, mutable statement cell,
 -- and connection.
+--
+-- @since 2.13.6
 createBackend :: LogFunc -> NonEmpty Word
               -> IORef (Map.Map Text Statement) -> PG.Connection -> SqlBackend
 createBackend logFunc serverVersion smap conn =
@@ -1073,7 +1103,15 @@ getColumn _ _ columnName _ =
 -- | Intelligent comparison of SQL types, to account for SqlInt32 vs SqlOther integer
 sqlTypeEq :: SqlType -> SqlType -> Bool
 sqlTypeEq x y =
-    T.toCaseFold (showSqlType x) == T.toCaseFold (showSqlType y)
+    let
+        -- Non exhaustive helper to map postgres aliases to the same name. Based on
+        -- https://www.postgresql.org/docs/9.5/datatype.html.
+        -- This prevents needless `ALTER TYPE`s when the type is the same.
+        normalize "int8"    = "bigint"
+        normalize "serial8" = "bigserial"
+        normalize v         = v
+    in
+        normalize (T.toCaseFold (showSqlType x)) == normalize (T.toCaseFold (showSqlType y))
 
 findAlters
     :: [EntityDef]
@@ -1339,7 +1377,7 @@ showAlter table (DropReference cname) = T.concat
     , escapeC cname
     ]
 
--- | Get the SQL string for the table that a PeristEntity represents.
+-- | Get the SQL string for the table that a PersistEntity represents.
 -- Useful for raw SQL queries.
 tableName :: (PersistEntity record) => record -> Text
 tableName = escapeE . tableDBName

persistent-postgresql/persistent-postgresql.cabal

@@ -1,5 +1,5 @@
 name:            persistent-postgresql
-version:         2.13.5.2
+version:         2.13.6.1
 license:         MIT
 license-file:    LICENSE
 author:          Felipe Lessa, Michael Snoyman <[email protected]>
@@ -25,8 +25,8 @@ library
                    , containers            >= 0.5
                    , monad-logger          >= 0.3.25
                    , mtl
-                   , postgresql-simple     >= 0.6.1    && < 0.7
-                   , postgresql-libpq      >= 0.9.4.2  && < 0.10
+                   , postgresql-simple     >= 0.6.1    && < 0.8
+                   , postgresql-libpq      >= 0.9.4.2  && < 0.11
                    , resourcet             >= 1.1.9
                    , resource-pool
                    , string-conversions

persistent-postgresql/test/EquivalentTypeTestPostgres.hs

@@ -21,15 +21,15 @@ import PgInit
 
 share [mkPersist sqlSettings, mkMigrate "migrateAll1"] [persistLowerCase|
 EquivalentType sql=equivalent_types
-    field1 Int
+    field1 Int    sqltype=bigint
     field2 T.Text sqltype=text
     field3 T.Text sqltype=us_postal_code
     deriving Eq Show
 |]
 
 share [mkPersist sqlSettings, mkMigrate "migrateAll2"] [persistLowerCase|
 EquivalentType2 sql=equivalent_types
-    field1 Int
+    field1 Int    sqltype=int8
     field2 T.Text
     field3 T.Text sqltype=us_postal_code
     deriving Eq Show

persistent-sqlite/ChangeLog.md

@@ -1,5 +1,11 @@
 # Changelog for persistent-sqlite
 
+## 2.13.2
+
+* [#1488](https://github.com/yesodweb/persistent/pull/1488)
+    * Add `openRawSqliteConn` for creating `RawSqlite SqlBackend` connections
+      that aren't automatically cleaned-up.
+
 ## 2.13.1.1
 
 * [#1459](https://github.com/yesodweb/persistent/pull/1459)

persistent-sqlite/Database/Persist/Sqlite.hs

@@ -48,6 +48,7 @@ module Database.Persist.Sqlite
     , ForeignKeyViolation(..)
     , checkForeignKeys
     , RawSqlite
+    , openRawSqliteConn
     , persistentBackend
     , rawSqliteConnection
     , withRawSqliteConnInfo
@@ -94,8 +95,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)
@@ -938,6 +939,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
 

persistent-sqlite/cbits/sqlite3.c

@@ -53429,7 +53429,7 @@ static int writeSuperJournal(Pager *pPager, const char *zSuper){
   }
   pPager->journalOff += (nSuper+20);
 
-  /* If the pager is in peristent-journal mode, then the physical
+  /* If the pager is in persistent-journal mode, then the physical
   ** journal-file may extend past the end of the super-journal name
   ** and 8 bytes of magic data just written to the file. This is
   ** dangerous because the code to rollback a hot-journal file

persistent-sqlite/persistent-sqlite.cabal

@@ -1,5 +1,5 @@
 name:            persistent-sqlite
-version:         2.13.1.1
+version:         2.13.2.0
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <[email protected]>

persistent/ChangeLog.md

@@ -1,9 +1,20 @@
 # Changelog for persistent
 
-## 2.14.6.0
-
+## 2.14.6.0 (unreleased)
+
+* [#1503](https://github.com/yesodweb/persistent/pull/1503)
+    * Create Haddocks from entity documentation comments
+* [1497](https://github.com/yesodweb/persistent/pull/1497)
+    * Always generates `SymbolToField "id"` instance
+* [#1509](https://github.com/yesodweb/persistent/pull/1509)
+    * Provide `ViaPersistEntity` for defining `PathMultiPiece` for entity keys.
 * [#1480](https://github.com/yesodweb/persistent/pull/1480)
   * Add `mpsAvoidHsKeyword` in `MkPersistSettings`
+  * 
+## 2.14.5.2
+
+* [#1513](https://github.com/yesodweb/persistent/pull/1513)
+    * Support GHC 9.8 and `aeson-2.2`
 
 ## 2.14.5.1
 

persistent/Database/Persist/Class/PersistEntity.hs

@@ -24,6 +24,7 @@ module Database.Persist.Class.PersistEntity
     , FilterValue (..)
     , BackendSpecificFilter
     , Entity (.., Entity, entityKey, entityVal)
+    , ViaPersistEntity (..)
 
     , recordName
     , entityValues
@@ -56,6 +57,7 @@ import Data.Aeson.Text (encodeToTextBuilder)
 import Data.Aeson.Types (Parser, Result(Error, Success))
 import Data.Attoparsec.ByteString (parseOnly)
 import Data.Functor.Identity
+import Web.PathPieces (PathMultiPiece(..), PathPiece(..))
 
 #if MIN_VERSION_aeson(2,0,0)
 import qualified Data.Aeson.KeyMap as AM
@@ -180,6 +182,18 @@ class ( PersistField (Key record), ToJSON (Key record), FromJSON (Key record)
     keyFromRecordM :: Maybe (record -> Key record)
     keyFromRecordM = Nothing
 
+-- | Newtype wrapper for optionally deriving typeclass instances on
+-- 'PersistEntity' keys.
+--
+-- @since 2.14.6.0
+newtype ViaPersistEntity record = ViaPersistEntity (Key record)
+
+instance PersistEntity record => PathMultiPiece (ViaPersistEntity record) where
+    fromPathMultiPiece pieces = do
+        Right key <- keyFromValues <$> mapM fromPathPiece pieces
+        pure $ ViaPersistEntity key
+    toPathMultiPiece (ViaPersistEntity key) = map toPathPiece $ keyToValues key
+
 -- | Construct an @'Entity' record@ by providing a value for each of the
 -- record's fields.
 --

persistent/Database/Persist/Class/PersistStore.hs

@@ -79,7 +79,7 @@ class (HasPersistBackend backend) => IsPersistBackend backend where
 -- @
 -- foo ::
 --   ( 'PersistEntity' record
---   , 'PeristEntityBackend' record ~ 'BaseBackend' backend
+--   , 'PersistEntityBackend' record ~ 'BaseBackend' backend
 --   , 'IsSqlBackend' backend
 --   )
 -- @

persistent/Database/Persist/Quasi.hs

@@ -612,8 +612,8 @@ Likewise, the field documentation is present in the @fieldComments@ field on the
 "A user can be old, or young, and we care about\nthis for some reason."
 @
 
-Unfortunately, we can't use this to create Haddocks for you, because <https://gitlab.haskell.org/ghc/ghc/issues/5467 Template Haskell does not support Haddock yet>.
-@persistent@ backends *can* use this to generate SQL @COMMENT@s, which are useful for a database perspective, and you can use the <https://hackage.haskell.org/package/persistent-documentation @persistent-documentation@> library to render a Markdown document of the entity definitions.
+Since @persistent-2.14.6.0@, documentation comments are included in documentation generated using Haddock if `mpsEntityHaddocks` is enabled (defaults to False).
+@persistent@ backends can also use this to generate SQL @COMMENT@s, which are useful for a database perspective, and you can use the <https://hackage.haskell.org/package/persistent-documentation @persistent-documentation@> library to render a Markdown document of the entity definitions.
 
 = Sum types
 

persistent/Database/Persist/Sql/Orphan/PersistStore.hs

@@ -80,7 +80,7 @@ whereStmtForKey conn k =
 whereStmtForKeys :: PersistEntity record => SqlBackend -> [Key record] -> Text
 whereStmtForKeys conn ks = T.intercalate " OR " $ whereStmtForKey conn `fmap` ks
 
--- | get the SQL string for the table that a PeristEntity represents
+-- | get the SQL string for the table that a PersistEntity represents
 -- Useful for raw SQL queries
 --
 -- Your backend may provide a more convenient tableName function