packages feed

postgresql-schema 0.1.0 → 0.1.1

raw patch · 3 files changed

+98/−20 lines, 3 filesdep +old-localedep +timenew-component:exe:schema-addPVP ok

version bump matches the API change (PVP)

Dependencies added: old-locale, time

API changes (from Hackage documentation)

+ Database.PostgreSQL.Schema: add :: FilePath -> FilePath -> FilePath -> Sh ()

Files

+ main/Add.hs view
@@ -0,0 +1,47 @@+import BasePrelude+import Data.Text                  ( pack )+import Data.Time.Clock            ( getCurrentTime )+import Data.Time.Format           ( formatTime )+import Database.PostgreSQL.Schema ( add )+import Options.Applicative+import Shelly+import System.Locale              ( defaultTimeLocale )++data Args = Args+  { aFile :: String+  , aDir  :: 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+      <$> strOption+          (  long    "file"+          <> metavar "FILE"+          <> help    "Migration File" )+      <*> optional ( strOption+          (  long    "dir"+          <> metavar "DIR"+          <> help    "Migrations Directory" ) )++newMigration :: IO String+newMigration = do+  now <- getCurrentTime+  return $ formatTime defaultTimeLocale "%Y%m%d-%H%M%S.sql" now++exec :: String -> String -> IO ()+exec file dir = do+  migration <- newMigration+  shelly $+    add (fromText (pack migration)) (fromText (pack file)) (fromText (pack dir))++main :: IO ()+main =+  execParser args >>= call where+    call Args{..} =+      exec aFile (fromMaybe "migrations" aDir)+
postgresql-schema.cabal view
@@ -1,5 +1,5 @@ name:                  postgresql-schema-version:               0.1.0+version:               0.1.1 synopsis:              PostgreSQL Schema Management description:           Please see README.md homepage:              https://github.com/mfine/postgresql-schema@@ -27,6 +27,23 @@   default-extensions:  NoImplicitPrelude                        OverloadedStrings +executable schema-add+  hs-source-dirs:      main+  main-is:             Add.hs+  ghc-options:         -Wall+  default-language:    Haskell2010+  build-depends:       base >= 4.7 && < 5+                     , base-prelude+                     , time+                     , old-locale+                     , optparse-applicative+                     , postgresql-schema+                     , shelly+                     , text+  default-extensions:  NoImplicitPrelude+                       OverloadedStrings+                       RecordWildCards+ executable schema-apply   hs-source-dirs:      main   main-is:             Apply.hs@@ -34,7 +51,6 @@   default-language:    Haskell2010   build-depends:       base >= 4.7 && < 5                      , base-prelude-                     , formatting                      , optparse-applicative                      , postgresql-schema                      , shelly
src/Database/PostgreSQL/Schema.hs view
@@ -1,5 +1,6 @@ module Database.PostgreSQL.Schema-  ( bootstrap+  ( add+  , bootstrap   , converge   ) where @@ -60,12 +61,12 @@ checkSchema :: Text -> Text -> Sh Bool checkSchema schema url = do   r <- psqlCommand (countSchema schema) url-  return $ strip r /= "0"+  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"+  return $ strip r == "0"  getMigrations :: [FilePath] -> Text -> Text -> Text -> Sh [FilePath] getMigrations migrations table schema url = do@@ -77,31 +78,45 @@   migrations <- findWhen test_f dir   forM migrations $ relativeTo dir -migrate :: [FilePath] -> Text -> Text -> Text -> Sh ()-migrate migrations table schema url =+migrate :: FilePath -> FilePath -> Text -> Text -> Text -> Sh ()+migrate migration dir table schema url = 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++migrateWithCheck :: [FilePath] -> Text -> Text -> Text -> Sh ()+migrateWithCheck 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+      when check $+        migrate migration dir table schema url +migrateWithoutCheck :: [FilePath] -> Text -> Text -> Text -> Sh ()+migrateWithoutCheck migrations table schema url =+  withTmpDir $ \dir ->+    forM_ migrations $ \migration ->+      migrate migration dir table schema url+ bootstrap :: FilePath -> Text -> Text -> Text -> Sh ()-bootstrap dir table schema url =+bootstrap dir table schema url = do+  migrations <- findMigrations dir   chdir dir $ do-    migrations <- findMigrations dir     check <- checkSchema schema url     when check $-      migrate migrations table schema url+      migrateWithoutCheck migrations table schema url     migrations' <- getMigrations migrations table schema url-    migrate migrations' table schema url+    migrateWithCheck migrations' table schema url  converge :: FilePath -> Text -> Text -> Text -> Sh ()-converge dir table schema url =+converge dir table schema url = do+  migrations <- findMigrations dir   chdir dir $ do-    migrations <- findMigrations dir     migrations' <- getMigrations migrations table schema url-    migrate migrations' table schema url+    migrateWithCheck migrations' table schema url++add :: FilePath -> FilePath -> FilePath -> Sh ()+add migration file dir =+  mv file (dir </> migration)