Commit 269a1687 authored by Michael Herold's avatar Michael Herold
Browse files

Changes to no data deletion as default (Fixes #10)

Also adds new option "--perimit-data-deletion"
parent c605e5e6
- Implement Parser.columnCheck
- Ensure that every module is only loaded once.
Giving 2x the same module in setup.yaml
can lead to strange errors
- Maybe a flag for strict parsing. Non-scrict turns
error messages for unkown keys to warnings
- Maybe a flag for sloppy parsing. Erronouse objects
are ignored and the next object is parsed
......@@ -51,7 +51,7 @@ run (Upgrade opt optDb optUpgrade) = do
deleteStmts <- pgsqlDeleteAllStmt conn
createStmts <- pgsqlGetFullStatements opt optDb setup
fragile <- pgsqlUpdateFragile conn createStmts
fragile <- pgsqlUpdateFragile optUpgrade conn createStmts
let stmts = (sort deleteStmts) ++ (sort $ fragile ++ (Data.List.filter afterDelete createStmts))
......
......@@ -104,16 +104,15 @@ parserOptInstall = OptInstall
-- Command Upgrade
data OptUpgrade = OptUpgrade {
optDeleteData :: Bool
optPermitDataDeletion :: Bool
}
deriving Show
parserOptUpgrade :: Parser OptUpgrade
parserOptUpgrade = OptUpgrade
<$> boolFlag
(long "do-not-delete-data"
<> short 'n'
<> help "NOT IMPLEMENTED: Do not perform table/column deletion (CURRENTLY NO EFFECT!)"
(long "perimit-data-deletion"
<> help "Permit deletion of columns or tables"
)
-- Command Doc
......@@ -126,18 +125,17 @@ data OptDoc = OptDoc {
parserOptDoc :: Parser OptDoc
parserOptDoc = OptDoc
<$> strOption
(
long "format" <>
(long "format" <>
short 'f' <>
val "html" <>
completeWith ["dot","html"]
)
<*> strOption
(
long "template" <>
(long "template" <>
short 't' <>
val "doc-template" <>
action "file -X '!*.html'" <>
action "file -X '!*.dot'" <>
action "directory"
)
......@@ -91,7 +91,7 @@ pgsqlDeleteFunctionStmt conn =
where
toStmt :: (SqlName, SqlName, PGArray SqlType) -> SqlStatement
toStmt (schema, function, args) = stmtDropFunction schema function (fromPGArray args)
toStmt (schema, function, args) = stmtDropFunction (schema, function, (fromPGArray args))
-- DROP TABLE CONSTRAINT
pgsqlDeleteTableConstraintStmt :: Connection -> IO [SqlStatement]
......@@ -107,8 +107,8 @@ pgsqlDeleteTableConstraintStmt conn =
return $ map f result
where
f :: (String, String, String) -> SqlStatement
f (schema, table, constraint) = stmtDropTableConstraint schema table constraint
f :: (SqlName, SqlName, SqlName) -> SqlStatement
f = stmtDropTableConstraint
-- DROP DOMAIN CONSTRAINT
pgsqlDeleteDomainConstraintStmt :: Connection -> IO [SqlStatement]
......@@ -124,8 +124,8 @@ pgsqlDeleteDomainConstraintStmt conn =
return $ map f result
where
f :: (String, String, String) -> SqlStatement
f (schema, domain, constraint) = stmtDropDomainConstraint schema domain constraint
f :: (SqlName, SqlName, SqlName) -> SqlStatement
f = stmtDropDomainConstraint
-- All DROP statements
pgsqlDeleteAllStmt :: Connection -> IO [SqlStatement]
......@@ -254,15 +254,19 @@ pgsqlCorrectTypes conn stmtsInstall = do
return $ stmtsCreate ++ stmtsDrop
pgsqlUpdateFragile :: Connection -> [SqlStatement] -> IO [SqlStatement]
pgsqlUpdateFragile conn stmtsInstall = do
pgsqlUpdateFragile :: OptUpgrade -> Connection -> [SqlStatement] -> IO [SqlStatement]
pgsqlUpdateFragile optUpgrade conn stmtsInstall = do
tables <- pgsqlCorrectTables conn stmtsInstall
columns <- pgsqlCorrectTableColumns conn stmtsInstall
domains <- pgsqlCorrectDomains conn stmtsInstall
types <- pgsqlCorrectTypes conn stmtsInstall
functions <- pgsqlCorrectFunctions conn stmtsInstall
return $ tables ++ columns ++ domains ++ types ++ functions
return $ if (optPermitDataDeletion optUpgrade)
then
tables ++ columns ++ domains ++ types ++ functions
else filter (\t -> typeEq SqlDropTable t || typeEq SqlDropColumn t)
tables ++ columns ++ domains ++ types ++ functions
-- DB Utils
......
......@@ -4,27 +4,21 @@ import Sql
import Parser.Basic
import Utils
-- ROLE
stmtDropRole :: SqlName -> SqlStatement
stmtDropRole role = SqlStmt SqlDropRole role $ "DROP ROLE " ++ toSql role
stmtDropFunction :: SqlName -> SqlName -> [SqlType] -> SqlStatement
stmtDropFunction schema function args =
-- FUNCTION
stmtDropFunction :: (SqlName, SqlName, [SqlType]) -> SqlStatement
stmtDropFunction (schema, function, args) =
SqlStmtFunction SqlDropFunction function args $
"DROP FUNCTION " ++ toSql(schema <.> function) ++
"(" ++ (join ", " (map toSql args)) ++ ")"
--" CASCADE"
stmtDropTableConstraint schema table constraint = SqlStmt SqlDropTableConstraint
(SqlName "") $
"ALTER TABLE " ++ toSql(SqlName $ schema ++ "." ++ table) ++
" DROP CONSTRAINT IF EXISTS " ++ toSql(SqlName constraint) -- ++ " CASCADE"
stmtDropDomainConstraint schema domain constraint = SqlStmt SqlDropDomainConstraint
(SqlName schema <.> SqlName domain) $
"ALTER DOMAIN " ++ toSql(SqlName $ schema ++ "." ++ domain) ++
" DROP CONSTRAINT " ++ toSql(SqlName constraint) ++ ""
-- TABLE
stmtDropTable :: SqlName -> SqlStatement
stmtDropTable t = SqlStmt SqlDropTable t $
"DROP TABLE " ++ toSql t
......@@ -33,11 +27,30 @@ stmtDropTableColumn :: (SqlName, SqlName) -> SqlStatement
stmtDropTableColumn (t, c) = SqlStmt SqlDropColumn (t <.> c) $
"ALTER TABLE " ++ toSql t ++ " DROP COLUMN " ++ toSql c
stmtDropTableConstraint :: (SqlName, SqlName, SqlName) -> SqlStatement
stmtDropTableConstraint (schema, table, constraint) = SqlStmt SqlDropTableConstraint
(schema <.> table <.> constraint) $
"ALTER TABLE " ++ toSql (schema <.> table) ++
" DROP CONSTRAINT IF EXISTS " ++ toSql constraint ++
-- Assuming that CASCADE will only cause other constraints to be deleted
-- Required since foreign keys may depend on other keys
" CASCADE"
-- DOMAIN
stmtDropDomain :: SqlName -> SqlStatement
stmtDropDomain d = SqlStmt SqlDropDomain d $
"DROP DOMAIN " ++ toSql d
stmtDropDomainConstraint :: (SqlName, SqlName, SqlName) -> SqlStatement
stmtDropDomainConstraint (schema, domain, constraint) = SqlStmt SqlDropDomainConstraint
(schema <.> domain) $
"ALTER DOMAIN " ++ toSql (schema <.> domain) ++
" DROP CONSTRAINT " ++ toSql constraint
-- TYPE
stmtDropType :: SqlName -> SqlStatement
stmtDropType t = SqlStmt SqlDropType t $
"DROP TYPE " ++ toSql t
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment