persistent-postgresql 1.3.1.3 → 2.0.0
raw patch · 2 files changed
+58/−49 lines, 2 filesdep +monad-loggerdep ~persistentdep ~postgresql-simpledep ~resourcet
Dependencies added: monad-logger
Dependency ranges changed: persistent, postgresql-simple, resourcet
Files
Database/Persist/Postgresql.hs view
@@ -44,6 +44,7 @@ import Data.Function (on) import Data.Conduit import qualified Data.Conduit.List as CL+import Control.Monad.Logger (MonadLogger, runNoLoggingT) import qualified Data.IntMap as I @@ -57,6 +58,7 @@ import Data.Text (Text) import Data.Aeson import Control.Monad (forM, mzero)+import Data.Acquire (Acquire, mkAcquire, with) import System.Environment (getEnvironment) import Data.Int (Int64) import Data.Monoid ((<>))@@ -74,7 +76,7 @@ -- finishes using it. Note that you should not use the given -- 'ConnectionPool' outside the action since it may be already -- been released.-withPostgresqlPool :: MonadIO m+withPostgresqlPool :: (MonadBaseControl IO m, MonadLogger m, MonadIO m) => ConnectionString -- ^ Connection string to the database. -> Int@@ -91,7 +93,7 @@ -- responsability to properly close the connection pool when -- unneeded. Use 'withPostgresqlPool' for an automatic resource -- control.-createPostgresqlPool :: MonadIO m+createPostgresqlPool :: (MonadIO m, MonadBaseControl IO m, MonadLogger m) => ConnectionString -- ^ Connection string to the database. -> Int@@ -103,17 +105,17 @@ -- | Same as 'withPostgresqlPool', but instead of opening a pool -- of connections, only one connection is opened.-withPostgresqlConn :: (MonadIO m, MonadBaseControl IO m)+withPostgresqlConn :: (MonadIO m, MonadBaseControl IO m, MonadLogger m) => ConnectionString -> (Connection -> m a) -> m a withPostgresqlConn = withSqlConn . open' -open' :: ConnectionString -> IO Connection-open' cstr = PG.connectPostgreSQL cstr >>= openSimpleConn+open' :: ConnectionString -> LogFunc -> IO Connection+open' cstr logFunc = PG.connectPostgreSQL cstr >>= openSimpleConn logFunc -- | Generate a 'Connection' from a 'PG.Connection'-openSimpleConn :: PG.Connection -> IO Connection-openSimpleConn conn = do- smap <- newIORef Map.empty+openSimpleConn :: LogFunc -> PG.Connection -> IO Connection+openSimpleConn logFunc conn = do+ smap <- newIORef $ Map.empty return Connection { connPrepare = prepare' conn , connStmtMap = smap@@ -127,6 +129,7 @@ , connNoLimit = "LIMIT ALL" , connRDBMS = "postgresql" , connLimitOffset = decorateSQLWithLimitOffset "LIMIT ALL"+ , connLogFunc = logFunc } prepare' :: PG.Connection -> Text -> IO Statement@@ -139,7 +142,7 @@ , stmtQuery = withStmt' conn query } -insertSql' :: EntityDef SqlType -> [PersistValue] -> InsertSqlResult+insertSql' :: EntityDef -> [PersistValue] -> InsertSqlResult insertSql' ent vals = let sql = T.concat [ "INSERT INTO "@@ -161,13 +164,13 @@ execute' :: PG.Connection -> PG.Query -> [PersistValue] -> IO Int64 execute' conn query vals = PG.execute conn query (map P vals) -withStmt' :: MonadResource m+withStmt' :: MonadIO m => PG.Connection -> PG.Query -> [PersistValue]- -> Source m [PersistValue]+ -> Acquire (Source m [PersistValue]) withStmt' conn query vals =- bracketP openS closeS pull+ pull `fmap` mkAcquire openS closeS where openS = do -- Construct raw query@@ -245,7 +248,6 @@ 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@@ -290,8 +292,8 @@ , (k PS.varchar, convertPV PersistText) , (k PS.date, convertPV PersistDay) , (k PS.time, convertPV PersistTimeOfDay)- , (k PS.timestamp, convertPV (PersistUTCTime . localTimeToUTC utc))- , (k PS.timestamptz, convertPV (PersistZonedTime . ZT))+ , (k PS.timestamp, convertPV PersistUTCTime)+ , (k PS.timestamptz, convertPV PersistUTCTime) , (k PS.bit, convertPV PersistInt64) , (k PS.varbit, convertPV PersistInt64) , (k PS.numeric, convertPV PersistRational)@@ -299,12 +301,7 @@ , (k PS.uuid, convertPV (PersistDbSpecific . unUnknown)) , (k PS.json, convertPV (PersistByteString . unUnknown)) , (k PS.unknown, convertPV (PersistByteString . unUnknown))- -- add Inet and Cidr types- , (k PS.inet, convertPV (PersistDbSpecific . unUnknown))- , (k PS.cidr, convertPV (PersistDbSpecific . unUnknown))- - -- array types: same order as above , (1000, listOf PersistBool) , (1001, listOf (PersistByteString . unBinary))@@ -324,8 +321,8 @@ , (1015, listOf PersistText) , (1182, listOf PersistDay) , (1183, listOf PersistTimeOfDay)- , (1115, listOf (PersistUTCTime . localTimeToUTC utc))- , (1185, listOf (PersistZonedTime . ZT))+ , (1115, listOf PersistUTCTime)+ , (1185, listOf PersistUTCTime) , (1561, listOf PersistInt64) , (1563, listOf PersistInt64) , (1231, listOf PersistRational)@@ -361,7 +358,7 @@ -> IO Bool doesTableExist getter (DBName name) = do stmt <- getter sql- runResourceT $ stmtQuery stmt vals $$ start+ with (stmtQuery stmt vals) ($$ start) where sql = "SELECT COUNT(*) FROM information_schema.tables WHERE table_name=?" vals = [PersistText name]@@ -372,9 +369,9 @@ start' res = error $ "doesTableExist returned unexpected result: " ++ show res finish x = await >>= maybe (return x) (error "Too many rows returned in doesTableExist") -migrate' :: [EntityDef a]+migrate' :: [EntityDef] -> (Text -> IO Statement)- -> EntityDef SqlType+ -> EntityDef -> IO (Either [Text] [(Bool, Text)]) migrate' allDefs getter val = fmap (fmap $ map showAlterDb) $ do let name = entityDB val@@ -395,7 +392,7 @@ if not exists then do let idtxt = case entityPrimary val of- Just pdef -> T.concat [" PRIMARY KEY (", T.intercalate "," $ map (escape . snd) $ primaryFields pdef, ")"]+ Just pdef -> T.concat [" PRIMARY KEY (", T.intercalate "," $ map (escape . fieldDB) $ primaryFields pdef, ")"] Nothing -> T.concat [escape $ entityID val , " SERIAL PRIMARY KEY UNIQUE"] let addTable = AddTable $ T.concat@@ -423,7 +420,8 @@ type SafeToRemove = Bool -data AlterColumn = Type SqlType | IsNull | NotNull | Add' Column | Drop SafeToRemove+data AlterColumn = Type SqlType Text+ | IsNull | NotNull | Add' Column | Drop SafeToRemove | Default Text | NoDefault | Update' Text | AddReference DBName [DBName] [DBName] | DropReference DBName type AlterColumn' = (DBName, AlterColumn)@@ -437,7 +435,7 @@ -- | Returns all of the columns in the given table currently in the database. getColumns :: (Text -> IO Statement)- -> EntityDef a+ -> EntityDef -> IO [Either Text (Either Column (DBName, [DBName]))] getColumns getter def = do let sqlv=T.concat ["SELECT "@@ -458,7 +456,7 @@ [ PersistText $ unDBName $ entityDB def , PersistText $ unDBName $ entityID def ]- cs <- runResourceT $ stmtQuery stmt vals $$ helper+ cs <- with (stmtQuery stmt vals) ($$ helper) let sqlc = T.concat ["SELECT " ,"c.constraint_name, " ,"c.column_name "@@ -477,7 +475,7 @@ stmt' <- getter sqlc - us <- runResourceT $ stmtQuery stmt' vals $$ helperU+ us <- with (stmtQuery stmt' vals) ($$ helperU) return $ cs ++ us where getAll front = do@@ -505,14 +503,14 @@ -- | Check if a column name is listed as the "safe to remove" in the entity -- list.-safeToRemove :: EntityDef a -> DBName -> Bool+safeToRemove :: EntityDef -> DBName -> Bool safeToRemove def (DBName colName) = any (elem "SafeToRemove" . fieldAttrs) $ filter ((== DBName colName) . fieldDB) $ entityFields def -getAlters :: [EntityDef a]- -> EntityDef SqlType+getAlters :: [EntityDef]+ -> EntityDef -> ([Column], [(DBName, [DBName])]) -> ([Column], [(DBName, [DBName])]) -> ([AlterColumn'], [AlterTable])@@ -587,12 +585,12 @@ ] let ref = refName tname cname stmt <- getter sql- runResourceT $ stmtQuery stmt+ with (stmtQuery stmt [ PersistText $ unDBName tname , PersistText $ unDBName ref- ] $$ do+ ]) ($$ do Just [PersistInt64 i] <- CL.head- return $ if i == 0 then Nothing else Just (DBName "", ref)+ return $ if i == 0 then Nothing else Just (DBName "", ref)) d' = case d of PersistNull -> Right Nothing PersistText t -> Right $ Just t@@ -602,8 +600,7 @@ getType "varchar" = Right SqlString getType "date" = Right SqlDay getType "bool" = Right SqlBool- getType "timestamp" = Right SqlDayTime- getType "timestamptz" = Right SqlDayTimeZoned+ getType "timestamptz" = Right SqlDayTime getType "float4" = Right SqlReal getType "float8" = Right SqlReal getType "bytea" = Right SqlBlob@@ -621,7 +618,7 @@ sqlTypeEq x y = T.toCaseFold (showSqlType x) == T.toCaseFold (showSqlType y) -findAlters :: [EntityDef a] -> DBName -> Column -> [Column] -> ([AlterColumn'], [Column])+findAlters :: [EntityDef] -> DBName -> Column -> [Column] -> ([AlterColumn'], [Column]) findAlters defs _tablename col@(Column name isNull sqltype def _defConstraintName _maxLen ref) cols = case filter (\c -> cName c == name) cols of [] -> ([(name, Add' col)], cols)@@ -644,7 +641,18 @@ Just s -> (:) (name, Update' s) in up [(name, NotNull)] _ -> []- modType = if sqlTypeEq sqltype sqltype' then [] else [(name, Type sqltype)]+ modType+ | sqlTypeEq sqltype sqltype' = []+ -- When converting from Persistent pre-2.0 databases, we+ -- need to make sure that TIMESTAMP WITHOUT TIME ZONE is+ -- treated as UTC.+ | sqltype == SqlDayTime && sqltype' == SqlOther "timestamp" =+ [(name, Type sqltype $ T.concat+ [ " USING "+ , escape name+ , " AT TIME ZONE 'UTC'"+ ])]+ | otherwise = [(name, Type sqltype "")] modDef = if def == def' then []@@ -655,7 +663,7 @@ filter (\c -> cName c /= name) cols) -- | Get the references to be added to a table for the given column.-getAddReference :: [EntityDef a] -> DBName -> DBName -> DBName -> Maybe (DBName, DBName) -> Maybe AlterDB+getAddReference :: [EntityDef] -> DBName -> DBName -> DBName -> Maybe (DBName, DBName) -> Maybe AlterDB getAddReference allDefs table reftable cname ref = case ref of Nothing -> Nothing@@ -687,8 +695,7 @@ showSqlType (SqlNumeric s prec) = T.concat [ "NUMERIC(", T.pack (show s), ",", T.pack (show prec), ")" ] showSqlType SqlDay = "DATE" showSqlType SqlTime = "TIME"-showSqlType SqlDayTime = "TIMESTAMP"-showSqlType SqlDayTimeZoned = "TIMESTAMP WITH TIME ZONE"+showSqlType SqlDayTime = "TIMESTAMP WITH TIME ZONE" showSqlType SqlBlob = "BYTEA" showSqlType SqlBool = "BOOLEAN" @@ -724,7 +731,7 @@ ] showAlter :: DBName -> AlterColumn' -> Text-showAlter table (n, Type t) =+showAlter table (n, Type t extra) = T.concat [ "ALTER TABLE " , escape table@@ -732,6 +739,7 @@ , escape n , " TYPE " , showSqlType t+ , extra ] showAlter table (n, IsNull) = T.concat@@ -831,7 +839,7 @@ instance PersistConfig PostgresConf where type PersistConfigBackend PostgresConf = SqlPersistT type PersistConfigPool PostgresConf = ConnectionPool- createPoolConfig (PostgresConf cs size) = createPostgresqlPool cs size+ createPoolConfig (PostgresConf cs size) = runNoLoggingT $ createPostgresqlPool cs size -- FIXME runPool _ = runSqlPool loadConfig (Object o) = do database <- o .: "database"
persistent-postgresql.cabal view
@@ -1,5 +1,5 @@ name: persistent-postgresql-version: 1.3.1.3+version: 2.0.0 license: MIT license-file: LICENSE author: Felipe Lessa, Michael Snoyman <michael@snoyman.com>@@ -16,9 +16,9 @@ library build-depends: base >= 4 && < 5 , transformers >= 0.2.1- , postgresql-simple >= 0.4.0 && < 0.5+ , postgresql-simple >= 0.3.10 && < 0.5 , postgresql-libpq >= 0.6.1 && < 0.10- , persistent >= 1.3 && < 1.4+ , persistent >= 2.0 && < 2.1 , containers >= 0.2 , bytestring >= 0.9 , text >= 0.7@@ -27,7 +27,8 @@ , time >= 1.1 , aeson >= 0.5 , conduit >= 0.5.3- , resourcet+ , resourcet >= 1.1+ , monad-logger >= 0.3.4 exposed-modules: Database.Persist.Postgresql ghc-options: -Wall