{-# LANGUAGE NoImplicitPrelude #-}
-- |Module with @optparse-applicative@ parsers for and datatypes to represent the command line arguments.
module Refurb.Cli where

import ClassyPrelude
import Composite.Record ((:->)(Val))
import qualified Options.Applicative as OA
import Refurb.Store (FQualifiedKey)

-- |Newtype wrapper for the @--execute@ boolean (@True@ if given, @False@ if omitted)
newtype GoNoGo = GoNoGo Bool deriving (GoNoGo -> GoNoGo -> Bool
(GoNoGo -> GoNoGo -> Bool)
-> (GoNoGo -> GoNoGo -> Bool) -> Eq GoNoGo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GoNoGo -> GoNoGo -> Bool
$c/= :: GoNoGo -> GoNoGo -> Bool
== :: GoNoGo -> GoNoGo -> Bool
$c== :: GoNoGo -> GoNoGo -> Bool
Eq, Int -> GoNoGo -> ShowS
[GoNoGo] -> ShowS
GoNoGo -> String
(Int -> GoNoGo -> ShowS)
-> (GoNoGo -> String) -> ([GoNoGo] -> ShowS) -> Show GoNoGo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GoNoGo] -> ShowS
$cshowList :: [GoNoGo] -> ShowS
show :: GoNoGo -> String
$cshow :: GoNoGo -> String
showsPrec :: Int -> GoNoGo -> ShowS
$cshowsPrec :: Int -> GoNoGo -> ShowS
Show)

-- |Newtype wrapper for the @--backup-first@ option to the @migrate@ command.
newtype PreMigrationBackup = PreMigrationBackup FilePath deriving (PreMigrationBackup -> PreMigrationBackup -> Bool
(PreMigrationBackup -> PreMigrationBackup -> Bool)
-> (PreMigrationBackup -> PreMigrationBackup -> Bool)
-> Eq PreMigrationBackup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PreMigrationBackup -> PreMigrationBackup -> Bool
$c/= :: PreMigrationBackup -> PreMigrationBackup -> Bool
== :: PreMigrationBackup -> PreMigrationBackup -> Bool
$c== :: PreMigrationBackup -> PreMigrationBackup -> Bool
Eq, Int -> PreMigrationBackup -> ShowS
[PreMigrationBackup] -> ShowS
PreMigrationBackup -> String
(Int -> PreMigrationBackup -> ShowS)
-> (PreMigrationBackup -> String)
-> ([PreMigrationBackup] -> ShowS)
-> Show PreMigrationBackup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PreMigrationBackup] -> ShowS
$cshowList :: [PreMigrationBackup] -> ShowS
show :: PreMigrationBackup -> String
$cshow :: PreMigrationBackup -> String
showsPrec :: Int -> PreMigrationBackup -> ShowS
$cshowsPrec :: Int -> PreMigrationBackup -> ShowS
Show)

-- |Newtype wrapper for the @--seed@ boolean (@True@ if given, @False@ if omitted)
newtype InstallSeedData = InstallSeedData Bool deriving (InstallSeedData -> InstallSeedData -> Bool
(InstallSeedData -> InstallSeedData -> Bool)
-> (InstallSeedData -> InstallSeedData -> Bool)
-> Eq InstallSeedData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstallSeedData -> InstallSeedData -> Bool
$c/= :: InstallSeedData -> InstallSeedData -> Bool
== :: InstallSeedData -> InstallSeedData -> Bool
$c== :: InstallSeedData -> InstallSeedData -> Bool
Eq, Int -> InstallSeedData -> ShowS
[InstallSeedData] -> ShowS
InstallSeedData -> String
(Int -> InstallSeedData -> ShowS)
-> (InstallSeedData -> String)
-> ([InstallSeedData] -> ShowS)
-> Show InstallSeedData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstallSeedData] -> ShowS
$cshowList :: [InstallSeedData] -> ShowS
show :: InstallSeedData -> String
$cshow :: InstallSeedData -> String
showsPrec :: Int -> InstallSeedData -> ShowS
$cshowsPrec :: Int -> InstallSeedData -> ShowS
Show)

