persistent-mysql 2.6 → 2.6.0.1
raw patch · 2 files changed
+66/−51 lines, 2 filesdep ~persistent
Dependency ranges changed: persistent
Files
- Database/Persist/MySQL.hs +63/−48
- persistent-mysql.cabal +3/−3
Database/Persist/MySQL.hs view
@@ -20,7 +20,7 @@ import Control.Monad.Logger (MonadLogger, runNoLoggingT) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Class (lift)-import Control.Monad.Trans.Error (ErrorT(..))+import Control.Monad.Trans.Except (runExceptT) import Control.Monad.Trans.Reader (runReaderT) import Control.Monad.Trans.Writer (runWriterT) import Data.Monoid ((<>))@@ -124,6 +124,7 @@ , connRDBMS = "mysql" , connLimitOffset = decorateSQLWithLimitOffset "LIMIT 18446744073709551615" , connLogFunc = logFunc+ , connMaxParams = Nothing } -- | Prepare a query. We don't support prepared statements, but@@ -456,7 +457,7 @@ stmtIdClmn <- getter "SELECT COLUMN_NAME, \ \IS_NULLABLE, \ \DATA_TYPE, \- \COLUMN_DEFAULT \+ \IF(IS_NULLABLE='YES', COALESCE(COLUMN_DEFAULT, 'NULL'), COLUMN_DEFAULT) \ \FROM INFORMATION_SCHEMA.COLUMNS \ \WHERE TABLE_SCHEMA = ? \ \AND TABLE_NAME = ? \@@ -467,8 +468,12 @@ -- Find out all columns. stmtClmns <- getter "SELECT COLUMN_NAME, \ \IS_NULLABLE, \+ \DATA_TYPE, \ \COLUMN_TYPE, \- \COLUMN_DEFAULT \+ \CHARACTER_MAXIMUM_LENGTH, \+ \NUMERIC_PRECISION, \+ \NUMERIC_SCALE, \+ \IF(IS_NULLABLE='YES', COALESCE(COLUMN_DEFAULT, 'NULL'), COLUMN_DEFAULT) \ \FROM INFORMATION_SCHEMA.COLUMNS \ \WHERE TABLE_SCHEMA = ? \ \AND TABLE_NAME = ? \@@ -519,10 +524,14 @@ -> IO (Either Text Column) getColumn connectInfo getter tname [ PersistText cname , PersistText null_- , PersistText type'+ , PersistText dataType+ , PersistText colType+ , colMaxLen+ , colPrecision+ , colScale , default'] = fmap (either (Left . pack) Right) $- runErrorT $ do+ runExceptT $ do -- Default value default_ <- case default' of PersistNull -> return Nothing@@ -557,65 +566,67 @@ return $ if pos == 1 then Just (DBName tab, DBName ref) else Nothing _ -> fail "MySQL.getColumn/getRef: never here" + let colMaxLen' = case colMaxLen of+ PersistInt64 l -> Just (fromIntegral l)+ _ -> Nothing+ ci = ColumnInfo+ { ciColumnType = colType+ , ciMaxLength = colMaxLen'+ , ciNumericPrecision = colPrecision+ , ciNumericScale = colScale+ }+ (typ, maxLen) <- parseColumnType dataType ci -- Okay! return Column { cName = DBName $ cname , cNull = null_ == "YES"- , cSqlType = parseType type'+ , cSqlType = typ , cDefault = default_ , cDefaultConstraintName = Nothing- , cMaxLen = Nothing -- FIXME: maxLen+ , cMaxLen = maxLen , cReference = ref } getColumn _ _ _ x = return $ Left $ pack $ "Invalid result from INFORMATION_SCHEMA: " ++ show x +-- | Extra column information from MySQL schema+data ColumnInfo = ColumnInfo+ { ciColumnType :: Text+ , ciMaxLength :: Maybe Integer+ , ciNumericPrecision :: PersistValue+ , ciNumericScale :: PersistValue+ } -- | Parse the type of column as returned by MySQL's -- @INFORMATION_SCHEMA@ tables.-parseType :: Text -> SqlType-parseType "bigint(20)" = SqlInt64-parseType "decimal(32,20)" = SqlNumeric 32 20-{--parseType "tinyint" = SqlBool+parseColumnType :: Monad m => Text -> ColumnInfo -> m (SqlType, Maybe Integer) -- Ints-parseType "int" = SqlInt32---parseType "short" = SqlInt32---parseType "long" = SqlInt64---parseType "longlong" = SqlInt64---parseType "mediumint" = SqlInt32-parseType "bigint" = SqlInt64+parseColumnType "tinyint" ci | ciColumnType ci == "tinyint(1)" = return (SqlBool, Nothing)+parseColumnType "int" ci | ciColumnType ci == "int(11)" = return (SqlInt32, Nothing)+parseColumnType "bigint" ci | ciColumnType ci == "bigint(20)" = return (SqlInt64, Nothing) -- Double---parseType "float" = SqlReal-parseType "double" = SqlReal---parseType "decimal" = SqlReal---parseType "newdecimal" = SqlReal+parseColumnType "double" _ = return (SqlReal, Nothing)+parseColumnType "decimal" ci =+ case (ciNumericPrecision ci, ciNumericScale ci) of+ (PersistInt64 p, PersistInt64 s) ->+ return (SqlNumeric (fromIntegral p) (fromIntegral s), Nothing)+ _ ->+ fail "missing DECIMAL precision in DB schema" -- Text-parseType "varchar" = SqlString---parseType "varstring" = SqlString---parseType "string" = SqlString-parseType "text" = SqlString---parseType "tinytext" = SqlString---parseType "mediumtext" = SqlString---parseType "longtext" = SqlString+parseColumnType "varchar" ci = return (SqlString, ciMaxLength ci)+parseColumnType "text" _ = return (SqlString, Nothing) -- ByteString-parseType "varbinary" = SqlBlob-parseType "blob" = SqlBlob---parseType "tinyblob" = SqlBlob---parseType "mediumblob" = SqlBlob---parseType "longblob" = SqlBlob+parseColumnType "varbinary" ci = return (SqlBlob, ciMaxLength ci)+parseColumnType "blob" _ = return (SqlBlob, Nothing) -- Time-related-parseType "time" = SqlTime-parseType "datetime" = SqlDayTime---parseType "timestamp" = SqlDayTime-parseType "date" = SqlDay---parseType "newdate" = SqlDay---parseType "year" = SqlDay--}-parseType b = SqlOther b+parseColumnType "time" _ = return (SqlTime, Nothing)+parseColumnType "datetime" _ = return (SqlDayTime, Nothing)+parseColumnType "date" _ = return (SqlDay, Nothing) +parseColumnType _ ci = return (SqlOther (ciColumnType ci), Nothing) + ---------------------------------------------------------------------- @@ -931,9 +942,9 @@ let name = entityDB val let (newcols, udefs, fdefs) = mkColumns allDefs val let udspair = map udToPair udefs- case ([], [], partitionEithers []) of+ case () of -- Nothing found, create everything- ([], [], _) -> do+ () -> do let uniques = flip concatMap udspair $ \(uname, ucols) -> [ AlterTable name $ AddUniqueConstraint uname $@@ -941,11 +952,12 @@ let foreigns = do Column { cName=cname, cReference=Just (refTblName, _a) } <- newcols return $ AlterColumn name (refTblName, addReference allDefs (refName name cname) refTblName cname)- - let foreignsAlt = map (\fdef -> let (childfields, parentfields) = unzip (map (\((_,b),(_,d)) -> (b,d)) (foreignFields fdef)) ++ let foreignsAlt = map (\fdef -> let (childfields, parentfields) = unzip (map (\((_,b),(_,d)) -> (b,d)) (foreignFields fdef)) in AlterColumn name (foreignRefTableDBName fdef, AddReference (foreignRefTableDBName fdef) (foreignConstraintNameDBName fdef) childfields parentfields)) fdefs- + return $ Right $ map showAlterDb $ (addTable newcols val): uniques ++ foreigns ++ foreignsAlt+ {- FIXME redundant, why is this here? The whole case expression is weird -- No errors and something found, migrate (_, _, ([], old')) -> do let excludeForeignKeys (xs,ys) = (map (\c -> case cReference c of@@ -959,6 +971,7 @@ return $ Right $ map showAlterDb $ acs' ++ ats' -- Errors (_, _, (errs, _)) -> return $ Left errs+ -} where findTypeAndMaxLen tblName col = let (col', ty) = findTypeOfColumn allDefs tblName col@@ -991,7 +1004,9 @@ connNoLimit = undefined, connRDBMS = undefined, connLimitOffset = undefined,- connLogFunc = undefined}+ connLogFunc = undefined,+ connUpsertSql = undefined,+ connMaxParams = Nothing} result = runReaderT . runWriterT . runWriterT $ mig resp <- result sqlbackend mapM_ T.putStrLn $ map snd $ snd resp
persistent-mysql.cabal view
@@ -1,5 +1,5 @@ name: persistent-mysql-version: 2.6+version: 2.6.0.1 license: MIT license-file: LICENSE author: Felipe Lessa <felipe.lessa@gmail.com>, Michael Snoyman@@ -29,10 +29,10 @@ library build-depends: base >= 4.6 && < 5 , transformers >= 0.2.1- , mysql-simple >= 0.2.2.3 && < 0.3+ , mysql-simple >= 0.2.2.3 && < 0.5 , mysql >= 0.1.1.3 && < 0.2 , blaze-builder- , persistent >= 2.6 && < 3+ , persistent >= 2.6.1 && < 3 , containers >= 0.2 , bytestring >= 0.9 , text >= 0.11.0.6