diff options
| -rw-r--r-- | src/Command/Checkout.hs | 4 | ||||
| -rw-r--r-- | src/Job.hs | 10 | ||||
| -rw-r--r-- | src/Repo.hs | 27 |
3 files changed, 24 insertions, 17 deletions
diff --git a/src/Command/Checkout.hs b/src/Command/Checkout.hs index c180a34..1859c05 100644 --- a/src/Command/Checkout.hs +++ b/src/Command/Checkout.hs @@ -30,5 +30,5 @@ instance Command CheckoutCommand where cmdCheckout :: CheckoutCommand -> CommandExec () cmdCheckout (CheckoutCommand name revision) = do repo <- maybe getDefaultRepo getRepo name - commit <- maybe (fail $ T.unpack $ "revision `" <> revision <> "' not found") return =<< readCommit repo revision - checkoutAt commit "." + tree <- maybe (fail $ T.unpack $ "revision `" <> revision <> "' not found") getCommitTree =<< readCommit repo revision + checkoutAt tree "." @@ -180,10 +180,10 @@ runManagedJob JobManager {..} tid cancel job = bracket acquire release $ \case runJobs :: JobManager -> Commit -> [ Job ] -> IO [ ( Job, TVar (JobStatus JobOutput) ) ] runJobs mngr@JobManager {..} commit jobs = do - treeId <- getTreeId commit + tree <- getCommitTree commit results <- atomically $ do forM jobs $ \job -> do - let jid = JobId [ JobIdTree treeId, JobIdName (jobName job) ] + let jid = JobId [ JobIdTree (treeId tree), JobIdName (jobName job) ] tid <- reserveTaskId mngr managed <- readTVar jmJobs ( job, tid, ) <$> case M.lookup jid managed of @@ -282,10 +282,10 @@ updateStatusFile path outVar = void $ liftIO $ forkIO $ loop Nothing prepareJob :: (MonadIO m, MonadMask m, MonadFail m) => FilePath -> Commit -> Job -> (FilePath -> FilePath -> m a) -> m a prepareJob dir commit job inner = do withSystemTempDirectory "minici" $ \checkoutPath -> do - checkoutAt commit checkoutPath - tid <- getTreeId commit + tree <- getCommitTree commit + checkoutAt tree checkoutPath - let jdir = dir </> "jobs" </> showTreeId tid </> stringJobName (jobName job) + let jdir = dir </> "jobs" </> showTreeId (treeId tree) </> stringJobName (jobName job) liftIO $ createDirectoryIfMissing True jdir inner checkoutPath jdir diff --git a/src/Repo.hs b/src/Repo.hs index 71fcca5..0720179 100644 --- a/src/Repo.hs +++ b/src/Repo.hs @@ -4,6 +4,7 @@ module Repo ( RepoName(..), textRepoName, showRepoName, Commit, commitId, CommitId, textCommitId, showCommitId, + Tree, treeId, treeRepo, TreeId, textTreeId, showTreeId, Tag(..), @@ -14,7 +15,7 @@ module Repo ( listCommits, findUpstreamRef, - getTreeId, + getCommitTree, getCommitTitle, getCommitMessage, @@ -82,11 +83,16 @@ commitId :: Commit -> CommitId commitId = commitId_ data CommitDetails = CommitDetails - { commitTreeId :: TreeId + { commitTree :: Tree , commitTitle :: Text , commitMessage :: Text } +data Tree = Tree + { treeRepo :: Repo + , treeId :: TreeId + } + data Tag a = Tag { tagTag :: Text , tagObject :: a @@ -220,15 +226,17 @@ getCommitDetails Commit {..} = do runGitCommand commitRepo [ "cat-file", "commit", showCommitId commitId_ ] let info = map (fmap (drop 1) . span (/= ' ')) infoPart - Just commitTreeId <- return $ TreeId . BC.pack <$> lookup "tree" info + Just treeId <- return $ TreeId . BC.pack <$> lookup "tree" info + let treeRepo = commitRepo + let commitTree = Tree {..} let commitTitle = T.pack title let commitMessage = T.pack $ unlines $ dropWhile null message let details = CommitDetails {..} return ( Just details, details ) -getTreeId :: (MonadIO m, MonadFail m) => Commit -> m TreeId -getTreeId = fmap commitTreeId . getCommitDetails +getCommitTree :: (MonadIO m, MonadFail m) => Commit -> m Tree +getCommitTree = fmap commitTree . getCommitDetails getCommitTitle :: (MonadIO m, MonadFail m) => Commit -> m Text getCommitTitle = fmap commitTitle . getCommitDetails @@ -237,10 +245,9 @@ getCommitMessage :: (MonadIO m, MonadFail m) => Commit -> m Text getCommitMessage = fmap commitMessage . getCommitDetails -checkoutAt :: (MonadIO m, MonadFail m) => Commit -> FilePath -> m () -checkoutAt commit@Commit {..} dest = do - let GitRepo {..} = commitRepo - tid <- getTreeId commit +checkoutAt :: (MonadIO m, MonadFail m) => Tree -> FilePath -> m () +checkoutAt Tree {..} dest = do + let GitRepo {..} = treeRepo liftIO $ withMVar gitLock $ \_ -> withSystemTempFile "minici-checkout.index" $ \index _ -> do let gitProc args = (proc "git" args) { env = Just @@ -249,7 +256,7 @@ checkoutAt commit@Commit {..} dest = do , ( "GIT_WORK_TREE", "." ) ] } - "" <- readCreateProcess (gitProc [ "read-tree", showTreeId tid ]) "" + "" <- readCreateProcess (gitProc [ "read-tree", showTreeId treeId ]) "" "" <- readCreateProcess (gitProc [ "checkout-index", "--all", "--prefix=" <> addTrailingPathSeparator dest ]) "" return () |