diff options
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 130 |
1 files changed, 104 insertions, 26 deletions
diff --git a/src/Main.hs b/src/Main.hs index 971bffe..9e9214f 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -6,45 +6,75 @@ import Control.Monad.Reader import Data.ByteString.Lazy qualified as BL import Data.List +import Data.List.NonEmpty qualified as NE import Data.Proxy import Data.Text qualified as T import System.Console.GetOpt +import System.Directory import System.Environment import System.Exit +import System.FilePath import System.IO import Command +import Command.Checkout +import Command.JobId import Command.Run import Config +import Repo +import Terminal import Version data CmdlineOptions = CmdlineOptions { optShowHelp :: Bool , optShowVersion :: Bool + , optCommon :: CommonOptions + , optStorage :: Maybe FilePath } defaultCmdlineOptions :: CmdlineOptions defaultCmdlineOptions = CmdlineOptions { optShowHelp = False , optShowVersion = False + , optCommon = defaultCommonOptions + , optStorage = Nothing } -options :: [OptDescr (CmdlineOptions -> CmdlineOptions)] +options :: [ OptDescr (CmdlineOptions -> Except String CmdlineOptions) ] options = - [ Option ['h'] ["help"] - (NoArg $ \opts -> opts { optShowHelp = True }) + [ Option [ 'h' ] [ "help" ] + (NoArg $ \opts -> return opts { optShowHelp = True }) "show this help and exit" - , Option ['V'] ["version"] - (NoArg $ \opts -> opts { optShowVersion = True }) + , Option [ 'V' ] [ "version" ] + (NoArg $ \opts -> return opts { optShowVersion = True }) "show version and exit" + , Option [ 'j' ] [ "jobs" ] + (ReqArg (\num opts -> return opts { optCommon = (optCommon opts) { optJobs = read num }}) "<num>") + ("number of jobs to run simultaneously (default " <> show (optJobs defaultCommonOptions) <> ")") + , Option [] [ "repo" ] + (ReqArg (\value opts -> + case span (/= ':') value of + ( repo, ':' : path ) -> return opts + { optCommon = (optCommon opts) + { optRepo = DeclaredRepo (RepoName $ T.pack repo) path : optRepo (optCommon opts) + } + } + _ -> throwError $ "--repo: invalid value `" <> value <> "'" + ) "<repo>:<path>") + ("override or declare repo path") + , Option [] [ "storage" ] + (ReqArg (\value opts -> return opts { optStorage = Just value }) "<path>") + "set storage path" ] data SomeCommandType = forall c. Command c => SC (Proxy c) -commands :: [ SomeCommandType ] +commands :: NE.NonEmpty SomeCommandType commands = - [ SC $ Proxy @RunCommand + ( SC $ Proxy @RunCommand) NE.:| + [ SC $ Proxy @CheckoutCommand + , SC $ Proxy @JobIdCommand ] lookupCommand :: String -> Maybe SomeCommandType @@ -55,25 +85,40 @@ lookupCommand name = find p commands main :: IO () main = do args <- getArgs - (opts, cmdargs) <- case getOpt RequireOrder options args of - (o, cmdargs, []) -> return (foldl (flip id) defaultCmdlineOptions o, cmdargs) + let ( mbConfigPath, args' ) = case args of + (path : rest) + | any isPathSeparator path -> ( Just path, rest ) + _ -> ( Nothing, args ) + + (opts, cmdargs) <- case getOpt RequireOrder options args' of + (os, cmdargs, []) -> do + let merge :: ([String], CmdlineOptions) -> (CmdlineOptions -> Except String CmdlineOptions) -> ([String], CmdlineOptions) + merge ( errs, o ) f = case runExcept $ f o of + Left err -> ( err : errs, o ) + Right o' -> ( errs, o' ) + + case foldl merge ( [], defaultCmdlineOptions ) os of + ( [], opts ) -> return ( opts , cmdargs ) + ( errs, _ ) -> do + hPutStrLn stderr $ unlines (reverse errs) <> "Try `minici --help' for more information." + exitFailure (_, _, errs) -> do hPutStrLn stderr $ concat errs <> "Try `minici --help' for more information." exitFailure when (optShowHelp opts) $ do - let header = "Usage: minici [<option>...] <command> [<args>]\n\nCommon options are:" + let header = "Usage: minici [<job-file>] [<option>...] <command> [<args>]\n\nCommon options are:" commandDesc (SC proxy) = " " <> padCommand (commandName proxy) <> commandDescription proxy padTo n str = str <> replicate (n - length str) ' ' padCommand = padTo (maxCommandNameLength + 3) commandNameLength (SC proxy) = length $ commandName proxy - maxCommandNameLength = maximum $ map commandNameLength commands + maxCommandNameLength = maximum $ fmap commandNameLength commands putStr $ usageInfo header options <> unlines ( [ "" , "Available commands:" - ] ++ map commandDesc commands + ] ++ map commandDesc (NE.toList commands) ) exitSuccess @@ -81,8 +126,17 @@ main = do putStrLn versionLine exitSuccess - (ncmd, cargs) <- case cmdargs of - [] -> return (head commands, []) + ( configPath, cmdargs' ) <- case ( mbConfigPath, cmdargs ) of + ( Just path, _ ) + -> return ( Just path, cmdargs ) + ( _, path : rest ) + | any isPathSeparator path + -> return ( Just path, rest ) + _ -> ( , cmdargs ) <$> findConfig + + ( ncmd, cargs ) <- case cmdargs' of + [] -> return ( NE.head commands, [] ) + (cname : cargs) | Just nc <- lookupCommand cname -> return (nc, cargs) | otherwise -> do @@ -92,7 +146,7 @@ main = do ] exitFailure - runSomeCommand ncmd cargs + runSomeCommand configPath opts ncmd cargs data FullCommandOptions c = FullCommandOptions { fcoSpecific :: CommandOptions c @@ -114,8 +168,10 @@ fullCommandOptions proxy = "show this help and exit" ] -runSomeCommand :: SomeCommandType -> [ String ] -> IO () -runSomeCommand (SC tproxy) args = do +runSomeCommand :: Maybe FilePath -> CmdlineOptions -> SomeCommandType -> [ String ] -> IO () +runSomeCommand ciConfigPath gopts (SC tproxy) args = do + let ciOptions = optCommon gopts + ciStorageDir = optStorage gopts let exitWithErrors errs = do hPutStrLn stderr $ concat errs <> "Try `minici " <> commandName tproxy <> " --help' for more information." exitFailure @@ -132,12 +188,34 @@ runSomeCommand (SC tproxy) args = do putStr $ usageInfo (T.unpack $ commandUsage tproxy) (fullCommandOptions tproxy) exitSuccess - Just configPath <- findConfig - BL.readFile configPath >>= return . parseConfig >>= \case - Left err -> do - putStr err - exitFailure - Right config -> do - let cmd = commandInit tproxy (fcoSpecific opts) cmdargs - let CommandExec exec = commandExec cmd - flip runReaderT config exec + ciConfig <- case ciConfigPath of + Just path -> parseConfig <$> BL.readFile path + Nothing -> return $ Left "no job file found" + + let cmd = commandInit tproxy (fcoSpecific opts) cmdargs + let CommandExec exec = commandExec cmd + + ciContainingRepo <- maybe (return Nothing) (openRepo . takeDirectory) ciConfigPath + + let openDeclaredRepo dir decl = do + let path = dir </> repoPath decl + openRepo path >>= \case + Just repo -> return ( repoName decl, repo ) + Nothing -> do + absPath <- makeAbsolute path + hPutStrLn stderr $ "Failed to open repo `" <> showRepoName (repoName decl) <> "' at " <> repoPath decl <> " (" <> absPath <> ")" + exitFailure + + cmdlineRepos <- forM (optRepo ciOptions) (openDeclaredRepo "") + configRepos <- case ( ciConfigPath, ciConfig ) of + ( Just path, Right config ) -> + forM (configRepos config) $ \decl -> do + case lookup (repoName decl) cmdlineRepos of + Just repo -> return ( repoName decl, repo ) + Nothing -> openDeclaredRepo (takeDirectory path) decl + _ -> return [] + + let ciOtherRepos = configRepos ++ cmdlineRepos + + ciTerminalOutput <- initTerminalOutput + flip runReaderT CommandInput {..} exec |