persistent-mysql 1.3.1 → 2.0.0

raw patch · 2 files changed

+33/−40 lines, 2 filesdep +monad-loggerdep ~persistentdep ~resourcetPVP ok

version bump matches the API change (PVP)

Dependencies added: monad-logger

Dependency ranges changed: persistent, resourcet

API changes (from Hackage documentation)

Files

• Database/Persist/MySQL.hs +29/−37
• persistent-mysql.cabal +4/−3

@@ -16,6 +16,7 @@  import Control.Arrow import Control.Monad (mzero)+import Control.Monad.Logger (MonadLogger, runNoLoggingT) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Error (ErrorT(..))@@ -28,6 +29,7 @@ import Data.List (find, intercalate, sort, groupBy) import Data.Text (Text, pack) import System.Environment (getEnvironment)+import Data.Acquire (Acquire, mkAcquire, with)  import Data.Conduit import qualified Blaze.ByteString.Builder.Char8 as BBB@@ -55,7 +57,7 @@ -- The pool is properly released after the action finishes using -- it.  Note that you should not use the given 'ConnectionPool' -- outside the action since it may be already been released.-withMySQLPool :: MonadIO m =>+withMySQLPool :: (MonadIO m, MonadLogger m, MonadBaseControl IO m) =>                  MySQL.ConnectInfo               -- ^ Connection information.               -> Int@@ -69,7 +71,7 @@ -- | Create a MySQL connection pool.  Note that it's your -- responsability to properly close the connection pool when -- unneeded.  Use 'withMySQLPool' for automatic resource control.-createMySQLPool :: MonadIO m =>+createMySQLPool :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) =>                    MySQL.ConnectInfo                 -- ^ Connection information.                 -> Int@@ -80,7 +82,7 @@  -- | Same as 'withMySQLPool', but instead of opening a pool -- of connections, only one connection is opened.-withMySQLConn :: (MonadBaseControl IO m, MonadIO m) =>+withMySQLConn :: (MonadBaseControl IO m, MonadIO m, MonadLogger m) =>                  MySQL.ConnectInfo               -- ^ Connection information.               -> (Connection -> m a)@@ -91,8 +93,8 @@  -- | Internal function that opens a connection to the MySQL -- server.-open' :: MySQL.ConnectInfo -> IO Connection-open' ci = do+open' :: MySQL.ConnectInfo -> LogFunc -> IO Connection+open' ci logFunc = do     conn <- MySQL.connect ci     MySQLBase.autocommit conn False -- disable autocommit!     smap <- newIORef $ Map.empty@@ -111,8 +113,9 @@         -- <http://dev.mysql.com/doc/refman/5.5/en/select.html>         , connRDBMS      = "mysql"         , connLimitOffset = decorateSQLWithLimitOffset "LIMIT 18446744073709551615"+        , connLogFunc    = 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@@ -127,7 +130,7 @@   -- | SQL code to be executed when inserting an entity.-insertSql' :: EntityDef SqlType -> [PersistValue] -> InsertSqlResult+insertSql' :: EntityDef -> [PersistValue] -> InsertSqlResult insertSql' ent vals =   let sql = pack $ concat                 [ "INSERT INTO "@@ -149,13 +152,14 @@  -- | Execute an statement that does return results.  The results -- are fetched all at once and stored into memory.-withStmt' :: MonadResource m+withStmt' :: MonadIO m           => MySQL.Connection           -> MySQL.Query           -> [PersistValue]-          -> Source m [PersistValue]-withStmt' conn query vals =-    bracketP createResult MySQLBase.freeResult fetchRows >>= CL.sourceList+          -> Acquire (Source m [PersistValue])+withStmt' conn query vals = do+    result <- mkAcquire createResult MySQLBase.freeResult+    return $ fetchRows result >>= CL.sourceList   where     createResult = do       -- Execute the query@@ -197,7 +201,6 @@     render (P (PersistDay d))         = MySQL.render d     render (P (PersistTimeOfDay t))   = MySQL.render t     render (P (PersistUTCTime t))     = MySQL.render t-    render (P (PersistZonedTime (ZT t))) = MySQL.render $ show t     render (P PersistNull)            = MySQL.render MySQL.Null     render (P (PersistList l))        = MySQL.render $ listToJSON l     render (P (PersistMap m))         = MySQL.render $ mapToJSON m@@ -267,11 +270,10 @@  -- | Create the migration plan for the given 'PersistEntity' -- @val@.-migrate' :: Show a-         => MySQL.ConnectInfo-         -> [EntityDef a]+migrate' :: MySQL.ConnectInfo+         -> [EntityDef]          -> (Text -> IO Statement)-         -> EntityDef SqlType+         -> EntityDef          -> IO (Either [Text] [(Bool, Text)]) migrate' connectInfo allDefs getter val = do     let name = entityDB val@@ -282,7 +284,7 @@       -- Nothing found, create everything       ([], [], _) -> do         let idtxt = case entityPrimary val of-                Just pdef -> concat [" PRIMARY KEY (", intercalate "," $ map (escapeDBName . snd) $ primaryFields pdef, ")"]+                Just pdef -> concat [" PRIMARY KEY (", intercalate "," $ map (escapeDBName . fieldDB) $ primaryFields pdef, ")"]                 Nothing   -> concat [escapeDBName $ entityID val, " BIGINT NOT NULL AUTO_INCREMENT PRIMARY KEY"]          let addTable = AddTable $ concat@@ -323,7 +325,7 @@   -- | Find out the type of a column.-findTypeOfColumn :: Show a => [EntityDef a] -> DBName -> DBName -> (DBName, FieldType)+findTypeOfColumn :: [EntityDef] -> DBName -> DBName -> (DBName, FieldType) findTypeOfColumn allDefs name col =     maybe (error $ "Could not find type of column " ++                    show col ++ " on table " ++ show name ++@@ -335,7 +337,7 @@   -- | Helper for 'AddRefence' that finds out the 'entityID'.-addReference :: Show a => [EntityDef a] -> DBName -> DBName -> DBName -> AlterColumn+addReference :: [EntityDef] -> DBName -> DBName -> DBName -> AlterColumn addReference allDefs fkeyname reftable cname = AddReference reftable fkeyname [cname] [id_]      where       id_ = maybe (error $ "Could not find ID of entity " ++ show reftable@@ -373,7 +375,7 @@ -- in the database. getColumns :: MySQL.ConnectInfo            -> (Text -> IO Statement)-           -> EntityDef a+           -> EntityDef            -> IO ( [Either Text (Either Column (DBName, [DBName]))] -- ID column                  , [Either Text (Either Column (DBName, [DBName]))] -- everything else                  )@@ -387,7 +389,7 @@                           \WHERE TABLE_SCHEMA = ? \                             \AND TABLE_NAME   = ? \                             \AND COLUMN_NAME  = ?"-    inter1 <- runResourceT $ stmtQuery stmtIdClmn vals $$ CL.consume+    inter1 <- with (stmtQuery stmtIdClmn vals) ($$ CL.consume)     ids <- runResourceT $ CL.sourceList inter1 $$ helperClmns -- avoid nested queries      -- Find out all columns.@@ -399,7 +401,7 @@                         \WHERE TABLE_SCHEMA = ? \                           \AND TABLE_NAME   = ? \                           \AND COLUMN_NAME <> ?"-    inter2 <- runResourceT $ stmtQuery stmtClmns vals $$ CL.consume+    inter2 <- with (stmtQuery stmtClmns vals) ($$ CL.consume)     cs <- runResourceT $ CL.sourceList inter2 $$ helperClmns -- avoid nested queries      -- Find out the constraints.@@ -413,7 +415,7 @@                           \AND REFERENCED_TABLE_SCHEMA IS NULL \                         \ORDER BY CONSTRAINT_NAME, \                                  \COLUMN_NAME"-    us <- runResourceT $ stmtQuery stmtCntrs vals $$ helperCntrs+    us <- with (stmtQuery stmtCntrs vals) ($$ helperCntrs)      -- Return both     return (ids, cs ++ us)@@ -477,7 +479,7 @@                  , PersistText $ unDBName $ tname                  , PersistByteString cname                  , PersistText $ pack $ MySQL.connectDatabase connectInfo ]-      cntrs <- runResourceT $ stmtQuery stmt vars $$ CL.consume+      cntrs <- with (stmtQuery stmt vars) ($$ CL.consume)       ref <- case cntrs of                [] -> return Nothing                [[PersistByteString tab, PersistByteString ref, PersistInt64 pos]] ->@@ -539,7 +541,6 @@ parseType "date"       = SqlDay --parseType "newdate"    = SqlDay --parseType "year"       = SqlDay--- Other -} parseType b            = SqlOther $ T.decodeUtf8 b @@ -549,8 +550,7 @@  -- | @getAlters allDefs tblName new old@ finds out what needs to -- be changed from @old@ to become @new@.-getAlters :: Show a-          => [EntityDef a]+getAlters :: [EntityDef]           -> DBName           -> ([Column], [(DBName, [DBName])])           -> ([Column], [(DBName, [DBName])])@@ -587,7 +587,7 @@ -- | @findAlters newColumn oldColumns@ finds out what needs to be -- changed in the columns @oldColumns@ for @newColumn@ to be -- supported.-findAlters :: Show a => DBName -> [EntityDef a] -> Column -> [Column] -> ([AlterColumn'], [Column])+findAlters :: DBName -> [EntityDef] -> Column -> [Column] -> ([AlterColumn'], [Column]) findAlters tblName allDefs col@(Column name isNull type_ def defConstraintName maxLen ref) cols =     case filter ((name ==) . cName) cols of     -- new fkey that didnt exist before@@ -648,8 +648,6 @@ showSqlType SqlBool    _          _     = "TINYINT(1)" showSqlType SqlDay     _          _     = "DATE" showSqlType SqlDayTime _          _     = "DATETIME"-showSqlType SqlDayTimeZoned _     True  = "VARCHAR(50) CHARACTER SET utf8"-showSqlType SqlDayTimeZoned _     False = "VARCHAR(50)" showSqlType SqlInt32   _          _     = "INT(11)" showSqlType SqlInt64   _          _     = "BIGINT" showSqlType SqlReal    _          _     = "DOUBLE"@@ -801,7 +799,7 @@      type PersistConfigPool    MySQLConf = ConnectionPool -    createPoolConfig (MySQLConf cs size) = createMySQLPool cs size+    createPoolConfig (MySQLConf cs size) = runNoLoggingT $ createMySQLPool cs size -- FIXME      runPool _ = runSqlPool @@ -809,16 +807,12 @@         database <- o .: "database"         host     <- o .: "host"         port     <- o .: "port"-        path     <- o .:? "path"         user     <- o .: "user"         password <- o .: "password"         pool     <- o .: "poolsize"         let ci = MySQL.defaultConnectInfo                    { MySQL.connectHost     = host                    , MySQL.connectPort     = port-                   , MySQL.connectPath     = case path of-                         Just p  -> p-                         Nothing -> MySQL.connectPath MySQL.defaultConnectInfo                    , MySQL.connectUser     = user                    , MySQL.connectPassword = password                    , MySQL.connectDatabase = database@@ -835,14 +829,12 @@                 MySQL.ConnectInfo                   { MySQL.connectHost     = host                   , MySQL.connectPort     = port-                  , MySQL.connectPath     = path                   , MySQL.connectUser     = user                   , MySQL.connectPassword = password                   , MySQL.connectDatabase = database                   } -> (myConnInfo conf)                          { MySQL.connectHost     = maybeEnv host "HOST"                          , MySQL.connectPort     = read $ maybeEnv (show port) "PORT"-                         , MySQL.connectPath     = maybeEnv path "PATH"                          , MySQL.connectUser     = maybeEnv user "USER"                          , MySQL.connectPassword = maybeEnv password "PASSWORD"                          , MySQL.connectDatabase = maybeEnv database "DATABASE"

@@ -1,5 +1,5 @@ name:            persistent-mysql-version:         1.3.1+version:         2.0.0 license:         MIT license-file:    LICENSE author:          Felipe Lessa <felipe.lessa@gmail.com>, Michael Snoyman@@ -30,14 +30,15 @@                    , mysql-simple          >= 0.2.2.3  && < 0.3                    , mysql                 >= 0.1.1.3  && < 0.2                    , blaze-builder-                   , persistent            >= 1.3      && < 1.4+                   , persistent            >= 2.0      && < 2.1                    , containers            >= 0.2                    , bytestring            >= 0.9                    , text                  >= 0.11.0.6                    , monad-control         >= 0.2                    , aeson                 >= 0.5                    , conduit               >= 0.5.3-                   , resourcet+                   , resourcet             >= 0.4.10+                   , monad-logger     exposed-modules: Database.Persist.MySQL     ghc-options:     -Wall