{-# 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
..}) <- 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 forall a. Ord a => a -> a -> Bool
> LogLevel
LevelDebug

  forall (m :: * -> *) a. MonadIO m => LoggingT m a -> m a
runStdoutLoggingT forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a.
(Text -> LogLevel -> Bool) -> LoggingT m a -> LoggingT m a
filterLogger forall {p}. p -> LogLevel -> Bool
logFilter forall a b. (a -> b) -> a -> b
$ do
    $Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> CharPos -> CharPos -> Loc
Text -> LoggingT IO ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: FilePath -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
id :: forall a. a -> a
logDebug forall a b. (a -> b) -> a -> b
$ Text
"Connecting to " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (ConnInfo -> Text
connInfoAsLogString ConnInfo
connInfo)
    forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase 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 forall a b. (a -> b) -> a -> b
$ ConnInfo -> ByteString
connInfoAsConnString ConnInfo
connInfo) (forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase 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) 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

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

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