persistent-mysql 1.1.4 → 1.2.0
raw patch · 2 files changed
+49/−45 lines, 2 filesdep ~persistent
Dependency ranges changed: persistent
Files
- Database/Persist/MySQL.hs +47/−43
- persistent-mysql.cabal +2/−2
Database/Persist/MySQL.hs view
@@ -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 -- <http://dev.mysql.com/doc/refman/5.5/en/select.html>+ , 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
persistent-mysql.cabal view
@@ -1,5 +1,5 @@ name: persistent-mysql-version: 1.1.4+version: 1.2.0 license: MIT license-file: LICENSE author: Felipe Lessa <felipe.lessa@gmail.com>, 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