persistent-postgresql 0.9.1 → 1.0.0
raw patch · 2 files changed
+62/−52 lines, 2 filesdep ~conduitdep ~persistentdep ~postgresql-simple
Dependency ranges changed: conduit, persistent, postgresql-simple
Files
Database/Persist/Postgresql.hs view
@@ -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)
persistent-postgresql.cabal view
@@ -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 <michael@snoyman.com>@@ -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