postgresql-schema (empty) → 0.1.0

raw patch · 7 files changed

+424/−0 lines, 7 filesdep +basedep +base-preludedep +formattingsetup-changed

Dependencies added: base, base-prelude, formatting, optparse-applicative, postgresql-schema, shelly, text

Files

• LICENSE +20/−0
• Setup.hs +2/−0
• main/Apply.hs +48/−0
• migrations/20130318-105434.sql +64/−0
• migrations/20130318-105456.sql +135/−0
• postgresql-schema.cabal +48/−0
• src/Database/PostgreSQL/Schema.hs +107/−0

@@ -0,0 +1,20 @@+Copyright (c) 2015 Mark Fine++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,48 @@+import BasePrelude         hiding ( FilePath )+import Data.Text                  ( Text, pack )+import Database.PostgreSQL.Schema ( bootstrap, converge )+import Options.Applicative+import Paths_postgresql_schema    ( getDataFileName )+import Shelly++data Args = Args+  { aDir :: Maybe String+  , aUrl :: Maybe String+  } deriving ( Eq, Read, Show )++args :: ParserInfo Args+args =+  info ( helper <*> args' )+    (  fullDesc+    <> header   "schema-apply: Apply Schema to PostgreSQL Database"+    <> progDesc "Apply Schema" ) where+    args' = Args+      <$> optional ( strOption+          (  long    "dir"+          <> metavar "DIR"+          <> help    "Migrations Directory" ) )+      <*> optional ( strOption+          (  long    "url"+          <> metavar "URL"+          <> help    "Database URL" ) )++apply :: FilePath -> FilePath -> Text -> Sh ()+apply bootstrapDir dir url = do+  bootstrap bootstrapDir bootstrapTable schema url+  converge dir table schema url where+    bootstrapTable = "bootstrap_scripts"+    table = "scripts"+    schema = "schema_evolution_manager"++exec :: String -> String -> String -> IO ()+exec bootstrapDir dir url =+  shelly $+    apply (fromText (pack bootstrapDir)) (fromText (pack dir)) (pack url)++main :: IO ()+main =+  execParser args >>= call where+    call Args{..} = do+      url <- lookupEnv "DATABASE_URL"+      bootstrapDir <- getDataFileName "migrations"+      maybe (return ()) (exec bootstrapDir (fromMaybe "migrations" aDir)) (aUrl <|> url)

@@ -0,0 +1,64 @@+-- This script initializes the schema_evolution_manager schema and the scripts and+-- the bootstrap_scripts tables++create schema schema_evolution_manager;++SET search_path TO schema_evolution_manager;++create or replace function table_exists(p_schema_name character varying, p_table_name character varying) returns boolean+    language plpgsql+    as $$+begin+  perform 1 from information_schema.tables where table_schema = p_schema_name and table_name=p_table_name and table_type='BASE TABLE';+  return found;+end;+$$;++create or replace function create_tables() returns void+    language plpgsql+    as $$+begin+  if not table_exists('schema_evolution_manager', 'scripts') then++    create table schema_evolution_manager.scripts (+      id           bigserial,+      filename     varchar(100) not null,+      created_at   timestamp with time zone default now() not null+    );++    alter table schema_evolution_manager.scripts add constraint scripts_id_pk primary key(id);+    alter table schema_evolution_manager.scripts add constraint scripts_filename_un unique(filename);++    comment on table schema_evolution_manager.scripts is '+      When a script is applied to this database, the script is recorded+      here. This table is the used to ensure scripts are applied at most+      once to this database.+    ';++  end if;++  if not table_exists('schema_evolution_manager', 'bootstrap_scripts') then++    create table schema_evolution_manager.bootstrap_scripts (+      id           bigserial,+      filename     varchar(100) not null,+      created_at   timestamp with time zone default now() not null+    );++    alter table schema_evolution_manager.bootstrap_scripts add constraint bootstrap_scripts_id_pk primary key(id);+    alter table schema_evolution_manager.bootstrap_scripts add constraint bootstrap_scripts_filename_un unique(filename);++    comment on table schema_evolution_manager.bootstrap_scripts is '+      Internal list of schema_evolution_manager sql scripts applied. Used only for upgrades+      to schema_evolution_manager itself.+    ';++  end if;++end;+$$;++select create_tables();++drop function create_tables();+drop function table_exists(character varying, character varying);

@@ -0,0 +1,135 @@+-- library of common utility functions+set search_path to schema_evolution_manager;++CREATE OR REPLACE FUNCTION create_basic_audit_data(p_schema_name character varying, p_table_name character varying) RETURNS void+    LANGUAGE plpgsql+    AS $$+begin+  perform schema_evolution_manager.create_basic_created_audit_data(p_schema_name, p_table_name);+  perform schema_evolution_manager.create_basic_updated_audit_data(p_schema_name, p_table_name);+  perform schema_evolution_manager.create_basic_deleted_audit_data(p_schema_name, p_table_name);+end;+$$;++CREATE OR REPLACE FUNCTION create_basic_created_audit_data(p_schema_name character varying, p_table_name character varying) RETURNS void+    LANGUAGE plpgsql+    AS $$+begin+  execute 'alter table ' || p_schema_name || '.' || p_table_name || ' add created_by_guid uuid not null';+  execute 'alter table ' || p_schema_name || '.' || p_table_name || ' add created_at timestamp with time zone default now() not null';+end;+$$;++CREATE OR REPLACE FUNCTION create_basic_deleted_audit_data(p_schema_name character varying, p_table_name character varying) RETURNS void+    LANGUAGE plpgsql+    AS $$+begin+  execute 'alter table ' || p_schema_name || '.' || p_table_name || ' add deleted_by_guid uuid';+  execute 'alter table ' || p_schema_name || '.' || p_table_name || ' add deleted_at timestamp with time zone';+  execute 'alter table ' || p_schema_name || '.' || p_table_name || ' add constraint ' || p_table_name || '_deleted_ck ' ||+          'check ( (deleted_at is null and deleted_by_guid is null) OR (deleted_at is not null and deleted_by_guid is not null) )';+  perform schema_evolution_manager.create_prevent_immediate_delete_trigger(p_schema_name, p_table_name);+end;+$$;++CREATE OR REPLACE FUNCTION create_basic_updated_audit_data(p_schema_name character varying, p_table_name character varying) RETURNS void+    LANGUAGE plpgsql+    AS $$+begin+  execute 'alter table ' || p_schema_name || '.' || p_table_name || ' add updated_by_guid uuid not null';+  execute 'alter table ' || p_schema_name || '.' || p_table_name || ' add updated_at timestamp with time zone default now() not null';+  perform schema_evolution_manager.create_updated_at_trigger(p_schema_name, p_table_name);+end;+$$;++CREATE OR REPLACE FUNCTION prevent_delete() RETURNS trigger+    LANGUAGE plpgsql+    AS $$+begin+  raise exception 'Physical deletes are not allowed on this table';+end;+$$;++CREATE OR REPLACE FUNCTION prevent_immediate_delete() RETURNS trigger+    LANGUAGE plpgsql+    AS $$+begin+  if old.deleted_at is null then+    raise exception 'You must set the deleted_at column for this table';+  end if;++  if old.deleted_at > now() - interval '1 months' then+    raise exception 'Physical deletes on this table can occur only after 1 month of deleting the records';+  end if;++  return old;+end;+$$;++CREATE OR REPLACE FUNCTION create_updated_at_trigger(p_schema_name character varying, p_table_name character varying) RETURNS character varying+    LANGUAGE plpgsql+    AS $$+declare+  v_name varchar;+begin+  v_name = p_table_name || '_updated_at_trigger';+  execute 'drop trigger if exists ' || v_name || ' on ' || p_schema_name || '.' || p_table_name;+  execute 'create trigger ' || v_name || ' before update on ' || p_schema_name || '.' || p_table_name || ' for each row execute procedure schema_evolution_manager.set_updated_at_trigger_function()';+  return v_name;+end;+$$;++CREATE OR REPLACE FUNCTION set_updated_at_trigger_function() RETURNS trigger+    LANGUAGE plpgsql+    AS $$+begin+  if (new.updated_at = old.updated_at) then+    new.updated_at = timezone('utc', now())::timestamptz;+  end if;+  return new;+end;+$$;++CREATE OR REPLACE FUNCTION create_prevent_immediate_delete_trigger(p_schema_name character varying, p_table_name character varying) RETURNS character varying+    LANGUAGE plpgsql+    AS $$+declare+  v_name varchar;+begin+  v_name = p_table_name || '_prevent_immediate_delete_trigger';+  execute 'create trigger ' || v_name || ' before delete on ' || p_schema_name || '.' || p_table_name || ' for each row execute procedure schema_evolution_manager.prevent_immediate_delete()';+  return v_name;+end;+$$;++CREATE OR REPLACE FUNCTION create_prevent_update_trigger(p_schema_name character varying, p_table_name character varying) RETURNS character varying+    LANGUAGE plpgsql+    AS $$+declare+  v_name varchar;+begin+  v_name = p_table_name || '_prevent_update_trigger';+  execute 'create trigger ' || v_name || ' after update on ' || p_schema_name || '.' || p_table_name || ' for each row execute procedure schema_evolution_manager.prevent_update()';+  return v_name;+end;+$$;++CREATE OR REPLACE FUNCTION create_prevent_delete_trigger(p_schema_name character varying, p_table_name character varying) RETURNS character varying+    LANGUAGE plpgsql+    AS $$+declare+  v_name varchar;+begin+  v_name = p_table_name || '_prevent_delete_trigger';+  execute 'create trigger ' || v_name || ' after delete on ' || p_schema_name || '.' || p_table_name || ' for each row execute procedure schema_evolution_manager.prevent_delete()';+  return v_name;+end;+$$;++CREATE OR REPLACE FUNCTION prevent_update() RETURNS trigger+    LANGUAGE plpgsql+    AS $$+begin+  raise exception 'Physical updates are not allowed on this table';+end;+$$;

@@ -0,0 +1,48 @@+name:                  postgresql-schema+version:               0.1.0+synopsis:              PostgreSQL Schema Management+description:           Please see README.md+homepage:              https://github.com/mfine/postgresql-schema+license:               BSD3+license-file:          LICENSE+author:                Mark Fine+maintainer:            mark.fine@gmail.com+copyright:             Copyright (C) 2015 Mark Fine+category:              Database+build-type:            Simple+cabal-version:         >= 1.10+data-files:            migrations/20130318-105434.sql+                     , migrations/20130318-105456.sql++library+  exposed-modules:     Database.PostgreSQL.Schema+  default-language:    Haskell2010+  hs-source-dirs:      src+  ghc-options:         -Wall -fno-warn-orphans+  build-depends:       base >= 4.7 && < 5+                     , base-prelude+                     , formatting+                     , shelly+                     , text+  default-extensions:  NoImplicitPrelude+                       OverloadedStrings++executable schema-apply+  hs-source-dirs:      main+  main-is:             Apply.hs+  ghc-options:         -Wall+  default-language:    Haskell2010+  build-depends:       base >= 4.7 && < 5+                     , base-prelude+                     , formatting+                     , optparse-applicative+                     , postgresql-schema+                     , shelly+                     , text+  default-extensions:  NoImplicitPrelude+                       OverloadedStrings+                       RecordWildCards++source-repository head+  type:     git+  location: https://github.com/mfine/postgresql-schema

@@ -0,0 +1,107 @@+module Database.PostgreSQL.Schema+  ( bootstrap+  , converge+  ) where++import BasePrelude hiding ( FilePath, (%), intercalate, lines )+import Data.Text          ( Text, intercalate, lines, strip )+import Formatting         ( (%), sformat, stext )+import Shelly++psqlCommand :: Text -> Text -> Sh Text+psqlCommand c url =+  run "psql" [ "--no-align"+             , "--tuples-only"+             , "--command"+             , c+             , url ]++psqlFile :: FilePath -> Text -> Sh ()+psqlFile f url =+  run_ "psql" [ "--no-align"+              , "--tuples-only"+              , "--quiet"+              , "--file"+              , toTextIgnore f+              , url ]++countSchema :: Text -> Text+countSchema schema =+  sformat ( " SELECT count(*) " %+            " FROM pg_namespace " %+            " WHERE nspname = '" % stext % "' " )+    schema++countMigration :: FilePath -> Text -> Text -> Text+countMigration migration table schema =+  sformat ( " SELECT count(*) " %+            " FROM " % stext % "." % stext %+            " WHERE filename = '" % stext % "' " )+    schema table (toTextIgnore migration)++insertMigration :: FilePath -> Text -> Text -> Text+insertMigration migration table schema =+  sformat ( " INSERT INTO " % stext % "." % stext % " (filename) " %+            " SELECT '" % stext % "' " %+            " WHERE NOT EXISTS " %+            " ( SELECT TRUE FROM " % stext % "." % stext %+            "   WHERE filename = '" % stext % "') " )+    schema table (toTextIgnore migration) schema table (toTextIgnore migration)++selectMigrations :: [FilePath] -> Text -> Text -> Text+selectMigrations migrations table schema =+  sformat ( " SELECT filename " %+            " FROM " % stext % "." % stext %+            " WHERE filename IN ( " % stext % " ) " )+    schema table $+      intercalate ", " $ flip map migrations $ \migration ->+        sformat ("'" % stext % "'") (toTextIgnore migration)++checkSchema :: Text -> Text -> Sh Bool+checkSchema schema url = do+  r <- psqlCommand (countSchema schema) url+  return $ strip r /= "0"++checkMigration :: FilePath -> Text -> Text -> Text -> Sh Bool+checkMigration migration table schema url = do+  r <- psqlCommand (countMigration migration table schema) url+  return $ strip r /= "0"++getMigrations :: [FilePath] -> Text -> Text -> Text -> Sh [FilePath]+getMigrations migrations table schema url = do+  r <- psqlCommand (selectMigrations migrations table schema) url+  return $ migrations \\ map fromText (lines r)++findMigrations :: FilePath -> Sh [FilePath]+findMigrations dir = do+  migrations <- findWhen test_f dir+  forM migrations $ relativeTo dir++migrate :: [FilePath] -> Text -> Text -> Text -> Sh ()+migrate migrations table schema url =+  withTmpDir $ \dir ->+    forM_ migrations $ \migration -> do+      check <- checkMigration migration table schema url+      when check $ do+        contents <- readfile migration+        appendfile (dir </> migration) "\\set ON_ERROR_STOP true\n\n"+        appendfile (dir </> migration) contents+        appendfile (dir </> migration) $ insertMigration migration table schema+        psqlFile (dir </> migration) url++bootstrap :: FilePath -> Text -> Text -> Text -> Sh ()+bootstrap dir table schema url =+  chdir dir $ do+    migrations <- findMigrations dir+    check <- checkSchema schema url+    when check $+      migrate migrations table schema url+    migrations' <- getMigrations migrations table schema url+    migrate migrations' table schema url++converge :: FilePath -> Text -> Text -> Text -> Sh ()+converge dir table schema url =+  chdir dir $ do+    migrations <- findMigrations dir+    migrations' <- getMigrations migrations table schema url+    migrate migrations' table schema url