Verbose option for ‘jobid’ command

5 files changed, 59 insertions, 19 deletions

diff --git a/src/Command/JobId.hs b/src/Command/JobId.hs
index d0a85db..1cfd18c 100644
--- a/src/Command/JobId.hs
+++ b/src/Command/JobId.hs
@@ -2,18 +2,26 @@ module Command.JobId (
     JobIdCommand,
 ) where
 
+import Control.Monad
 import Control.Monad.IO.Class
 
 import Data.Text (Text)
 import Data.Text qualified as T
-import Data.Text.IO qualified as T
+
+import System.Console.GetOpt
 
 import Command
 import Eval
 import Job.Types
+import Output
+import Repo
+
 
+data JobIdCommand = JobIdCommand JobIdOptions JobRef
 
-data JobIdCommand = JobIdCommand JobRef
+data JobIdOptions = JobIdOptions
+    { joVerbose :: Bool
+    }
 
 instance Command JobIdCommand where
     commandName _ = "jobid"
@@ -22,17 +30,44 @@ instance Command JobIdCommand where
     type CommandArguments JobIdCommand = Text
 
     commandUsage _ = T.pack $ unlines $
-        [ "Usage: minici jobid <job ref>"
+        [ "Usage: minici jobid [<option>...] <job ref>"
+        ]
+
+    type CommandOptions JobIdCommand = JobIdOptions
+    defaultCommandOptions _ = JobIdOptions
+        { joVerbose = False
+        }
+
+    commandOptions _ =
+        [ Option [ 'v' ] [ "verbose" ]
+            (NoArg $ \opts -> opts { joVerbose = True })
+            "show detals of the ID"
         ]
 
-    commandInit _ _ = JobIdCommand . JobRef . T.splitOn "."
+    commandInit _ opts = JobIdCommand opts . JobRef . T.splitOn "."
     commandExec = cmdJobId
 
 
 cmdJobId :: JobIdCommand -> CommandExec ()
-cmdJobId (JobIdCommand ref) = do
+cmdJobId (JobIdCommand JobIdOptions {..} ref) = do
     einput <- getEvalInput
+    out <- getOutput
     JobId ids <- either (tfail . textEvalError) return =<<
         liftIO (runEval (evalJobReference ref) einput)
 
-    liftIO $ T.putStrLn $ textJobId $ JobId ids
+    outputMessage out $ textJobId $ JobId ids
+    when joVerbose $ do
+        outputMessage out ""
+        forM_ ids $ \case
+            JobIdName name -> outputMessage out $ textJobName name <> " (job name)"
+            JobIdCommit mbrepo cid -> outputMessage out $ T.concat
+                [ textCommitId cid, " (commit"
+                , maybe "" (\name -> " from ‘" <> textRepoName name <> "’ repo") mbrepo
+                , ")"
+                ]
+            JobIdTree mbrepo subtree cid -> outputMessage out $ T.concat
+                [ textTreeId cid, " (tree"
+                , maybe "" (\name -> " from ‘" <> textRepoName name <> "’ repo") mbrepo
+                , if not (null subtree) then ", subtree ‘" <> T.pack subtree <> "’" else ""
+                , ")"
+                ]
diff --git a/src/Command/Run.hs b/src/Command/Run.hs
index 593412c..6190236 100644
--- a/src/Command/Run.hs
+++ b/src/Command/Run.hs
@@ -136,7 +136,7 @@ argumentJobSource names = do
             return ( config, Just commit )
 
     cidPart <- case jobsetCommit of
-        Just commit -> (: []) . JobIdTree Nothing . treeId <$> getCommitTree commit
+        Just commit -> (: []) . JobIdTree Nothing "" . treeId <$> getCommitTree commit
         Nothing -> return []
     jobsetJobsEither <- fmap Right $ forM names $ \name ->
         case find ((name ==) . jobName) (configJobs config) of
@@ -162,7 +162,7 @@ rangeSource base tip = do
     jobsets <- forM commits $ \commit -> do
         tree <- getCommitTree commit
         cmdEvalWith (\ei -> ei
-            { eiCurrentIdRev = JobIdTree Nothing (treeId tree) : eiCurrentIdRev ei
+            { eiCurrentIdRev = JobIdTree Nothing (treeSubdir tree) (treeId tree) : eiCurrentIdRev ei
             }) . evalJobSet [] =<< loadJobSetFromRoot root commit
     oneshotJobSource jobsets
 
@@ -185,7 +185,7 @@ watchBranchSource branch = do
             jobsets <- forM commits $ \commit -> do
                 tree <- getCommitTree commit
                 let einput = einputBase
-                        { eiCurrentIdRev = JobIdTree Nothing (treeId tree) : eiCurrentIdRev einputBase
+                        { eiCurrentIdRev = JobIdTree Nothing (treeSubdir tree) (treeId tree) : eiCurrentIdRev einputBase
                         }
                 either (fail . T.unpack . textEvalError) return =<<
                     flip runEval einput . evalJobSet [] =<< loadJobSetFromRoot root commit
@@ -215,7 +215,7 @@ watchTagSource pat = do
               then do
                 tree <- getCommitTree $ tagObject tag
                 let einput = einputBase
-                        { eiCurrentIdRev = JobIdTree Nothing (treeId tree) : eiCurrentIdRev einputBase
+                        { eiCurrentIdRev = JobIdTree Nothing (treeSubdir tree) (treeId tree) : eiCurrentIdRev einputBase
                         }
                 jobset <- either (fail . T.unpack . textEvalError) return =<<
                     flip runEval einput . evalJobSet [] =<< loadJobSetFromRoot root (tagObject tag)
diff --git a/src/Eval.hs b/src/Eval.hs
index 4e9f528..013c074 100644
--- a/src/Eval.hs
+++ b/src/Eval.hs
@@ -56,7 +56,7 @@ isDefaultRepoMissingInId djob
   where
     matches (JobIdName _) = False
     matches (JobIdCommit rname _) = isNothing rname
-    matches (JobIdTree rname _) = isNothing rname
+    matches (JobIdTree rname _ _) = isNothing rname
 
 collectOtherRepos :: DeclaredJob -> Eval [ (( Maybe RepoName, Maybe Text ), FilePath ) ]
 collectOtherRepos decl = do
@@ -75,7 +75,7 @@ evalJob revisionOverrides decl = do
     EvalInput {..} <- ask
     otherRepos <- collectOtherRepos decl
     otherRepoTrees <- forM otherRepos $ \(( mbname, mbrev ), commonPath ) -> do
-        ( mbname, ) <$> case lookup mbname revisionOverrides of
+        ( mbname, ) . ( commonPath, ) <$> case lookup mbname revisionOverrides of
             Just tree -> return tree
             Nothing -> case maybe eiContainingRepo (flip lookup eiOtherRepos) mbname of
                 Just repo -> do
@@ -84,11 +84,11 @@ evalJob revisionOverrides decl = do
                 Nothing -> throwError $ OtherEvalError $ "repo ‘" <> maybe "" textRepoName mbname <> "’ not defined"
 
     otherCheckout <- forM (jobOtherCheckout decl) $ \(( name, _ ), checkout ) -> do
-        (, checkout ) <$> case lookup (Just name) otherRepoTrees of
+        (, checkout ) <$> case snd <$> lookup (Just name) otherRepoTrees of
             Just tree -> return tree
             Nothing -> throwError $ OtherEvalError $ "repo ‘" <> textRepoName name <> "’ not defined"
 
-    let otherRepoIds = map (uncurry JobIdTree . fmap treeId) otherRepoTrees
+    let otherRepoIds = map (\( name, ( subtree, tree )) -> JobIdTree name subtree (treeId tree)) otherRepoTrees
     return Job
         { jobId = JobId $ reverse $ reverse otherRepoIds ++ JobIdName (jobId decl) : eiCurrentIdRev
         , jobName = jobName decl
@@ -148,7 +148,7 @@ canonicalCommitConfig :: [ Text ] -> Repo -> Eval JobId
 canonicalCommitConfig rs repo = do
     ( tree, rs' ) <- readTreeFromIdRef rs "" repo
     config <- either fail return =<< loadConfigForCommit tree
-    local (\ei -> ei { eiCurrentIdRev = JobIdTree Nothing (treeId tree) : eiCurrentIdRev ei }) $
+    local (\ei -> ei { eiCurrentIdRev = JobIdTree Nothing "" (treeId tree) : eiCurrentIdRev ei }) $
         canonicalJobName rs' config
 
 evalJobReference :: JobRef -> Eval JobId
diff --git a/src/Job/Types.hs b/src/Job/Types.hs
index b5d05fb..7e7a4b8 100644
--- a/src/Job/Types.hs
+++ b/src/Job/Types.hs
@@ -72,7 +72,7 @@ newtype JobId = JobId [ JobIdPart ]
 data JobIdPart
     = JobIdName JobName
     | JobIdCommit (Maybe RepoName) CommitId
-    | JobIdTree (Maybe RepoName) TreeId
+    | JobIdTree (Maybe RepoName) FilePath TreeId
     deriving (Eq, Ord)
 
 newtype JobRef = JobRef [ Text ]
@@ -82,7 +82,7 @@ textJobIdPart :: JobIdPart -> Text
 textJobIdPart = \case
     JobIdName name -> textJobName name
     JobIdCommit _ cid -> textCommitId cid
-    JobIdTree _ tid -> textTreeId tid
+    JobIdTree _ _ tid -> textTreeId tid
 
 textJobId :: JobId -> Text
 textJobId (JobId ids) = T.intercalate "." $ map textJobIdPart ids
diff --git a/src/Output.hs b/src/Output.hs
index 54b434e..5838342 100644
--- a/src/Output.hs
+++ b/src/Output.hs
@@ -6,12 +6,14 @@ module Output (
 
     withOutput,
     outputTerminal,
+    outputMessage,
     outputEvent,
     outputFootnote,
 ) where
 
 import Control.Monad
 import Control.Monad.Catch
+import Control.Monad.IO.Class
 
 import Data.Text (Text)
 import Data.Text.IO qualified as T
@@ -76,8 +78,11 @@ outStrLn Output {..} h text
     | otherwise = do
         T.hPutStrLn h text
 
-outputEvent :: Output -> OutputEvent -> IO ()
-outputEvent out@Output {..} = \case
+outputMessage :: MonadIO m => Output -> Text -> m ()
+outputMessage out msg = outputEvent out (OutputMessage msg)
+
+outputEvent :: MonadIO m => Output -> OutputEvent -> m ()
+outputEvent out@Output {..} = liftIO . \case
     OutputMessage msg -> do
         forM_ outTerminal $ \term -> void $ newLine term msg
         forM_ outLogs $ \h -> outStrLn out h msg