Checkout referenced repos when preparing job

6 files changed, 30 insertions, 22 deletions

diff --git a/src/Command/Checkout.hs b/src/Command/Checkout.hs
index 3667e76..7cba593 100644
--- a/src/Command/Checkout.hs
+++ b/src/Command/Checkout.hs
@@ -52,11 +52,7 @@ instance Command CheckoutCommand where
 cmdCheckout :: CheckoutCommand -> CommandExec ()
 cmdCheckout (CheckoutCommand CheckoutOptions {..} name mbrev) = do
     repo <- maybe getDefaultRepo getRepo name
-    root <- getCommitTree =<< case mbrev of
-        Just revision -> readCommit repo revision
-        Nothing -> createWipCommit repo
-    tree <- case coSubtree of
-        Nothing -> return root
-        Just subtree -> maybe (fail $ "subtree `" <> subtree <> "' not found in " <> maybe "current worktree" (("revision `" <>) . (<> "'") . T.unpack) mbrev) return =<<
-            getSubtree subtree root
+    mbCommit <- sequence $ fmap (readCommit repo) mbrev
+    root <- getCommitTree =<< maybe (createWipCommit repo) return mbCommit
+    tree <- maybe return (getSubtree mbCommit) coSubtree $ root
     checkoutAt tree $ maybe "." id coDestination
diff --git a/src/Config.hs b/src/Config.hs
index 68db57d..13be619 100644
--- a/src/Config.hs
+++ b/src/Config.hs
@@ -85,17 +85,18 @@ parseJob name node = flip (withMap "Job") node $ \j -> do
     jobUses <- maybe (return []) parseUses =<< j .:? "uses"
     return Job {..}
 
-parseSingleCheckout :: Node Pos -> Parser [ Either JobCheckout ( JobRepo Declared, JobCheckout ) ]
+parseSingleCheckout :: Node Pos -> Parser [ Either JobCheckout ( JobRepo Declared, Maybe Text, JobCheckout ) ]
 parseSingleCheckout = withMap "checkout definition" $ \m -> do
-    mbName <- m .:? "repo"
     jcSubtree <- fmap T.unpack <$> m .:? "subtree"
     jcDestination <- fmap T.unpack <$> m .:? "dest"
     let checkout = JobCheckout {..}
-    return $ (: []) $ case mbName of
-        Nothing -> Left checkout
-        Just name -> Right ( DeclaredJobRepo (RepoName name), checkout )
+    m .:? "repo" >>= \case
+        Nothing -> return [ Left checkout ]
+        Just name -> do
+            revision <- m .:? "revision"
+            return [ Right ( DeclaredJobRepo (RepoName name), revision, checkout ) ]
 
-parseMultipleCheckouts :: Node Pos -> Parser [ Either JobCheckout ( JobRepo Declared, JobCheckout ) ]
+parseMultipleCheckouts :: Node Pos -> Parser [ Either JobCheckout ( JobRepo Declared, Maybe Text, JobCheckout ) ]
 parseMultipleCheckouts = withSeq "checkout definitions" $ fmap concat . mapM parseSingleCheckout
 
 cabalJob :: Node Pos -> Parser [CreateProcess]
diff --git a/src/Eval.hs b/src/Eval.hs
index 9130dd3..b263a19 100644
--- a/src/Eval.hs
+++ b/src/Eval.hs
@@ -28,10 +28,10 @@ textEvalError (OtherEvalError text) = text
 
 evalJob :: EvalInput -> DeclaredJob -> Except EvalError Job
 evalJob EvalInput {..} decl = do
-    otherCheckout <- forM (jobOtherCheckout decl) $ \( DeclaredJobRepo name, checkout ) -> do
+    otherCheckout <- forM (jobOtherCheckout decl) $ \( DeclaredJobRepo name, revision, checkout ) -> do
         repo <- maybe (throwError $ OtherEvalError $ "repo `" <> textRepoName name <> "' not defined") return $
             lookup name eiOtherRepos
