diff --git a/Database/Persist/Postgresql.hs b/Database/Persist/Postgresql.hs --- a/Database/Persist/Postgresql.hs +++ b/Database/Persist/Postgresql.hs @@ -39,14 +39,14 @@ import Control.Arrow import Data.List (sort, groupBy) import Data.Function (on) -import qualified Data.Conduit as C +import Data.Conduit import qualified Data.Conduit.List as CL import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B8 import qualified Data.Text as T import qualified Data.Text.Encoding as T --- import Data.Time.LocalTime (localTimeToUTC, utc) +import Data.Time.LocalTime (localTimeToUTC, utc) import Data.Text (Text, pack) import Data.Aeson import Control.Monad (forM, mzero) @@ -143,14 +143,13 @@ _ <- PG.execute conn query (map P vals) return () -withStmt' :: C.MonadResource m +withStmt' :: MonadResource m => PG.Connection -> PG.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 -- Construct raw query @@ -195,11 +194,17 @@ closeS (ret, _, _, _) = LibPQ.unsafeFreeResult ret + pull x = do + y <- liftIO $ pullS x + case y of + Nothing -> return () + Just z -> yield z >> pull x + pullS (ret, rowRef, rowCount, getters) = do row <- atomicModifyIORef rowRef (\r -> (r+1, r)) if row == rowCount - then return C.IOClosed - else fmap C.IOOpen $ forM (zip getters [0..]) $ \(getter, col) -> do + then return Nothing + else fmap Just $ forM (zip getters [0..]) $ \(getter, col) -> do mbs <- LibPQ.getvalue' ret row col case mbs of Nothing -> return PersistNull @@ -220,6 +225,7 @@ toField (P (PersistDay d)) = PGTF.toField d toField (P (PersistTimeOfDay t)) = PGTF.toField t toField (P (PersistUTCTime t)) = PGTF.toField t + toField (P (PersistZonedTime (ZT t))) = PGTF.toField t toField (P PersistNull) = PGTF.toField PG.Null toField (P (PersistList l)) = PGTF.toField $ listToJSON l toField (P (PersistMap m)) = PGTF.toField $ mapToJSON m @@ -233,29 +239,30 @@ -- FIXME: check if those are correct and complete. getGetter :: PG.BuiltinType -> Getter PersistValue -getGetter PG.Bool = convertPV PersistBool -getGetter PG.Bytea = convertPV (PersistByteString . unBinary) -getGetter PG.Char = convertPV PersistText -getGetter PG.Name = convertPV PersistText -getGetter PG.Int8 = convertPV PersistInt64 -getGetter PG.Int2 = convertPV PersistInt64 -getGetter PG.Int4 = convertPV PersistInt64 -getGetter PG.Text = convertPV PersistText -getGetter PG.Xml = convertPV PersistText -getGetter PG.Float4 = convertPV PersistDouble -getGetter PG.Float8 = convertPV PersistDouble -getGetter PG.Abstime = convertPV PersistUTCTime -getGetter PG.Reltime = convertPV PersistUTCTime -getGetter PG.Money = convertPV PersistDouble -getGetter PG.Bpchar = convertPV PersistText -getGetter PG.Varchar = convertPV PersistText -getGetter PG.Date = convertPV PersistDay -getGetter PG.Time = convertPV PersistTimeOfDay -getGetter PG.Timestamp = convertPV PersistUTCTime -getGetter PG.Bit = convertPV PersistInt64 -getGetter PG.Varbit = convertPV PersistInt64 -getGetter PG.Numeric = convertPV (PersistDouble . fromRational) -getGetter PG.Void = \_ _ -> Ok PersistNull +getGetter PG.Bool = convertPV PersistBool +getGetter PG.ByteA = convertPV (PersistByteString . unBinary) +getGetter PG.Char = convertPV PersistText +getGetter PG.Name = convertPV PersistText +getGetter PG.Int8 = convertPV PersistInt64 +getGetter PG.Int2 = convertPV PersistInt64 +getGetter PG.Int4 = convertPV PersistInt64 +getGetter PG.Text = convertPV PersistText +getGetter PG.Xml = convertPV PersistText +getGetter PG.Float4 = convertPV PersistDouble +getGetter PG.Float8 = convertPV PersistDouble +getGetter PG.AbsTime = convertPV PersistUTCTime +getGetter PG.RelTime = convertPV PersistUTCTime +getGetter PG.Money = convertPV PersistDouble +getGetter PG.BpChar = convertPV PersistText +getGetter PG.VarChar = convertPV PersistText +getGetter PG.Date = convertPV PersistDay +getGetter PG.Time = convertPV PersistTimeOfDay +getGetter PG.Timestamp = convertPV (PersistUTCTime . localTimeToUTC utc) +getGetter PG.TimestampTZ = convertPV (PersistZonedTime . ZT) +getGetter PG.Bit = convertPV PersistInt64 +getGetter PG.VarBit = convertPV PersistInt64 +getGetter PG.Numeric = convertPV (PersistDouble . fromRational) +getGetter PG.Void = \_ _ -> Ok PersistNull getGetter other = error $ "Postgresql.getGetter: type " ++ show other ++ " not supported." @@ -317,10 +324,10 @@ [ PersistText $ unDBName $ entityDB def , PersistText $ unDBName $ entityID def ] - cs <- C.runResourceT $ withStmt stmt vals C.$$ helper + cs <- runResourceT $ withStmt stmt vals $$ helper stmt' <- getter "SELECT constraint_name, column_name FROM information_schema.constraint_column_usage WHERE table_name=? AND column_name <> ? ORDER BY constraint_name, column_name" - us <- C.runResourceT $ withStmt stmt' vals C.$$ helperU + us <- runResourceT $ withStmt stmt' vals $$ helperU return $ cs ++ us where getAll front = do @@ -396,27 +403,28 @@ ] let ref = refName tname cname stmt <- getter sql - C.runResourceT $ withStmt stmt + runResourceT $ withStmt stmt [ PersistText $ unDBName tname , PersistText $ unDBName ref - ] C.$$ do + ] $$ do Just [PersistInt64 i] <- CL.head return $ if i == 0 then Nothing else Just (DBName "", ref) d' = case d of PersistNull -> Right Nothing PersistText t -> Right $ Just t _ -> Left $ pack $ "Invalid default column: " ++ show d - getType "int4" = Right $ SqlInt32 - getType "int8" = Right $ SqlInteger - getType "varchar" = Right $ SqlString - getType "date" = Right $ SqlDay - getType "bool" = Right $ SqlBool - getType "timestamp" = Right $ SqlDayTime - getType "float4" = Right $ SqlReal - getType "float8" = Right $ SqlReal - getType "bytea" = Right $ SqlBlob - getType "time" = Right $ SqlTime - getType a = Left $ "Unknown type: " `T.append` a + getType "int4" = Right $ SqlInt32 + getType "int8" = Right $ SqlInt64 + getType "varchar" = Right $ SqlString + getType "date" = Right $ SqlDay + getType "bool" = Right $ SqlBool + getType "timestamp" = Right $ SqlDayTime + getType "timestamptz" = Right $ SqlDayTimeZoned + getType "float4" = Right $ SqlReal + getType "float8" = Right $ SqlReal + getType "bytea" = Right $ SqlBlob + getType "time" = Right $ SqlTime + getType a = Left $ "Unknown type: " `T.append` a getColumn _ _ x = return $ Left $ pack $ "Invalid result from information_schema: " ++ show x @@ -469,13 +477,15 @@ showSqlType :: SqlType -> String showSqlType SqlString = "VARCHAR" showSqlType SqlInt32 = "INT4" -showSqlType SqlInteger = "INT8" +showSqlType SqlInt64 = "INT8" showSqlType SqlReal = "DOUBLE PRECISION" showSqlType SqlDay = "DATE" showSqlType SqlTime = "TIME" showSqlType SqlDayTime = "TIMESTAMP" +showSqlType SqlDayTimeZoned = "TIMESTAMP WITH TIME ZONE" showSqlType SqlBlob = "BYTEA" showSqlType SqlBool = "BOOLEAN" +showSqlType (SqlOther t) = T.unpack t showAlterDb :: AlterDB -> (Bool, Text) showAlterDb (AddTable s) = (False, pack s) diff --git a/persistent-postgresql.cabal b/persistent-postgresql.cabal --- a/persistent-postgresql.cabal +++ b/persistent-postgresql.cabal @@ -1,5 +1,5 @@ name: persistent-postgresql -version: 0.9.1 +version: 1.0.0 license: MIT license-file: LICENSE author: Felipe Lessa, Michael Snoyman @@ -15,16 +15,16 @@ library build-depends: base >= 4 && < 5 , transformers >= 0.2.1 && < 0.4 - , postgresql-simple >= 0.1 && < 0.2 + , postgresql-simple >= 0.2 && < 0.3 , postgresql-libpq >= 0.6.1 && < 0.9 - , persistent >= 0.9 && < 0.10 + , persistent >= 1.0 && < 1.1 , containers >= 0.2 , bytestring >= 0.9 , text >= 0.7 && < 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.Postgresql ghc-options: -Wall