persistent-postgresql 2.10.1.1 → 2.10.1.2
raw patch · 4 files changed
+47/−14 lines, 4 files
Files
- ChangeLog.md +4/−0
- Database/Persist/Postgresql.hs +29/−13
- persistent-postgresql.cabal +1/−1
- test/CustomConstraintTest.hs +13/−0
ChangeLog.md view
@@ -1,5 +1,9 @@ # Changelog for persistent-postgresql +## 2.10.1.2++* Fix issue with multiple foreign keys on single column. [#1010](https://github.com/yesodweb/persistent/pull/1010)+ ## 2.10.1.1 * Compatibility with latest persistent-template for test suite [#1002](https://github.com/yesodweb/persistent/pull/1002/files)
Database/Persist/Postgresql.hs view
@@ -554,7 +554,7 @@ -> EntityDef -> IO (Either [Text] [(Bool, Text)]) migrate' allDefs getter entity = fmap (fmap $ map showAlterDb) $ do- old <- getColumns getter entity+ old <- getColumns getter entity newcols' case partitionEithers old of ([], old'') -> do exists <-@@ -565,6 +565,7 @@ (errs, _) -> return $ Left errs where name = entityDB entity+ (newcols', udefs, fdefs) = mkColumns allDefs entity migrationText exists old'' = if not exists then createText newcols fdefs udspair@@ -574,7 +575,6 @@ in acs' ++ ats' where old' = partitionEithers old''- (newcols', udefs, fdefs) = mkColumns allDefs entity newcols = filter (not . safeToRemove entity . cName) newcols' udspair = map udToPair udefs excludeForeignKeys (xs,ys) = (map excludeForeignKey xs,ys)@@ -650,9 +650,9 @@ -- | Returns all of the columns in the given table currently in the database. getColumns :: (Text -> IO Statement)- -> EntityDef+ -> EntityDef -> [Column] -> IO [Either Text (Either Column (DBName, [DBName]))]-getColumns getter def = do+getColumns getter def cols = do let sqlv=T.concat ["SELECT " ,"column_name " ,",is_nullable "@@ -700,6 +700,10 @@ us <- with (stmtQuery stmt' vals) (\src -> runConduit $ src .| helperU) return $ cs ++ us where+ refMap = Map.fromList $ foldl ref [] cols+ where ref rs c = case cReference c of+ Nothing -> rs+ (Just r) -> (unDBName $ cName c, r) : rs getAll front = do x <- CL.head case x of@@ -715,8 +719,8 @@ x <- CL.head case x of Nothing -> return []- Just x' -> do- col <- liftIO $ getColumn getter (entityDB def) x'+ Just x'@((PersistText cname):_) -> do+ col <- liftIO $ getColumn getter (entityDB def) x' (Map.lookup cname refMap) let col' = case col of Left e -> Left e Right c -> Right $ Left c@@ -764,8 +768,9 @@ getColumn :: (Text -> IO Statement) -> DBName -> [PersistValue]+ -> Maybe (DBName, DBName) -> IO (Either Text Column)-getColumn getter tableName' [PersistText columnName, PersistText isNullable, PersistText typeName, defaultValue, numericPrecision, numericScale, maxlen] =+getColumn getter tableName' [PersistText columnName, PersistText isNullable, PersistText typeName, defaultValue, numericPrecision, numericScale, maxlen] refName = case d' of Left s -> return $ Left s Right d'' ->@@ -776,7 +781,7 @@ Left s -> return $ Left s Right t -> do let cname = DBName columnName- ref <- getRef cname+ ref <- getRef cname refName return $ Right Column { cName = cname , cNull = isNullable == "YES"@@ -798,7 +803,8 @@ case T.stripSuffix p t of Nothing -> loop' ps Just t' -> t'- getRef cname = do+ getRef _ Nothing = return Nothing+ getRef cname (Just (_, refName')) = do let sql = T.concat ["SELECT DISTINCT " ,"ccu.table_name, " ,"tc.constraint_name "@@ -810,16 +816,26 @@ ,"AND ccu.constraint_name=kcu.constraint_name " ,"AND kcu.ordinal_position=1 " ,"AND kcu.table_name=? "- ,"AND kcu.column_name=?"]+ ,"AND kcu.column_name=? "+ ,"AND tc.constraint_name=?"] stmt <- getter sql cntrs <- with (stmtQuery stmt [PersistText $ unDBName tableName'- ,PersistText $ unDBName cname])+ ,PersistText $ unDBName cname+ ,PersistText $ unDBName refName']) (\src -> runConduit $ src .| CL.consume) case cntrs of [] -> return Nothing [[PersistText table, PersistText constraint]] -> return $ Just (DBName table, DBName constraint)- _ -> error "Postgresql.getColumn: error fetching constraints"+ xs ->+ error $ mconcat+ [ "Postgresql.getColumn: error fetching constraints. Expected a single result for foreign key query for table: "+ , T.unpack (unDBName tableName')+ , " and column: "+ , T.unpack (unDBName cname)+ , " but got: "+ , show xs+ ] d' = case defaultValue of PersistNull -> Right Nothing PersistText t -> Right $ Just t@@ -861,7 +877,7 @@ , ", respectively." , " Specify the values as numeric(total_digits, digits_after_decimal_place)." ]-getColumn _ _ columnName =+getColumn _ _ columnName _ = return $ Left $ T.pack $ "Invalid result from information_schema: " ++ show columnName -- | Intelligent comparison of SQL types, to account for SqlInt32 vs SqlOther integer
persistent-postgresql.cabal view
@@ -1,5 +1,5 @@ name: persistent-postgresql-version: 2.10.1.1+version: 2.10.1.2 license: MIT license-file: LICENSE author: Felipe Lessa, Michael Snoyman <michael@snoyman.com>
test/CustomConstraintTest.hs view
@@ -23,6 +23,12 @@ CustomConstraint2 cc_id CustomConstraint1Id constraint=custom_constraint deriving Show++CustomConstraint3+ -- | This will lead to a constraint with the name custom_constraint3_cc_id1_fkey+ cc_id1 CustomConstraint1Id+ cc_id2 CustomConstraint1Id+ deriving Show |] specs :: (MonadIO m, MonadFail m) => RunDb SqlBackend m -> Spec@@ -51,3 +57,10 @@ ,PersistText "custom_constraint"] liftIO $ 1 @?= (exists :: Int) + it "allows multiple constraints on a single column" $ runDb $ do+ runMigration customConstraintMigrate+ -- | Here we add another foreign key on the same column where the default one already exists. In practice, this could be a compound key with another field.+ rawExecute "ALTER TABLE \"custom_constraint3\" ADD CONSTRAINT \"extra_constraint\" FOREIGN KEY(\"cc_id1\") REFERENCES \"custom_constraint1\"(\"id\")" []+ -- | This is where the error is thrown in `getColumn`+ _ <- getMigration customConstraintMigrate+ pure ()