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 +47/−0
- postgresql-schema.cabal +18/−2
- src/Database/PostgreSQL/Schema.hs +33/−18
+ 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)