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