-- |This module defines the MOO command interface, the commnad line options
-- parser, and helpers to manipulate the Command data structure.
module Moo.CommandInterface
    ( commands
    , commandOptionUsage
    , findCommand
    , getCommandArgs
    , usageString
    ) where

import Data.Maybe
import Moo.CommandHandlers
import Moo.Core
import System.Console.GetOpt

-- |The available commands; used to dispatch from the command line and
-- used to generate usage output.
-- |The available commands; used to dispatch from the command line and
-- used to generate usage output.
commands :: [Command]
commands :: [Command]
commands = [ String
-> [String]
-> [String]
-> [String]
-> String
-> CommandHandler
-> Command
Command String
"new" [String
migrationName]
                           []
                           [String
"no-ask", String
configFile]
                           String
"Create a new empty migration"
                           CommandHandler
newCommand

           , String
-> [String]
-> [String]
-> [String]
-> String
-> CommandHandler
-> Command
Command String
"apply" [String
migrationName]
                             []
                             [String
testOption, String
configFile]
                             String
"Apply the specified migration and its \
                             \dependencies"
                             CommandHandler
applyCommand

           , String
-> [String]
-> [String]
-> [String]
-> String
-> CommandHandler
-> Command
Command String
"revert" [String
migrationName]
                              []
                              [String
testOption, String
configFile]
                              String
"Revert the specified migration and those \
                              \that depend on it"
                              CommandHandler
revertCommand

           , String
-> [String]
-> [String]
-> [String]
-> String
-> CommandHandler
-> Command
Command String
"test" [String
migrationName]
                            []
                            [String
configFile]
                            String
"Test the specified migration by applying \
                            \and reverting it in a transaction, then \
                            \roll back"
                            CommandHandler
testCommand

           , String
-> [String]
-> [String]
-> [String]
-> String
-> CommandHandler
-> Command
Command String
"upgrade" []
                               []
                               [String
testOption, String
configFile]
                               String
"Install all migrations that have not yet \
                               \been installed"

                               CommandHandler
upgradeCommand

           , String
-> [String]
-> [String]
-> [String]
-> String
-> CommandHandler
-> Command
Command String
"upgrade-list" []
                                    []
                                    []
                                    String
"Show the list of migrations not yet \
                                    \installed"
                                    CommandHandler
upgradeListCommand

           , String
-> [String]
-> [String]
-> [String]
-> String
-> CommandHandler
-> Command
Command String
"reinstall" [String
migrationName]
                                 []
                                 [String
testOption, String
configFile]
                                 String
"Reinstall a migration by reverting, then \
                                 \reapplying it"
                                 CommandHandler
reinstallCommand

           , String
-> [String]
-> [String]
-> [String]
-> String
-> CommandHandler
-> Command
Command String
"list" []
                            []
                            [String
configFile]
                            String
"List migrations already installed in the backend"
                            CommandHandler
listCommand
           ]
    where migrationName :: String
migrationName = String
"migrationName"
          testOption :: String
testOption    = String
"test"
          configFile :: String
configFile    = String
"config-file"


findCommand :: String -> Maybe Command
findCommand :: String -> Maybe Command
findCommand String
name = [Command] -> Maybe Command
forall a. [a] -> Maybe a
listToMaybe [ Command
c | Command
c <- [Command]
commands, Command -> String
_cName Command
c String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name ]

commandOptions :: [ OptDescr (CommandOptions -> IO CommandOptions) ]
commandOptions :: [OptDescr (CommandOptions -> IO CommandOptions)]
commandOptions =  [ OptDescr (CommandOptions -> IO CommandOptions)
optionConfigFile
                  , OptDescr (CommandOptions -> IO CommandOptions)
optionTest
                  , OptDescr (CommandOptions -> IO CommandOptions)
optionNoAsk
                  ]

optionConfigFile :: OptDescr (CommandOptions -> IO CommandOptions)
optionConfigFile :: OptDescr (CommandOptions -> IO CommandOptions)
optionConfigFile = String
-> [String]
-> ArgDescr (CommandOptions -> IO CommandOptions)
-> String
-> OptDescr (CommandOptions -> IO CommandOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"c" [String
"config-file"]
                   ((String -> CommandOptions -> IO CommandOptions)
-> String -> ArgDescr (CommandOptions -> IO CommandOptions)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
arg CommandOptions
opt ->
                             CommandOptions -> IO CommandOptions
forall (m :: * -> *) a. Monad m => a -> m a
return CommandOptions
opt { _configFilePath :: Maybe String
_configFilePath = String -> Maybe String
forall a. a -> Maybe a
Just String
arg }) String
"FILE")
                   String