-        return ( EvaluatedJobRepo repo, checkout )
+        return ( EvaluatedJobRepo repo, revision, checkout )
     return Job
         { jobName = jobName decl
         , jobContainingCheckout = jobContainingCheckout decl
diff --git a/src/Job.hs b/src/Job.hs
index 1d30489..820f5e5 100644
--- a/src/Job.hs
+++ b/src/Job.hs
@@ -286,12 +286,23 @@ prepareJob dir mbCommit job inner = do
         jdirCommit <- case mbCommit of
             Just commit -> do
                 tree <- getCommitTree commit
-                checkoutAt tree checkoutPath
+                forM_ (jobContainingCheckout job) $ \(JobCheckout mbsub dest) -> do
+                    subtree <- maybe return (getSubtree mbCommit) mbsub $ tree
+                    checkoutAt subtree $ checkoutPath </> fromMaybe "" dest
                 return $ showTreeId (treeId tree) </> stringJobName (jobName job)
             Nothing -> do
+                when (not $ null $ jobContainingCheckout job) $ do
+                    fail $ "no containing repository, can't do checkout"
                 return $ stringJobName (jobName job)
 
-        let jdir = dir </> "jobs" </> jdirCommit
+        jdirOther <- forM (jobOtherCheckout job) $ \( EvaluatedJobRepo repo, revision, JobCheckout mbsub dest ) -> do
+            commit <- readCommit repo $ fromMaybe "HEAD" revision
+            tree <- getCommitTree commit
+            subtree <- maybe return (getSubtree (Just commit)) mbsub $ tree
+            checkoutAt subtree $ checkoutPath </> fromMaybe "" dest
+            return $ showTreeId (treeId tree)
+
+        let jdir = dir </> "jobs" </> jdirCommit </> joinPath jdirOther
         liftIO $ createDirectoryIfMissing True jdir
 
         inner checkoutPath jdir
diff --git a/src/Job/Types.hs b/src/Job/Types.hs
index a16ba1d..4de9ef9 100644
--- a/src/Job/Types.hs
+++ b/src/Job/Types.hs
@@ -14,7 +14,7 @@ data Evaluated
 data Job' d = Job
     { jobName :: JobName
     , jobContainingCheckout :: [ JobCheckout ]
-    , jobOtherCheckout :: [ ( JobRepo d, JobCheckout ) ]
+    , jobOtherCheckout :: [ ( JobRepo d, Maybe Text, JobCheckout ) ]
     , jobRecipe :: [ CreateProcess ]
     , jobArtifacts :: [ ( ArtifactName, CreateProcess ) ]
     , jobUses :: [ ( JobName, ArtifactName ) ]
diff --git a/src/Repo.hs b/src/Repo.hs
index 2568fff..702f09d 100644
--- a/src/Repo.hs
+++ b/src/Repo.hs
@@ -250,17 +250,17 @@ getCommitMessage :: (MonadIO m, MonadFail m) => Commit -> m Text
 getCommitMessage = fmap commitMessage . getCommitDetails
 
 
-getSubtree :: MonadIO m => FilePath -> Tree -> m (Maybe Tree)
-getSubtree path tree = liftIO $ do
+getSubtree :: (MonadIO m, MonadFail m) => Maybe Commit -> FilePath -> Tree -> m Tree
+getSubtree mbCommit path tree = liftIO $ do
     let GitRepo {..} = treeRepo tree
     readProcessWithExitCode "git" [ "--git-dir=" <> gitDir, "rev-parse", "--verify", "--quiet", showTreeId (treeId tree) <> ":" <> path ] "" >>= \case
         ( ExitSuccess, out, _ ) | tid : _ <- lines out -> do
-            return $ Just Tree
+            return Tree
                 { treeRepo = treeRepo tree
                 , treeId = TreeId (BC.pack tid)
                 }
         _ -> do
-            return Nothing
+            fail $ "subtree `" <> path <> "' not found" <> maybe "" (("in revision `" <>) . (<> "'") . showCommitId . commitId) mbCommit
 
 
 checkoutAt :: (MonadIO m, MonadFail m) => Tree -> FilePath -> m ()