diff --git a/Database/Persist/MySQL.hs b/Database/Persist/MySQL.hs --- a/Database/Persist/MySQL.hs +++ b/Database/Persist/MySQL.hs @@ -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) 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: 0.9.0.3 +version: 1.0.0 license: MIT license-file: LICENSE author: Felipe Lessa , 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