diff --git a/Database/Persist/MySQL.hs b/Database/Persist/MySQL.hs --- a/Database/Persist/MySQL.hs +++ b/Database/Persist/MySQL.hs @@ -6,8 +6,7 @@ ( withMySQLPool , withMySQLConn , createMySQLPool - , module Database.Persist - , module Database.Persist.GenericSql + , module Database.Persist.Sql , MySQL.ConnectInfo(..) , MySQLBase.SSLInfo(..) , MySQL.defaultConnectInfo @@ -35,11 +34,7 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T -import Database.Persist hiding (Entity (..)) -import Database.Persist.Store -import Database.Persist.GenericSql hiding (Key) -import Database.Persist.GenericSql.Internal -import Database.Persist.EntityDef +import Database.Persist.Sql import Data.Int (Int64) import qualified Database.MySQL.Simple as MySQL @@ -98,18 +93,19 @@ MySQLBase.autocommit conn False -- disable autocommit! smap <- newIORef $ Map.empty return Connection - { prepare = prepare' conn - , stmtMap = smap - , insertSql = insertSql' - , close = MySQL.close conn - , migrateSql = migrate' ci - , begin = const $ MySQL.execute_ conn "start transaction" >> return () - , commitC = const $ MySQL.commit conn - , rollbackC = const $ MySQL.rollback conn - , escapeName = pack . escapeDBName - , noLimit = "LIMIT 18446744073709551615" + { connPrepare = prepare' conn + , connStmtMap = smap + , connInsertSql = insertSql' + , connClose = MySQL.close conn + , connMigrateSql = migrate' ci + , connBegin = const $ MySQL.execute_ conn "start transaction" >> return () + , connCommit = const $ MySQL.commit conn + , connRollback = const $ MySQL.rollback conn + , connEscapeName = pack . escapeDBName + , connNoLimit = "LIMIT 18446744073709551615" -- This noLimit is suggested by MySQL's own docs, see -- + , connRDBMS = "mysql" } -- | Prepare a query. We don't support prepared statements, but @@ -118,10 +114,10 @@ prepare' conn sql = do let query = MySQL.Query (T.encodeUtf8 sql) return Statement - { finalize = return () - , reset = return () - , execute = execute' conn query - , withStmt = withStmt' conn query + { stmtFinalize = return () + , stmtReset = return () + , stmtExecute = execute' conn query + , stmtQuery = withStmt' conn query } @@ -256,15 +252,15 @@ -- | Create the migration plan for the given 'PersistEntity' -- @val@. -migrate' :: PersistEntity val +migrate' :: Show a => MySQL.ConnectInfo - -> [EntityDef] + -> [EntityDef a] -> (Text -> IO Statement) - -> val + -> EntityDef SqlType -> IO (Either [Text] [(Bool, Text)]) migrate' connectInfo allDefs getter val = do - let name = entityDB $ entityDef val - (idClmn, old) <- getColumns connectInfo getter $ entityDef val + let name = entityDB val + (idClmn, old) <- getColumns connectInfo getter val let new = second (map udToPair) $ mkColumns allDefs val case (idClmn, old, partitionEithers old) of -- Nothing found, create everything @@ -273,7 +269,7 @@ [ "CREATE TABLE " , escapeDBName name , "(" - , escapeDBName $ entityID $ entityDef val + , escapeDBName $ entityID val , " BIGINT NOT NULL AUTO_INCREMENT PRIMARY KEY" , concatMap (\x -> ',' : showColumn x) $ fst new , ")" @@ -297,7 +293,7 @@ -- | Find out the type of a column. -findTypeOfColumn :: [EntityDef] -> DBName -> DBName -> (DBName, FieldType) +findTypeOfColumn :: Show a => [EntityDef a] -> DBName -> DBName -> (DBName, FieldType) findTypeOfColumn allDefs name col = maybe (error $ "Could not find type of column " ++ show col ++ " on table " ++ show name ++ @@ -309,7 +305,7 @@ -- | Helper for 'AddRefence' that finds out the 'entityID'. -addReference :: [EntityDef] -> DBName -> AlterColumn +addReference :: Show a => [EntityDef a] -> DBName -> AlterColumn addReference allDefs name = AddReference name id_ where id_ = maybe (error $ "Could not find ID of entity " ++ show name @@ -319,11 +315,11 @@ return (entityID entDef) data AlterColumn = Change Column - | Add Column + | Add' Column | Drop | Default String | NoDefault - | Update String + | Update' String | AddReference DBName DBName | DropReference DBName @@ -348,7 +344,7 @@ -- in the database. getColumns :: MySQL.ConnectInfo -> (Text -> IO Statement) - -> EntityDef + -> EntityDef a -> IO ( [Either Text (Either Column (DBName, [DBName]))] -- ID column , [Either Text (Either Column (DBName, [DBName]))] -- everything else ) @@ -362,7 +358,7 @@ \WHERE TABLE_SCHEMA = ? \ \AND TABLE_NAME = ? \ \AND COLUMN_NAME = ?" - inter1 <- runResourceT $ withStmt stmtIdClmn vals $$ CL.consume + inter1 <- runResourceT $ stmtQuery stmtIdClmn vals $$ CL.consume ids <- runResourceT $ CL.sourceList inter1 $$ helperClmns -- avoid nested queries -- Find out all columns. @@ -374,7 +370,7 @@ \WHERE TABLE_SCHEMA = ? \ \AND TABLE_NAME = ? \ \AND COLUMN_NAME <> ?" - inter2 <- runResourceT $ withStmt stmtClmns vals $$ CL.consume + inter2 <- runResourceT $ stmtQuery stmtClmns vals $$ CL.consume cs <- runResourceT $ CL.sourceList inter2 $$ helperClmns -- avoid nested queries -- Find out the constraints. @@ -387,7 +383,7 @@ \AND REFERENCED_TABLE_SCHEMA IS NULL \ \ORDER BY CONSTRAINT_NAME, \ \COLUMN_NAME" - us <- runResourceT $ withStmt stmtCntrs vals $$ helperCntrs + us <- runResourceT $ stmtQuery stmtCntrs vals $$ helperCntrs -- Return both return $ (ids, cs ++ us) @@ -453,7 +449,7 @@ , PersistText $ unDBName $ tname , PersistByteString cname , PersistText $ pack $ MySQL.connectDatabase connectInfo ] - cntrs <- runResourceT $ withStmt stmt vars $$ CL.consume + cntrs <- runResourceT $ stmtQuery stmt vars $$ CL.consume ref <- case cntrs of [] -> return Nothing [[PersistByteString tab, PersistByteString ref]] -> @@ -461,7 +457,14 @@ _ -> fail "MySQL.getColumn/getRef: never here" -- Okay! - return $ Column (DBName $ T.decodeUtf8 cname) (null_ == "YES") type_ default_ Nothing ref -- FIXME: maxLen + return Column + { cName = DBName $ T.decodeUtf8 cname + , cNull = null_ == "YES" + , cSqlType = type_ + , cDefault = default_ + , cMaxLen = Nothing -- FIXME: maxLen + , cReference = ref + } getColumn _ _ _ x = return $ Left $ pack $ "Invalid result from INFORMATION_SCHEMA: " ++ show x @@ -514,7 +517,8 @@ -- | @getAlters allDefs tblName new old@ finds out what needs to -- be changed from @old@ to become @new@. -getAlters :: [EntityDef] +getAlters :: Show a + => [EntityDef a] -> DBName -> ([Column], [(DBName, [DBName])]) -> ([Column], [(DBName, [DBName])]) @@ -551,11 +555,11 @@ -- | @findAlters newColumn oldColumns@ finds out what needs to be -- changed in the columns @oldColumns@ for @newColumn@ to be -- supported. -findAlters :: [EntityDef] -> Column -> [Column] -> ([AlterColumn'], [Column]) +findAlters :: Show a => [EntityDef a] -> Column -> [Column] -> ([AlterColumn'], [Column]) findAlters allDefs col@(Column name isNull type_ def _maxLen ref) cols = case filter ((name ==) . cName) cols of [] -> ( let cnstr = [addReference allDefs tname | Just (tname, _) <- [ref]] - in map ((,) name) (Add col : cnstr) + in map ((,) name) (Add' col : cnstr) , cols ) Column _ isNull' type_' def' _maxLen' ref':_ -> let -- Foreign key @@ -662,7 +666,7 @@ , " " , showColumn (Column n nu t def maxLen Nothing) ] -showAlter table (_, Add col) = +showAlter table (_, Add' col) = concat [ "ALTER TABLE " , escapeDBName table @@ -693,7 +697,7 @@ , escapeDBName n , " DROP DEFAULT" ] -showAlter table (n, Update s) = +showAlter table (n, Update' s) = concat [ "UPDATE " , escapeDBName table @@ -753,7 +757,7 @@ instance PersistConfig MySQLConf where - type PersistConfigBackend MySQLConf = SqlPersist + type PersistConfigBackend MySQLConf = SqlPersistT type PersistConfigPool MySQLConf = ConnectionPool 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: 1.1.4 +version: 1.2.0 license: MIT license-file: LICENSE author: Felipe Lessa , Michael Snoyman @@ -28,7 +28,7 @@ , transformers >= 0.2.1 , mysql-simple >= 0.2.2.3 && < 0.3 , mysql >= 0.1.1.3 && < 0.2 - , persistent >= 1.1.5 && < 1.2 + , persistent >= 1.2 && < 1.3 , containers >= 0.2 , bytestring >= 0.9 , text >= 0.11.0.6