{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
-- |Top level module of Refurb along which re-exports the library portion of Refurb ('Refurb.Types' and 'Refurb.MigrationUtils')
module Refurb
  ( refurbMain
  , module Refurb.MigrationUtils
  , module Refurb.Types
  ) where

import ClassyPrelude
import Control.Monad.Base (liftBase)
import Control.Monad.Logger (LogLevel(LevelDebug), filterLogger, logDebug, runStdoutLoggingT)
import qualified Database.PostgreSQL.Simple as PG
import qualified Options.Applicative as OA
import Refurb.Cli (Command(CommandMigrate, CommandShowLog, CommandShowMigration, CommandBackup), Opts(Opts, debug, command, configFile), optsParser)
import Refurb.MigrationUtils
import Refurb.Run.Backup (backup)
import Refurb.Run.Internal (Context(Context))
import Refurb.Run.Info (showMigration, showLog)
import Refurb.Run.Migrate (migrate)
import Refurb.Store (isSchemaPresent, initializeSchema)
import Refurb.Types

-- |Main entry point for refurbishing.
--
-- In @refurb readDatabaseConnectionString migrations@, @readDatabaseConnectionString@ is a function taking the configuration file path from the command line
-- and yielding a pair of actual and loggable connection strings, and @migrations@ is a list of 'Migration' records to consider.
--
-- For example:
--
-- @
--   module Main where
--
--   import Refurb ('Migration', 'MonadMigration', 'execute_', 'schemaMigration', refurbMain)
--
--   migrations :: ['Migration']
--   migrations =
--     [ schemaMigration "create-my-table" createMyTable
--     ]
--
--   createMyTable :: MonadMigration m => m ()
--   createMyTable =
--     void $ execute_ "create table my_table (...)"
--
--   main :: IO ()
--   main = refurbMain readDatabaseConnInfo migrations
-- @
refurbMain :: (FilePath -> IO ConnInfo) -> [Migration] -> IO ()
refurbMain :: (FilePath -> IO ConnInfo) -> [Migration] -> IO ()
refurbMain FilePath -> IO ConnInfo
readConnInfo [Migration]
migrations = do
  opts :: Opts
opts@(Opts {Bool
FilePath
Command
command :: Command
configFile :: FilePath
debug :: Bool
configFile :: Opts -> FilePath
command :: Opts -> Command
debug :: Opts -> Bool
..}) <- ParserInfo Opts -> IO Opts
forall a. ParserInfo a -> IO a
OA.execParser ParserInfo Opts
optsParser

  ConnInfo
connInfo <- FilePath -> IO ConnInfo
readConnInfo FilePath
configFile

  let logFilter :: p -> LogLevel -> Bool
logFilter = if Bool
debug
                  then \ p
_ LogLevel
_   -> Bool
True
                  else \ p
_ LogLevel
lvl -> LogLevel
lvl LogLevel -> LogLevel -> Bool
forall a. Ord a => a -> a -> Bool
> LogLevel
LevelDebug

  LoggingT IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => LoggingT m a -> m a
runStdoutLoggingT (LoggingT IO () -> IO ())
-> (LoggingT IO () -> LoggingT IO ()) -> LoggingT IO () -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (LogSource -> LogLevel -> Bool) -> LoggingT IO () -> LoggingT IO ()
forall (m :: * -> *) a.
(LogSource -> LogLevel -> Bool) -> LoggingT m a -> LoggingT m a
filterLogger LogSource -> LogLevel -> Bool
forall p. p -> LogLevel -> Bool
logFilter (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Int
FilePath
LogLevel
FilePath -> LogSource
FilePath -> FilePath -> FilePath -> CharPos -> CharPos -> Loc
Loc -> LogSource -> LogLevel -> LogSource -> LoggingT IO ()
LogSource -> LogSource
(LogSource -> LoggingT IO ())
-> (LogSource -> LogSource) -> LogSource -> LoggingT IO ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> LogSource -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> LogSource -> LogLevel -> msg -> m ()
pack :: FilePath -> LogSource
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
$logDebug (LogSource -> LoggingT IO ()) -> LogSource -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ LogSource
"Connecting to " LogSource -> LogSource -> LogSource
forall a. Semigroup a => a -> a -> a
<> LogSource -> LogSource
forall a. Show a => a -> LogSource
tshow (ConnInfo -> LogSource
connInfoAsLogString ConnInfo
connInfo)
    LoggingT IO Connection
-> (Connection -> LoggingT IO ())
-> (Connection -> LoggingT IO ())
-> LoggingT IO ()
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (IO Connection -> LoggingT IO Connection
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO Connection -> LoggingT IO Connection)
-> (ByteString -> IO Connection)
-> ByteString
-> LoggingT IO Connection
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> IO Connection
PG.connectPostgreSQL (ByteString -> LoggingT IO Connection)
-> ByteString -> LoggingT IO Connection
forall a b. (a -> b) -> a -> b
$ ConnInfo -> ByteString
connInfoAsConnString ConnInfo
connInfo) (IO () -> LoggingT IO ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> LoggingT IO ())
-> (Connection -> IO ()) -> Connection -> LoggingT IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Connection -> IO ()
PG.close) ((Connection -> LoggingT IO ()) -> LoggingT IO ())
-> (Connection -> LoggingT IO ()) -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ \ Connection
conn -> do
      let context :: Context
