diff options
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 56 |
1 files changed, 50 insertions, 6 deletions
diff --git a/src/Main.hs b/src/Main.hs index e273715..647231d 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -25,7 +25,10 @@ import Command.Extract import Command.JobId import Command.Log import Command.Run +import Command.Shell +import Command.Subtree import Config +import Destination import Output import Repo import Version @@ -63,12 +66,23 @@ options = case span (/= ':') value of ( repo, ':' : path ) -> return opts { optCommon = (optCommon opts) - { optRepo = DeclaredRepo (RepoName $ T.pack repo) path : optRepo (optCommon opts) + { optRepo = ( RepoName $ T.pack repo, path ) : optRepo (optCommon opts) } } _ -> throwError $ "--repo: invalid value ‘" <> value <> "’" ) "<repo>:<path>") ("override or declare repo path") + , Option [] [ "destination" ] + (ReqArg (\value opts -> + case span (/= ':') value of + ( dest, ':' : url ) -> return opts + { optCommon = (optCommon opts) + { optDestination = ( DestinationName $ T.pack dest, T.pack url ) : optDestination (optCommon opts) + } + } + _ -> throwError $ "--repo: invalid value ‘" <> value <> "’" + ) "<destination>:<url>") + ("override or declare destination") , Option [] [ "storage" ] (ReqArg (\value opts -> return opts { optStorage = Just value }) "<path>") "set storage path" @@ -92,6 +106,8 @@ commands = , SC $ Proxy @ExtractCommand , SC $ Proxy @JobIdCommand , SC $ Proxy @LogCommand + , SC $ Proxy @ShellCommand + , SC $ Proxy @SubtreeCommand ] lookupCommand :: String -> Maybe SomeCommandType @@ -239,13 +255,13 @@ runSomeCommand rootPath gopts (SC tproxy) args = do JobRootRepo repo -> return (Just repo) JobRootConfig _ -> openRepo $ takeDirectory ciRootPath - let openDeclaredRepo dir decl = do - let path = dir </> repoPath decl + let openDeclaredRepo dir ( name, dpath ) = do + let path = dir </> dpath openRepo path >>= \case - Just repo -> return ( repoName decl, repo ) + Just repo -> return ( name, repo ) Nothing -> do absPath <- makeAbsolute path - hPutStrLn stderr $ "Failed to open repo ‘" <> showRepoName (repoName decl) <> "’ at " <> repoPath decl <> " (" <> absPath <> ")" + hPutStrLn stderr $ "Failed to open repo ‘" <> showRepoName name <> "’ at " <> dpath <> " (" <> absPath <> ")" exitFailure cmdlineRepos <- forM (optRepo ciOptions) (openDeclaredRepo "") @@ -254,10 +270,38 @@ runSomeCommand rootPath gopts (SC tproxy) args = do forM (configRepos config) $ \decl -> do case lookup (repoName decl) cmdlineRepos of Just repo -> return ( repoName decl, repo ) - Nothing -> openDeclaredRepo (takeDirectory ciRootPath) decl + Nothing + | Just path <- repoPath decl + -> openDeclaredRepo (takeDirectory ciRootPath) ( repoName decl, path ) + + | otherwise + -> do + hPutStrLn stderr $ "No path defined for repo ‘" <> showRepoName (repoName decl) <> "’" + exitFailure + _ -> return [] + + let openDeclaredDestination dir ( name, url ) = do + dest <- openDestination dir url + return ( name, dest ) + + cmdlineDestinations <- forM (optDestination ciOptions) (openDeclaredDestination "") + cfgDestinations <- case ciJobRoot of + JobRootConfig config -> do + forM (configDestinations config) $ \decl -> do + case lookup (destinationName decl) cmdlineDestinations of + Just dest -> return ( destinationName decl, dest ) + Nothing + | Just url <- destinationUrl decl + -> openDeclaredDestination (takeDirectory ciRootPath) ( destinationName decl, url ) + + | otherwise + -> do + hPutStrLn stderr $ "No url defined for destination ‘" <> showDestinationName (destinationName decl) <> "’" + exitFailure _ -> return [] let ciOtherRepos = configRepos ++ cmdlineRepos + ciDestinations = cfgDestinations ++ cmdlineDestinations outputTypes <- case optOutput gopts of Just types -> return types |