module Morph.Options ( Options(..) , getOptions , withConnection ) where import Control.Exception (bracket) import System.Environment (getEnv) import Data.Monoid import qualified Data.ByteString.Char8 as BS import Database.PostgreSQL.Simple import Options.Applicative data Options = Options { Options -> Maybe ByteString optsConnectionString :: Maybe BS.ByteString , Options -> FilePath optsMigrationsDirectory :: FilePath , Options -> Bool optsTransaction :: Bool } optionsParser :: Parser Options optionsParser :: Parser Options optionsParser = Maybe ByteString -> FilePath -> Bool -> Options Options (Maybe ByteString -> FilePath -> Bool -> Options) -> Parser (Maybe ByteString) -> Parser (FilePath -> Bool -> Options) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ReadM (Maybe ByteString) -> Mod OptionFields (Maybe ByteString) -> Parser (Maybe ByteString) forall a. ReadM a -> Mod OptionFields a -> Parser a option (ByteString -> Maybe ByteString forall a. a -> Maybe a Just (ByteString -> Maybe ByteString) -> ReadM ByteString -> ReadM (Maybe ByteString) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> ReadM ByteString forall s. IsString s => ReadM s str) (Char -> Mod OptionFields (Maybe ByteString) forall (f :: * -> *) a. HasName f => Char -> Mod f a short Char 'c' Mod OptionFields (Maybe ByteString) -> Mod OptionFields (Maybe ByteString) -> Mod OptionFields (Maybe ByteString) forall a. Semigroup a => a -> a -> a <> FilePath -> Mod OptionFields (Maybe ByteString) forall (f :: * -> *) a. HasName f => FilePath -> Mod f a long FilePath "connection" Mod OptionFields (Maybe ByteString) -> Mod OptionFields (Maybe ByteString) -> Mod OptionFields (Maybe ByteString) forall a. Semigroup a => a -> a -> a <> FilePath -> Mod OptionFields (Maybe ByteString) forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a metavar FilePath "DATABASE_CONNECTION_STRING" Mod OptionFields (Maybe ByteString) -> Mod OptionFields (Maybe ByteString) -> Mod OptionFields (Maybe ByteString) forall a. Semigroup a => a -> a -> a <> FilePath -> Mod OptionFields (Maybe ByteString) forall (f :: * -> *) a. FilePath -> Mod f a help FilePath "Libpq connection string. Read from environment variable otherwise." Mod OptionFields (Maybe ByteString) -> Mod OptionFields (Maybe ByteString) -> Mod OptionFields (Maybe ByteString) forall a. Semigroup a => a -> a -> a <> Maybe ByteString -> Mod OptionFields (Maybe ByteString) forall (f :: * -> *) a. HasValue f => a -> Mod f a value Maybe ByteString forall a. Maybe a Nothing) Parser (FilePath -> Bool -> Options) -> Parser FilePath -> Parser (Bool -> Options) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Mod OptionFields FilePath -> Parser FilePath forall s. IsString s => Mod OptionFields s -> Parser s strOption (Char -> Mod OptionFields FilePath forall (f :: * -> *) a. HasName f => Char -> Mod f a short Char 'd' Mod OptionFields FilePath -> Mod OptionFields FilePath -> Mod OptionFields FilePath forall a. Semigroup a => a -> a -> a <> FilePath -> Mod OptionFields FilePath forall (f :: * -> *) a. HasName f => FilePath -> Mod f a long FilePath "dir" Mod OptionFields FilePath -> Mod OptionFields FilePath -> Mod OptionFields FilePath forall a. Semigroup a => a -> a -> a <> FilePath -> Mod OptionFields FilePath forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a metavar FilePath "PATH" Mod OptionFields FilePath -> Mod OptionFields FilePath -> Mod OptionFields FilePath forall a. Semigroup a => a -> a -> a <> Mod OptionFields FilePath forall a (f :: * -> *). Show a => Mod f a showDefault Mod OptionFields FilePath -> Mod OptionFields FilePath -> Mod OptionFields FilePath forall a. Semigroup a => a -> a -> a <> FilePath -> Mod OptionFields FilePath forall (f :: * -> *) a. HasValue f => a -> Mod f a value FilePath "migrations" Mod OptionFields FilePath -> Mod OptionFields FilePath -> Mod OptionFields FilePath forall a. Semigroup a => a -> a -> a <> FilePath -> Mod OptionFields FilePath forall (f :: * -> *) a. FilePath -> Mod f a help FilePath "Path to the directory containing migrations.") Parser (Bool -> Options) -> Parser Bool -> Parser Options forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Bool -> Bool -> Mod FlagFields Bool -> Parser Bool forall a. a -> a -> Mod FlagFields a -> Parser a flag Bool True Bool False (FilePath -> Mod FlagFields Bool forall (f :: * -> *) a. HasName f => FilePath -> Mod f a long FilePath "no-transaction" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool forall a. Semigroup a => a -> a -> a <> FilePath -> Mod FlagFields Bool forall (f :: * -> *) a. FilePath -> Mod f a help FilePath "Do not run migrations in a SQL transaction.") getOptions :: IO Options getOptions :: IO Options getOptions = ParserInfo Options -> IO Options forall a. ParserInfo a -> IO a execParser (ParserInfo Options -> IO Options) -> ParserInfo Options -> IO Options forall a b. (a -> b) -> a -> b $ Parser Options -> InfoMod Options -> ParserInfo Options forall a. Parser a -> InfoMod a -> ParserInfo a info (Parser (Options -> Options) forall a. Parser (a -> a) helper Parser (Options -> Options) -> Parser Options -> Parser Options forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Parser Options optionsParser) (InfoMod Options -> ParserInfo Options) -> InfoMod Options -> ParserInfo Options forall a b. (a -> b) -> a -> b $ InfoMod Options forall a. InfoMod a fullDesc InfoMod Options -> InfoMod Options -> InfoMod Options forall a. Semigroup a => a -> a -> a <> FilePath -> InfoMod Options forall a. FilePath -> InfoMod a progDesc FilePath "Migrator for PostgreSQL databases with support for rollbacks" InfoMod Options -> InfoMod Options -> InfoMod Options forall a. Semigroup a => a -> a -> a <> FilePath -> InfoMod Options forall a. FilePath -> InfoMod a footer FilePath "This program is licensed under the BSD-3 license." createConn :: Options -> IO Connection createConn :: Options -> IO Connection createConn Options opts = do ByteString connString <- case Options -> Maybe ByteString optsConnectionString Options opts of Maybe ByteString Nothing -> FilePath -> ByteString BS.pack (FilePath -> ByteString) -> IO FilePath -> IO ByteString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> FilePath -> IO FilePath getEnv FilePath "DATABASE_CONNECTION_STRING" Just ByteString cs -> ByteString -> IO ByteString forall (f :: * -> *) a. Applicative f => a -> f a pure ByteString cs ByteString -> IO Connection connectPostgreSQL ByteString connString destroyConn :: Connection -> IO () destroyConn :: Connection -> IO () destroyConn = Connection -> IO () close withConnection :: Options -> (Connection -> IO a) -> IO a withConnection :: Options -> (Connection -> IO a) -> IO a withConnection Options options Connection -> IO a f = IO Connection -> (Connection -> IO ()) -> (Connection -> IO a) -> IO a forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c bracket (Options -> IO Connection createConn Options options) Connection -> IO () destroyConn Connection -> IO a f