-- |The various top level commands that can be requested by the user
data Command
  = CommandMigrate GoNoGo (Maybe PreMigrationBackup) InstallSeedData
  -- ^Migrate the database or show what migrations would be applied, possibly backing up beforehand.
  | CommandShowLog
  -- ^Show the migration status.
  | CommandShowMigration FQualifiedKey
  -- ^Show status of a particular migration with its log output.
  | CommandBackup FilePath
  -- ^Back up the database.
  deriving (Command -> Command -> Bool
(Command -> Command -> Bool)
-> (Command -> Command -> Bool) -> Eq Command
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c== :: Command -> Command -> Bool
Eq, Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
(Int -> Command -> ShowS)
-> (Command -> String) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show)

-- |Option parser for the @migrate@ command
commandMigrateParser :: OA.ParserInfo Command
commandMigrateParser :: ParserInfo Command
commandMigrateParser =
  Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info
    (
      GoNoGo -> Maybe PreMigrationBackup -> InstallSeedData -> Command
CommandMigrate
        (GoNoGo -> Maybe PreMigrationBackup -> InstallSeedData -> Command)
-> Parser GoNoGo
-> Parser (Maybe PreMigrationBackup -> InstallSeedData -> Command)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Bool -> GoNoGo
GoNoGo (Bool -> GoNoGo) -> Parser Bool -> Parser GoNoGo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
OA.switch
              (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"execute"
              Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
OA.short Char
'e'
              Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Actually run migrations. Without this switch the migrations to run will be logged but none of them executed."
              )
            )
        Parser (Maybe PreMigrationBackup -> InstallSeedData -> Command)
-> Parser (Maybe PreMigrationBackup)
-> Parser (InstallSeedData -> Command)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( ReadM (Maybe PreMigrationBackup)
-> Mod OptionFields (Maybe PreMigrationBackup)
-> Parser (Maybe PreMigrationBackup)
forall a. ReadM a -> Mod OptionFields a -> Parser a
OA.option (PreMigrationBackup -> Maybe PreMigrationBackup
forall a. a -> Maybe a
Just (PreMigrationBackup -> Maybe PreMigrationBackup)
-> (String -> PreMigrationBackup)
-> String
-> Maybe PreMigrationBackup
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> PreMigrationBackup
PreMigrationBackup (String -> Maybe PreMigrationBackup)
-> ReadM String -> ReadM (Maybe PreMigrationBackup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM String
forall a. Read a => ReadM a
OA.auto)
              (  Maybe PreMigrationBackup
-> Mod OptionFields (Maybe PreMigrationBackup)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
OA.value Maybe PreMigrationBackup
forall a. Maybe a
Nothing
              Mod OptionFields (Maybe PreMigrationBackup)
-> Mod OptionFields (Maybe PreMigrationBackup)
-> Mod OptionFields (Maybe PreMigrationBackup)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Maybe PreMigrationBackup)
forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"backup-first"
              Mod OptionFields (Maybe PreMigrationBackup)
-> Mod OptionFields (Maybe PreMigrationBackup)
-> Mod OptionFields (Maybe PreMigrationBackup)
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields (Maybe PreMigrationBackup)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
OA.short Char
'b'
              Mod OptionFields (Maybe PreMigrationBackup)
-> Mod OptionFields (Maybe PreMigrationBackup)
-> Mod OptionFields (Maybe PreMigrationBackup)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Maybe PreMigrationBackup)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
OA.metavar String
"BACKUP-FILE"
              Mod OptionFields (Maybe PreMigrationBackup)
-> Mod OptionFields (Maybe PreMigrationBackup)
-> Mod OptionFields (Maybe PreMigrationBackup)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (Maybe PreMigrationBackup)
forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Back up the database before applying migrations. Has no effect without --execute."
              )
            )
        Parser (InstallSeedData -> Command)
-> Parser InstallSeedData -> Parser Command
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Bool -> InstallSeedData
InstallSeedData (Bool -> InstallSeedData) -> Parser Bool -> Parser InstallSeedData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
OA.switch
              (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"seed"
              Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
OA.short Char
's'
              Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Apply seed scripts in addition to schema migrations. Not available on prod databases."
              )
            )
    )
    ( String -> InfoMod Command
forall a. String -> InfoMod a
OA.progDesc String
"Apply migrations to the database, or see which ones would be applied" )

