refurb-0.2.3.0: src/Refurb.hs

{-# 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 readConnInfo migrations = do
  opts@(Opts {..}) <- OA.execParser optsParser

  connInfo <- readConnInfo configFile

  let logFilter = if debug
                  then \ _ _   -> True
                  else \ _ lvl -> lvl > LevelDebug

  runStdoutLoggingT . filterLogger logFilter $ do
    $logDebug $ "Connecting to " <> tshow (connInfoAsLogString connInfo)
    bracket (liftBase . PG.connectPostgreSQL $ connInfoAsConnString connInfo) (liftBase . PG.close) $ \ conn -> do
      let context = Context opts conn connInfo migrations

      unlessM (isSchemaPresent conn) $ initializeSchema conn

      void . liftIO $ PG.execute_ conn "set search_path = 'public'"
      flip runReaderT context $
        case command of
          CommandMigrate goNoGo backupMay installSeedData ->
            migrate goNoGo backupMay installSeedData
          CommandShowLog ->
            showLog
          CommandShowMigration key ->
            showMigration key
          CommandBackup path ->
            backup path