persistent-mysql 0.9.0.3 → 1.0.0
raw patch · 2 files changed
+45/−38 lines, 2 filesdep −timedep ~conduitdep ~persistentPVP ok
version bump matches the API change (PVP)
Dependencies removed: time
Dependency ranges changed: conduit, persistent
API changes (from Hackage documentation)
Files
- Database/Persist/MySQL.hs +42/−34
- persistent-mysql.cabal +3/−4
Database/Persist/MySQL.hs view
@@ -28,10 +28,9 @@ import Data.IORef import Data.List (find, intercalate, sort, groupBy) import Data.Text (Text, pack)--- import Data.Time.LocalTime (localTimeToUTC, utc) import System.Environment (getEnvironment) -import qualified Data.Conduit as C+import Data.Conduit import qualified Data.Conduit.List as CL import qualified Data.Map as Map import qualified Data.Text as T@@ -148,14 +147,13 @@ -- | Execute an statement that does return results. The results -- are fetched all at once and stored into memory.-withStmt' :: C.MonadResource m+withStmt' :: MonadResource m => MySQL.Connection -> MySQL.Query -> [PersistValue]- -> C.Source m [PersistValue]-withStmt' conn query vals = C.sourceIO (liftIO openS )- (liftIO . closeS)- (liftIO . pullS )+ -> Source m [PersistValue]+withStmt' conn query vals =+ bracketP openS closeS pull where openS = do -- Execute the query@@ -171,11 +169,17 @@ closeS (result, _) = MySQLBase.freeResult result + pull x = do+ y <- liftIO $ pullS x+ case y of+ Nothing -> return ()+ Just z -> yield z >> pull x+ pullS (result, getters) = do row <- MySQLBase.fetchRow result case row of- [] -> return C.IOClosed -- Do not free the result per sourceIO's docs.- _ -> return $ C.IOOpen $ zipWith ($) getters row+ [] -> return Nothing -- Do not free the result per sourceIO's docs.+ _ -> return $ Just $ zipWith ($) getters row -- | @newtype@ around 'PersistValue' that supports the@@ -191,6 +195,7 @@ 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@@ -221,10 +226,11 @@ getGetter MySQLBase.Double = convertPV PersistDouble getGetter MySQLBase.Decimal = convertPV PersistDouble getGetter MySQLBase.NewDecimal = convertPV PersistDouble--- ByteString and Text-getGetter MySQLBase.VarChar = convertPV PersistByteString-getGetter MySQLBase.VarString = convertPV PersistByteString-getGetter MySQLBase.String = convertPV PersistByteString+-- Text+getGetter MySQLBase.VarChar = convertPV persistText+getGetter MySQLBase.VarString = convertPV persistText+getGetter MySQLBase.String = convertPV persistText+-- ByteString getGetter MySQLBase.Blob = convertPV PersistByteString getGetter MySQLBase.TinyBlob = convertPV PersistByteString getGetter MySQLBase.MediumBlob = convertPV PersistByteString@@ -245,7 +251,10 @@ getGetter other = error $ "MySQL.getGetter: type " ++ show other ++ " not supported." +persistText :: ByteString -> PersistValue+persistText = PersistText . T.decodeUtf8 + ---------------------------------------------------------------------- @@ -355,8 +364,8 @@ \WHERE TABLE_SCHEMA = ? \ \AND TABLE_NAME = ? \ \AND COLUMN_NAME <> ?"- inter <- C.runResourceT $ withStmt stmtClmns vals C.$$ CL.consume- cs <- C.runResourceT $ CL.sourceList inter C.$$ helperClmns -- avoid nested queries+ inter <- runResourceT $ withStmt stmtClmns vals $$ CL.consume+ cs <- runResourceT $ CL.sourceList inter $$ helperClmns -- avoid nested queries -- Find out the constraints. stmtCntrs <- getter "SELECT CONSTRAINT_NAME, \@@ -368,7 +377,7 @@ \AND REFERENCED_TABLE_SCHEMA IS NULL \ \ORDER BY CONSTRAINT_NAME, \ \COLUMN_NAME"- us <- C.runResourceT $ withStmt stmtCntrs vals C.$$ helperCntrs+ us <- runResourceT $ withStmt stmtCntrs vals $$ helperCntrs -- Return both return $ cs ++ us@@ -377,16 +386,14 @@ , PersistText $ unDBName $ entityDB def , PersistText $ unDBName $ entityID def ] - helperClmns = CL.mapM getIt C.=$ CL.consume+ helperClmns = CL.mapM getIt =$ CL.consume where getIt = fmap (either Left (Right . Left)) . liftIO . getColumn connectInfo getter (entityDB def) helperCntrs = do- let check [ PersistByteString cntrName- , PersistByteString clmnName] = return ( T.decodeUtf8 cntrName- , T.decodeUtf8 clmnName )+ let check [PersistText cntrName, PersistText clmnName] = return (cntrName, clmnName) check other = fail $ "helperCntrs: unexpected " ++ show other rows <- mapM check =<< CL.consume return $ map (Right . Right . (DBName . fst . head &&& map (DBName . snd)))@@ -399,9 +406,9 @@ -> DBName -> [PersistValue] -> IO (Either Text Column)-getColumn connectInfo getter tname [ PersistByteString cname- , PersistByteString null_- , PersistByteString type'+getColumn connectInfo getter tname [ PersistText cname+ , PersistText null_+ , PersistText type' , default'] = fmap (either (Left . pack) Right) $ runErrorT $ do@@ -432,17 +439,17 @@ \COLUMN_NAME" let vars = [ PersistText $ pack $ MySQL.connectDatabase connectInfo , PersistText $ unDBName $ tname- , PersistByteString cname+ , PersistText $ cname , PersistText $ pack $ MySQL.connectDatabase connectInfo ]- cntrs <- C.runResourceT $ withStmt stmt vars C.$$ CL.consume+ cntrs <- runResourceT $ withStmt stmt vars $$ CL.consume ref <- case cntrs of [] -> return Nothing- [[PersistByteString tab, PersistByteString ref]] ->- return $ Just (DBName $ T.decodeUtf8 tab, DBName $ T.decodeUtf8 ref)+ [[PersistText tab, PersistText ref]] ->+ return $ Just (DBName tab, DBName ref) _ -> fail "MySQL.getColumn/getRef: never here" -- Okay!- return $ Column (DBName $ T.decodeUtf8 cname) (null_ == "YES") type_ default_ Nothing ref -- FIXME: maxLen+ return $ Column (DBName cname) (null_ == "YES") type_ default_ Nothing ref -- FIXME: maxLen getColumn _ _ _ x = return $ Left $ pack $ "Invalid result from INFORMATION_SCHEMA: " ++ show x@@ -450,15 +457,15 @@ -- | Parse the type of column as returned by MySQL's -- @INFORMATION_SCHEMA@ tables.-parseType :: Monad m => ByteString -> m SqlType+parseType :: Monad m => Text -> m SqlType parseType "tinyint" = return SqlBool -- Ints parseType "int" = return SqlInt32 parseType "short" = return SqlInt32-parseType "long" = return SqlInteger-parseType "longlong" = return SqlInteger+parseType "long" = return SqlInt64+parseType "longlong" = return SqlInt64 parseType "mediumint" = return SqlInt32-parseType "bigint" = return SqlInteger+parseType "bigint" = return SqlInt64 -- Double parseType "float" = return SqlReal parseType "double" = return SqlReal@@ -583,13 +590,14 @@ showSqlType SqlBool _ = "TINYINT(1)" showSqlType SqlDay _ = "DATE" showSqlType SqlDayTime _ = "DATETIME"+showSqlType SqlDayTimeZoned _ = "VARCHAR(50) CHARACTER SET utf8" showSqlType SqlInt32 _ = "INT"-showSqlType SqlInteger _ = "BIGINT"+showSqlType SqlInt64 _ = "BIGINT" showSqlType SqlReal _ = "DOUBLE PRECISION" showSqlType SqlString Nothing = "TEXT CHARACTER SET utf8" showSqlType SqlString (Just i) = "VARCHAR(" ++ show i ++ ") CHARACTER SET utf8" showSqlType SqlTime _ = "TIME"-+showSqlType (SqlOther t) _ = T.unpack t -- | Render an action that must be done on the database. showAlterDb :: AlterDB -> (Bool, Text)
persistent-mysql.cabal view
@@ -1,5 +1,5 @@ name: persistent-mysql-version: 0.9.0.3+version: 1.0.0 license: MIT license-file: LICENSE author: Felipe Lessa <felipe.lessa@gmail.com>, Michael Snoyman@@ -28,14 +28,13 @@ , transformers >= 0.2.1 && < 0.4 , mysql-simple >= 0.2.2.3 && < 0.3 , mysql >= 0.1.1.3 && < 0.2- , persistent >= 0.9 && < 0.10+ , persistent >= 1.0 && < 1.1 , containers >= 0.2 , bytestring >= 0.9 , text >= 0.11.0.6 && < 0.12 , monad-control >= 0.2 && < 0.4- , time >= 1.1 , aeson >= 0.5- , conduit >= 0.4 && < 0.5+ , conduit >= 0.5 && < 0.6 exposed-modules: Database.Persist.MySQL ghc-options: -Wall