postgresql-schema 0.1.8 → 0.1.9
raw patch · 3 files changed
+101/−1 lines, 3 filesnew-component:exe:schema-clear
Files
- main/Clear.hs +54/−0
- postgresql-schema.cabal +16/−1
- src/Database/PostgreSQL/Schema.hs +31/−0
+ main/Clear.hs view
@@ -0,0 +1,54 @@+-- |+-- Module: Clear+-- Copyright: (c) 2015 Mark Fine+-- License: MIT+-- Maintainer: Mark Fine <mark.fine@gmail.com>+-- Stability: experimental+-- Portability: portable+--+-- Tool for clearing PostgreSQL migrations.++import BasicPrelude+import Data.Text ( pack )+import Database.PostgreSQL.Schema+import Options.Applicative+import Shelly+import System.Environment+import System.IO hiding ( putStr, getLine )++data Args = Args+ { 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 "url"+ <> metavar "URL"+ <> help "Database URL" ) )++prompt :: String -> IO Bool+prompt url = do+ putStr $ "Really drop " <> pack url <> "? [y]: "+ hFlush stdout+ (== "y") <$> getLine++exec :: String -> IO ()+exec url = do+ y <- prompt url+ when y $ shelly $+ clear schema (pack url) where+ schema = "schema_evolution_manager"++main :: IO ()+main =+ execParser args >>= call where+ call Args{..} = do+ url <- lookupEnv "DATABASE_URL"+ maybe (err "No Database URL") exec (aUrl <|> url) where+ err = hPutStrLn stderr
postgresql-schema.cabal view
@@ -1,5 +1,5 @@ name: postgresql-schema-version: 0.1.8+version: 0.1.9 synopsis: PostgreSQL Schema Management description: Please see README.md homepage: https://github.com/mfine/postgresql-schema@@ -48,6 +48,21 @@ hs-source-dirs: main main-is: Apply.hs other-modules: Paths_postgresql_schema+ ghc-options: -Wall+ default-language: Haskell2010+ build-depends: base >= 4.7 && < 5+ , basic-prelude+ , optparse-applicative+ , postgresql-schema+ , shelly+ , text+ default-extensions: NoImplicitPrelude+ OverloadedStrings+ RecordWildCards++executable schema-clear+ hs-source-dirs: main+ main-is: Clear.hs ghc-options: -Wall default-language: Haskell2010 build-depends: base >= 4.7 && < 5
src/Database/PostgreSQL/Schema.hs view
@@ -15,6 +15,8 @@ -- * Applying Migrations , bootstrap , converge+ -- * Clearing Migrations+ , clear ) where import BasicPrelude hiding ( FilePath, (</>) )@@ -48,6 +50,14 @@ \ ( SELECT TRUE FROM " <> schema <> "." <> table <> " WHERE filename = '" <> toTextIgnore migration <> "' ) " +dropSchemaSQL :: Text -> Text+dropSchemaSQL schema =+ " DROP SCHEMA IF EXISTS " <> schema <> " CASCADE "++createSchemaSQL :: Text -> Text+createSchemaSQL schema =+ " CREATE SCHEMA IF NOT EXISTS " <> schema <> " "+ -- psql psql :: FilePath -> Text -> Sh ()@@ -66,6 +76,11 @@ bracket (connectPostgreSQL (encodeUtf8 url)) close $ \c -> query c (fromString $ unpack q) p +execute_' :: Text -> Text -> IO ()+execute_' q url =+ bracket (connectPostgreSQL (encodeUtf8 url)) close $ \c ->+ void $ execute_ c (fromString $ unpack q)+ countSchema :: Text -> Text -> IO [Only Int] countSchema schema = query' countSchemaSQL $ Only schema@@ -74,6 +89,14 @@ selectMigrations migrations table schema = query' (selectMigrationsSQL table schema) $ Only $ In $ map toTextIgnore migrations +dropSchema :: Text -> Text -> IO ()+dropSchema schema =+ execute_' (dropSchemaSQL schema)++createSchema :: Text -> Text -> IO ()+createSchema schema =+ execute_' (createSchemaSQL schema)+ -- interpreted queries checkSchema :: Text -> Text -> IO Bool@@ -161,3 +184,11 @@ unless (null migrations') $ do echo "Migrating..." migrate migrations' table schema url++clear :: Text -> Text -> Sh ()+clear schema url = do+ echo "Dropping..."+ liftIO $ do+ dropSchema schema url+ dropSchema "public" url+ createSchema "public" url