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