diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # Changelog for persistent-mysql +## 2.12.1.0 + +* Expose `openMySQLConn` for explicit reference to opened connection. [#1248](https://github.com/yesodweb/persistent/pull/1248) + * Makes it convenient to use with `mysql-simple`. + ## 2.12.0.0 * Decomposed `HaskellName` into `ConstraintNameHS`, `EntityNameHS`, `FieldNameHS`. Decomposed `DBName` into `ConstraintNameDB`, `EntityNameDB`, `FieldNameDB` respectively. [#1174](https://github.com/yesodweb/persistent/pull/1174) diff --git a/Database/Persist/MySQL.hs b/Database/Persist/MySQL.hs --- a/Database/Persist/MySQL.hs +++ b/Database/Persist/MySQL.hs @@ -32,36 +32,36 @@ , copyUnlessNull , copyUnlessEmpty , copyUnlessEq + , openMySQLConn ) where -import qualified Blaze.ByteString.Builder.Char8 as BBB import qualified Blaze.ByteString.Builder.ByteString as BBS +import qualified Blaze.ByteString.Builder.Char8 as BBB import Control.Arrow import Control.Monad -import Control.Monad.IO.Class (MonadIO (..)) +import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.IO.Unlift (MonadUnliftIO) import Control.Monad.Logger (MonadLoggerIO, runNoLoggingT) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Except (ExceptT, runExceptT) -import Control.Monad.Trans.Reader (runReaderT, ReaderT) +import Control.Monad.Trans.Reader (ReaderT, runReaderT) import Control.Monad.Trans.Writer (runWriterT) -import GHC.Stack -import Data.Conduit -import qualified Data.Conduit.List as CL import Data.Acquire (Acquire, mkAcquire, with) import Data.Aeson import Data.Aeson.Types (modifyFailure) import Data.ByteString (ByteString) +import Data.Conduit +import qualified Data.Conduit.List as CL import Data.Either (partitionEithers) import Data.Fixed (Pico) import Data.Function (on) -import Data.Int (Int64) import Data.IORef -import Data.List (find, intercalate, sort, groupBy) +import Data.Int (Int64) +import Data.List (find, groupBy, intercalate, sort) import qualified Data.Map as Map -import Data.Maybe (listToMaybe, mapMaybe, fromMaybe) +import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) import Data.Monoid ((<>)) import qualified Data.Monoid as Monoid import Data.Pool (Pool) @@ -69,18 +69,19 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T +import GHC.Stack import System.Environment (getEnvironment) import Database.Persist.Sql import Database.Persist.Sql.Types.Internal (makeIsolationLevelStatement) import qualified Database.Persist.Sql.Util as Util -import qualified Database.MySQL.Base as MySQLBase -import qualified Database.MySQL.Base.Types as MySQLBase -import qualified Database.MySQL.Simple as MySQL -import qualified Database.MySQL.Simple.Param as MySQL +import qualified Database.MySQL.Base as MySQLBase +import qualified Database.MySQL.Base.Types as MySQLBase +import qualified Database.MySQL.Simple as MySQL +import qualified Database.MySQL.Simple.Param as MySQL import qualified Database.MySQL.Simple.Result as MySQL -import qualified Database.MySQL.Simple.Types as MySQL +import qualified Database.MySQL.Simple.Types as MySQL -- | Create a MySQL connection pool and run the given action. -- The pool is properly released after the action finishes using @@ -120,14 +121,17 @@ withMySQLConn = withSqlConn . open' --- | Internal function that opens a connection to the MySQL --- server. -open' :: MySQL.ConnectInfo -> LogFunc -> IO SqlBackend -open' ci logFunc = do +-- | Open a connection to MySQL server, initialize the 'SqlBackend' and return +-- their tuple +-- +-- @since 2.12.1.0 +openMySQLConn :: MySQL.ConnectInfo -> LogFunc -> IO (MySQL.Connection, SqlBackend) +openMySQLConn ci logFunc = do conn <- MySQL.connect ci MySQLBase.autocommit conn False -- disable autocommit! smap <- newIORef $ Map.empty - return $ SqlBackend + let + backend = SqlBackend { connPrepare = prepare' conn , connStmtMap = smap , connInsertSql = insertSql' @@ -153,7 +157,14 @@ , connMaxParams = Nothing , connRepsertManySql = Just repsertManySql } + pure (conn, backend) + +-- | Internal function that opens a connection to the MySQL server. +open' :: MySQL.ConnectInfo -> LogFunc -> IO SqlBackend +open' ci logFunc = snd <$> openMySQLConn ci logFunc + + -- | Prepare a query. We don't support prepared statements, but -- we'll do some client-side preprocessing here. prepare' :: MySQL.Connection -> Text -> IO Statement @@ -320,7 +331,7 @@ -- Controversial conversions go MySQLBase.Set _ _ = convertPV PersistText go MySQLBase.Enum _ _ = convertPV PersistText - -- Conversion using PersistDbSpecific + -- Conversion using PersistLiteral go MySQLBase.Geometry _ _ = \_ m -> case m of Just g -> PersistLiteral g @@ -1428,7 +1439,7 @@ -- [] -- @ -- --- Once we run that code on the datahase, the new data set looks like this: +-- Once we run that code on the database, the new data set looks like this: -- -- > items: -- > +------+-------------+-------+----------+ diff --git a/persistent-mysql.cabal b/persistent-mysql.cabal --- a/persistent-mysql.cabal +++ b/persistent-mysql.cabal @@ -1,5 +1,5 @@ name: persistent-mysql -version: 2.12.0.0 +version: 2.12.1.0 license: MIT license-file: LICENSE author: Felipe Lessa , Michael Snoyman diff --git a/test/InsertDuplicateUpdate.hs b/test/InsertDuplicateUpdate.hs --- a/test/InsertDuplicateUpdate.hs +++ b/test/InsertDuplicateUpdate.hs @@ -61,12 +61,15 @@ dbItems <- map entityVal <$> selectList [] [] sort dbItems @== sort (newItem : items) it "updates existing records" $ db $ do + let postUpdate = map (\i -> i { itemQuantity = fmap (+1) (itemQuantity i) }) items deleteWhere ([] :: [Filter Item]) insertMany_ items insertManyOnDuplicateKeyUpdate items [] [ItemQuantity +=. Just 1] + dbItems <- sort . fmap entityVal <$> selectList [] [] + dbItems @== sort postUpdate it "only copies passing values" $ db $ do deleteWhere ([] :: [Filter Item]) insertMany_ items