postgresql-schema 0.1.1 → 0.1.3
raw patch · 4 files changed
+108/−56 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- main/Add.hs +26/−10
- main/Apply.hs +10/−0
- postgresql-schema.cabal +1/−1
- src/Database/PostgreSQL/Schema.hs +71/−45
main/Add.hs view
@@ -1,3 +1,13 @@+-- |+-- Module: Add+-- Copyright: (c) 2015 Mark Fine+-- License: MIT+-- Maintainer: Mark Fine <mark.fine@gmail.com>+-- Stability: experimental+-- Portability: portable+--+-- Tool for adding PostgreSQL migrations.+ import BasePrelude import Data.Text ( pack ) import Data.Time.Clock ( getCurrentTime )@@ -9,6 +19,7 @@ data Args = Args { aFile :: String+ , aName :: Maybe String , aDir :: Maybe String } deriving ( Eq, Read, Show ) @@ -24,24 +35,29 @@ <> metavar "FILE" <> help "Migration File" ) <*> optional ( strOption+ ( long "name"+ <> metavar "NAME"+ <> help "Migration Name" ) )+ <*> 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+exec :: String -> String -> String -> IO ()+exec migration file dir = shelly $ add (fromText (pack migration)) (fromText (pack file)) (fromText (pack dir)) +newMigration :: Maybe String -> IO String+newMigration name = do+ now <- getCurrentTime+ return $ intercalate "-" ( timestamp now : maybeToList name ) ++ ".sql" where+ timestamp = formatTime defaultTimeLocale "%Y%m%d-%H%M%S"+ main :: IO () main = execParser args >>= call where- call Args{..} =- exec aFile (fromMaybe "migrations" aDir)+ call Args{..} = do+ migration <- newMigration aName+ exec migration aFile (fromMaybe "migrations" aDir)
main/Apply.hs view
@@ -1,3 +1,13 @@+-- |+-- Module: Apply+-- Copyright: (c) 2015 Mark Fine+-- License: MIT+-- Maintainer: Mark Fine <mark.fine@gmail.com>+-- Stability: experimental+-- Portability: portable+--+-- Tool for applying PostgreSQL migrations.+ import BasePrelude hiding ( FilePath ) import Data.Text ( Text, pack ) import Database.PostgreSQL.Schema ( bootstrap, converge )
postgresql-schema.cabal view
@@ -1,5 +1,5 @@ name: postgresql-schema-version: 0.1.1+version: 0.1.3 synopsis: PostgreSQL Schema Management description: Please see README.md homepage: https://github.com/mfine/postgresql-schema
src/Database/PostgreSQL/Schema.hs view
@@ -1,5 +1,18 @@+-- |+-- Module: Database.PostgreSQL.Schema+-- Copyright: (c) 2015 Mark Fine+-- License: MIT+-- Maintainer: Mark Fine <mark.fine@gmail.com>+-- Stability: experimental+-- Portability: portable+--+-- Functions for working with PostgreSQL migrations.+ module Database.PostgreSQL.Schema- ( add+ (+ -- * Adding Migrations+ add+ -- * Applying Migrations , bootstrap , converge ) where@@ -9,6 +22,9 @@ import Formatting ( (%), sformat, stext ) import Shelly ++-- psql+ psqlCommand :: Text -> Text -> Sh Text psqlCommand c url = run "psql" [ "--no-align"@@ -26,20 +42,15 @@ , toTextIgnore f , url ] ++-- SQL+ countSchema :: Text -> Text-countSchema schema =+countSchema = 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) " %@@ -58,65 +69,80 @@ intercalate ", " $ flip map migrations $ \migration -> sformat ("'" % stext % "'") (toTextIgnore migration) ++-- psql + SQL+ 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+filterMigrations :: [FilePath] -> Text -> Text -> Text -> Sh [FilePath]+filterMigrations migrations table schema url = do r <- psqlCommand (selectMigrations migrations table schema) url return $ migrations \\ map fromText (lines r) ++-- migrations+ findMigrations :: FilePath -> Sh [FilePath] findMigrations dir = do migrations <- findWhen test_f dir forM migrations $ relativeTo dir -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 =+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 $- migrate migration dir table schema url+ echo $ out migration+ 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 where+ out migration =+ sformat ( "M " % stext % " -> " % stext )+ (toTextIgnore migration) table -migrateWithoutCheck :: [FilePath] -> Text -> Text -> Text -> Sh ()-migrateWithoutCheck migrations table schema url =- withTmpDir $ \dir ->- forM_ migrations $ \migration ->- migrate migration dir table schema url +-- API++-- | Add a DDL migration file to a migrations directory. Fails if+-- migration file or migrations directory do not exist.+add :: FilePath -> FilePath -> FilePath -> Sh ()+add migration file dir = do+ echo out+ mv file (dir </> migration) where+ out =+ sformat ( "A " % stext % " -> " % stext )+ (toTextIgnore file)+ (toTextIgnore (dir </> migration))++-- | Apply bootstrap migrations to a database. Checks if a database+-- has been previously bootstrapped, and applies all bootstrap+-- migrations if it has not been previously bootstrapped. Applies+-- all bootstrap migrations that have not been applied yet and records+-- their application. bootstrap :: FilePath -> Text -> Text -> Text -> Sh () bootstrap dir table schema url = do migrations <- findMigrations dir chdir dir $ do check <- checkSchema schema url- when check $- migrateWithoutCheck migrations table schema url- migrations' <- getMigrations migrations table schema url- migrateWithCheck migrations' table schema url+ when check $ do+ echo "Bootstrapping..."+ migrate migrations table schema url+ migrations' <- filterMigrations migrations table schema url+ unless (null migrations') $ do+ echo "Bootstrap migrating..."+ migrate migrations' table schema url +-- | Apply migrations to a database. Applies all migrations that have+-- not been applied yet and records their application. converge :: FilePath -> Text -> Text -> Text -> Sh () converge dir table schema url = do migrations <- findMigrations dir chdir dir $ do- migrations' <- getMigrations migrations table schema url- migrateWithCheck migrations' table schema url--add :: FilePath -> FilePath -> FilePath -> Sh ()-add migration file dir =- mv file (dir </> migration)+ migrations' <- filterMigrations migrations table schema url+ unless (null migrations') $ do+ echo "Migrating..."+ migrate migrations' table schema url