context = Opts -> Connection -> ConnInfo -> [Migration] -> Context
Context Opts
opts Connection
conn ConnInfo
connInfo [Migration]
migrations

      LoggingT IO Bool -> LoggingT IO () -> LoggingT IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (Connection -> LoggingT IO Bool
forall (m :: * -> *).
(MonadBaseControl IO m, MonadMask m, MonadLogger m) =>
Connection -> m Bool
isSchemaPresent Connection
conn) (LoggingT IO () -> LoggingT IO ())
-> LoggingT IO () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> LoggingT IO ()
forall (m :: * -> *).
(MonadBaseControl IO m, MonadLogger m) =>
Connection -> m ()
initializeSchema Connection
conn

      LoggingT IO Int64 -> LoggingT IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LoggingT IO Int64 -> LoggingT IO ())
-> (IO Int64 -> LoggingT IO Int64) -> IO Int64 -> LoggingT IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO Int64 -> LoggingT IO Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> LoggingT IO ()) -> IO Int64 -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> Query -> IO Int64
PG.execute_ Connection
conn Query
"set search_path = 'public'"
      (ReaderT Context (LoggingT IO) () -> Context -> LoggingT IO ())
-> Context -> ReaderT Context (LoggingT IO) () -> LoggingT IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT Context (LoggingT IO) () -> Context -> LoggingT IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Context
context (ReaderT Context (LoggingT IO) () -> LoggingT IO ())
-> ReaderT Context (LoggingT IO) () -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$
        case Command
command of
          CommandMigrate GoNoGo
goNoGo Maybe PreMigrationBackup
backupMay InstallSeedData
installSeedData ->
            GoNoGo
-> Maybe PreMigrationBackup
-> InstallSeedData
-> ReaderT Context (LoggingT IO) ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadRefurb m) =>
GoNoGo -> Maybe PreMigrationBackup -> InstallSeedData -> m ()
migrate GoNoGo
goNoGo Maybe PreMigrationBackup
backupMay InstallSeedData
installSeedData
          Command
CommandShowLog ->
            ReaderT Context (LoggingT IO) ()
forall (m :: * -> *). MonadRefurb m => m ()
showLog
          CommandShowMigration FQualifiedKey
key ->
            FQualifiedKey -> ReaderT Context (LoggingT IO) ()
forall (m :: * -> *). MonadRefurb m => FQualifiedKey -> m ()
showMigration FQualifiedKey
key
          CommandBackup FilePath
path ->
            FilePath -> ReaderT Context (LoggingT IO) ()
forall (m :: * -> *). MonadRefurb m => FilePath -> m ()
backup FilePath
path