-- |Option parser for the @show-log@ command
commandShowLogParser :: OA.ParserInfo Command
commandShowLogParser :: ParserInfo Command
commandShowLogParser =
  Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info
    (
      Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
CommandShowLog
    )
    ( String -> InfoMod Command
forall a. String -> InfoMod a
OA.progDesc String
"Show migrations along with their status in the database" )

-- |Option parser for the @show-migration@ command
commandShowMigrationParser :: OA.ParserInfo Command
commandShowMigrationParser :: ParserInfo Command
commandShowMigrationParser =
  Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info
    (
      FQualifiedKey -> Command
CommandShowMigration
        (FQualifiedKey -> Command)
-> Parser FQualifiedKey -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> FQualifiedKey
forall (s :: Symbol) a. a -> s :-> a
Val (Text -> FQualifiedKey)
-> (String -> Text) -> String -> FQualifiedKey
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
forall seq. IsSequence seq => [Element seq] -> seq
pack (String -> FQualifiedKey) -> Parser String -> Parser FQualifiedKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
OA.strArgument (String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
OA.metavar String
"MIGRATION-KEY"))
    )
    ( String -> InfoMod Command
forall a. String -> InfoMod a
OA.progDesc String
"Show status of and log details for a particular migration" )

-- |Option parser for the @backup@ command
commandBackupParser :: OA.ParserInfo Command
commandBackupParser :: ParserInfo Command
commandBackupParser =
  Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info
    (
      String -> Command
CommandBackup
        (String -> Command) -> Parser String -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
OA.strArgument (String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
OA.metavar String
"BACKUP-FILE")
    )
    ( String -> InfoMod Command
forall a. String -> InfoMod a
OA.progDesc String
"Back up the database" )

-- |Structure holding the parsed command line arguments and options.
data Opts = Opts
  { Opts -> Bool
debug      :: Bool
  -- ^Whether to turn on debug logging to the console
  , Opts -> Bool
colorize   :: Bool
  -- ^Whether to colorize console output
  , Opts -> String
configFile :: FilePath
  -- ^The configuration file where (presumably) the database connection information is stored
  , Opts -> Command
command    :: Command
  -- ^Which command the user chose and the options for that command
  }

-- |Parser for the command line arguments
optsParser :: OA.ParserInfo Opts
optsParser :: ParserInfo Opts
optsParser =
  Parser Opts -> InfoMod Opts -> ParserInfo Opts
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info
    (
      Parser (Opts -> Opts)
forall a. Parser (a -> a)
OA.helper Parser (Opts -> Opts) -> Parser Opts -> Parser Opts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (
        Bool -> Bool -> String -> Command -> Opts
Opts
          (Bool -> Bool -> String -> Command -> Opts)
-> Parser Bool -> Parser (Bool -> String -> Command -> Opts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
OA.switch
                (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"debug"
                Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
OA.short Char
'd'
                Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Turn on debug diagnostic logging"
                )
          Parser (Bool -> String -> Command -> Opts)
-> Parser Bool -> Parser (String -> Command -> Opts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> Bool
not (Bool -> Bool) -> Parser Bool -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
OA.switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"no-color" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
OA.help String
"disable ANSI colorization"))
          Parser (String -> Command -> Opts)
-> Parser String -> Parser (Command -> Opts)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
OA.strOption
                (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
OA.long String
"config"
                Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
OA.short Char
'c'
                Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
OA.metavar String
"SERVER-CONFIG"
                Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
OA.help String
"Path to server config file to read database connection information from"
                )
          Parser (Command -> Opts) -> Parser Command -> Parser Opts
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
OA.hsubparser
                (  String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command String
"migrate"        ParserInfo Command
commandMigrateParser
                Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command String
"show-log"       ParserInfo Command
commandShowLogParser
                Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command String
"show-migration" ParserInfo Command
commandShowMigrationParser
                Mod CommandFields Command
-> Mod CommandFields Command -> Mod CommandFields Command
forall a. Semigroup a => a -> a -> a
<> String -> ParserInfo Command -> Mod CommandFields Command
forall a. String -> ParserInfo a -> Mod CommandFields a
OA.command String
"backup"         ParserInfo Command
commandBackupParser
                )
      )
    )
    (  InfoMod Opts
forall a. InfoMod a
OA.fullDesc
    InfoMod Opts -> InfoMod Opts -> InfoMod Opts
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Opts
forall a. String -> InfoMod a
OA.header String
"Maintain server database"
    )