{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
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
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