"Specify location of configuration file"

optionTest :: OptDescr (CommandOptions -> IO CommandOptions)
optionTest :: OptDescr (CommandOptions -> IO CommandOptions)
optionTest = String
-> [String]
-> ArgDescr (CommandOptions -> IO CommandOptions)
-> String
-> OptDescr (CommandOptions -> IO CommandOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"t" [String
"test"]
             ((CommandOptions -> IO CommandOptions)
-> ArgDescr (CommandOptions -> IO CommandOptions)
forall a. a -> ArgDescr a
NoArg (\CommandOptions
opt -> CommandOptions -> IO CommandOptions
forall (m :: * -> *) a. Monad m => a -> m a
return CommandOptions
opt { _test :: Bool
_test = Bool
True }))
             String
"Perform the action then rollback when finished"

optionNoAsk :: OptDescr (CommandOptions -> IO CommandOptions)
optionNoAsk :: OptDescr (CommandOptions -> IO CommandOptions)
optionNoAsk = String
-> [String]
-> ArgDescr (CommandOptions -> IO CommandOptions)
-> String
-> OptDescr (CommandOptions -> IO CommandOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"n" [String
"no-ask"]
              ((CommandOptions -> IO CommandOptions)
-> ArgDescr (CommandOptions -> IO CommandOptions)
forall a. a -> ArgDescr a
NoArg (\CommandOptions
opt -> CommandOptions -> IO CommandOptions
forall (m :: * -> *) a. Monad m => a -> m a
return CommandOptions
opt { _noAsk :: Bool
_noAsk = Bool
True }))
              String
"Do not interactively ask any questions, just do it"

getCommandArgs :: [String] -> IO ( CommandOptions, [String] )
getCommandArgs :: [String] -> IO (CommandOptions, [String])
getCommandArgs [String]
args = do
  let ([CommandOptions -> IO CommandOptions]
actions, [String]
required, [String]
_) =  ArgOrder (CommandOptions -> IO CommandOptions)
-> [OptDescr (CommandOptions -> IO CommandOptions)]
-> [String]
-> ([CommandOptions -> IO CommandOptions], [String], [String])
forall a.
ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String])
getOpt ArgOrder (CommandOptions -> IO CommandOptions)
forall a. ArgOrder a
RequireOrder [OptDescr (CommandOptions -> IO CommandOptions)]
commandOptions [String]
args
  CommandOptions
opts <- (IO CommandOptions
 -> (CommandOptions -> IO CommandOptions) -> IO CommandOptions)
-> IO CommandOptions
-> [CommandOptions -> IO CommandOptions]
-> IO CommandOptions
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl IO CommandOptions
-> (CommandOptions -> IO CommandOptions) -> IO CommandOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
(>>=) IO CommandOptions
defaultOptions [CommandOptions -> IO CommandOptions]
actions
  (CommandOptions, [String]) -> IO (CommandOptions, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return ( CommandOptions
opts, [String]
required )

defaultOptions :: IO CommandOptions
defaultOptions :: IO CommandOptions
defaultOptions = CommandOptions -> IO CommandOptions
forall (m :: * -> *) a. Monad m => a -> m a
return (CommandOptions -> IO CommandOptions)
-> CommandOptions -> IO CommandOptions
forall a b. (a -> b) -> a -> b
$ Maybe String -> Bool -> Bool -> CommandOptions
CommandOptions Maybe String
forall a. Maybe a
Nothing Bool
False Bool
False

commandOptionUsage :: String
commandOptionUsage :: String
commandOptionUsage = String
-> [OptDescr (CommandOptions -> IO CommandOptions)] -> String
forall a. String -> [OptDescr a] -> String
usageInfo String
"Options:" [OptDescr (CommandOptions -> IO CommandOptions)]
commandOptions

usageString :: Command -> String
usageString :: Command -> String
usageString Command
command =
    [String] -> String
unwords (Command -> String
_cName Command
commandString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
optionalArgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
options [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
requiredArgs)
    where
      requiredArgs :: [String]
requiredArgs = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
s -> String
"<" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
">") ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Command -> [String]
_cRequired Command
command
      optionalArgs :: [String]
optionalArgs = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
s -> String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]") ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Command -> [String]
_cOptional Command
command
      options :: [String]
options = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
s -> String
"["String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]")  [String]
optionStrings
      optionStrings :: [String]
optionStrings = Command -> [String]
_cAllowedOptions Command
command