summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Expression.hs12
-rw-r--r--src/Repo.hs112
-rw-r--r--test/script/expression.et99
3 files changed, 183 insertions, 40 deletions
diff --git a/src/Expression.hs b/src/Expression.hs
index bf35f2a..43f859e 100644
--- a/src/Expression.hs
+++ b/src/Expression.hs
@@ -132,10 +132,14 @@ evaluateDeclaredRevision repo = \case
ts -> return $ StaticRef $ tagObject $ foldl1' sel ts
WatchedRef (TextRef ref) -> do
- watched <- watchBranch repo ref
- output <- getOutput
- outputEvent output $ TestMessage $ "watch-branch-started " <> ref
- return $ WatchedRef $ BranchRef watched
+ watchBranch repo ref >>= \case
+ Right watched -> do
+ output <- getOutput
+ outputEvent output $ TestMessage $ "watch-branch-started " <> ref
+ return $ WatchedRef $ BranchRef watched
+ Left commit -> do
+ return $ StaticRef commit
+
WatchedRef (TagRef wtPattern wtUpdate) -> do
wtChan <- watchTags repo
value <- filter (Glob.match wtPattern . T.unpack . tagTag) <$> listTags repo >>= \case
diff --git a/src/Repo.hs b/src/Repo.hs
index 7fe699c..9fab2f7 100644
--- a/src/Repo.hs
+++ b/src/Repo.hs
@@ -68,8 +68,7 @@ data Repo
{ gitDir :: FilePath
, gitWritable :: Bool
, gitLock :: MVar ()
- , gitInotify :: MVar (Maybe ( INotify, TChan (Tag Commit) ))
- , gitWatchedBranches :: MVar (Map Text [ TVar (Maybe Commit) ])
+ , gitInotify :: MVar (Maybe GitInotify)
}
instance Show Repo where
@@ -178,7 +177,6 @@ openRepo gitWritable path = do
Just gitDir -> do
gitLock <- newMVar ()
gitInotify <- newMVar Nothing
- gitWatchedBranches <- newMVar M.empty
return $ Just GitRepo {..}
Nothing -> do
return Nothing
@@ -329,6 +327,12 @@ findUpstreamRef repo@GitRepo {..} ref = liftIO $ do
_ -> return Nothing
_ -> return Nothing
+getGitRefPath :: MonadIO m => Repo -> Text -> m (Maybe FilePath)
+getGitRefPath GitRepo {..} ref = liftIO $ do
+ readProcessWithExitCode "git" [ "--git-dir=" <> gitDir, "rev-parse", "--symbolic-full-name", T.unpack ref ] "" >>= \case
+ ( ExitSuccess, out, _ ) | [ path ] <- lines out -> return (Just path)
+ ( _, _, _ ) -> return Nothing
+
getCommitDetails :: (MonadIO m, MonadFail m) => Commit -> m CommitDetails
getCommitDetails Commit {..} = do
@@ -502,41 +506,77 @@ pushToBranch Branch {..} Commit {..} = do
| otherwise -> error "createProcess must return stdout handle"
-repoInotify :: Repo -> IO ( INotify, TChan (Tag Commit) )
-repoInotify repo@GitRepo {..} = modifyMVar gitInotify $ \case
- cur@(Just info) ->
- return ( cur, info )
+data GitInotify = GitInotify
+ { giInotify :: INotify
+ , giTags :: MVar (Maybe ( WatchDescriptor, TChan (Tag Commit) ))
+ , giDirs :: MVar (Map FilePath ( WatchDescriptor, Map Text (TVar (Maybe Commit)) ))
+ }
+
+repoInotify :: Repo -> IO GitInotify
+repoInotify GitRepo {..} = modifyMVar gitInotify $ \case
+ cur@(Just gi) ->
+ return ( cur, gi )
Nothing -> do
- inotify <- initINotify
- tagsChan <- newBroadcastTChanIO
- let info = ( inotify, tagsChan )
+ giInotify <- initINotify
+ giTags <- newMVar Nothing
+ giDirs <- newMVar M.empty
+ let gi = GitInotify {..}
+ return ( Just gi, gi )
+
+watchBranch :: (MonadIO m, MonadFail m) => Repo -> Text -> m (Either Commit (STM (Maybe Commit)))
+watchBranch repo@GitRepo {..} ref = liftIO $ do
+ mbCommit <- tryReadCommit repo ref
+ gi@GitInotify {..} <- repoInotify repo
+ getGitRefPath repo ref >>= \case
+ Just path -> Right <$> do
+ let ( dir, sbranch ) = splitFileName path
+ branch = T.pack sbranch
+ modifyMVar giDirs $ \dirMap ->
+ case M.lookup dir dirMap of
+ Just ( wd, branchMap ) ->
+ case M.lookup branch branchMap of
+ Just tvar -> do
+ return ( dirMap, readTVar tvar )
+ Nothing -> do
+ tvar <- newTVarIO mbCommit
+ return ( M.insert dir ( wd, M.insert branch tvar branchMap ) dirMap, readTVar tvar )
+
+ Nothing -> do
+ wd <- addBranchWatch gi dir
+ tvar <- newTVarIO mbCommit
+ return ( M.insert dir ( wd, M.singleton branch tvar ) dirMap, readTVar tvar )
+
+ Nothing | Just commit <- mbCommit -> do
+ return $ Left commit
- _ <- addWatch inotify [ MoveIn ] (BC.pack headsDir) $ \event -> do
- let branch = decodeUtf8 $ filePath event
- tvars <- fromMaybe [] . M.lookup branch <$> readMVar gitWatchedBranches
- when (not $ null tvars) $ do
- commit <- readBranch repo branch
- atomically $ do
- mapM_ (`writeTVar` commit) tvars
-
- _ <- addWatch inotify [ MoveIn ] (BC.pack tagsDir) $ \event -> do
- tryReadTag repo (decodeUtf8 $ filePath event) >>= \case
- Just tag -> atomically $ writeTChan tagsChan tag
- Nothing -> return ()
-
- return ( Just info, info )
+ _ -> do
+ fail $ "ref ‘" <> T.unpack ref <> "’ not found in ‘" <> gitDir <> "’"
where
- headsDir = gitDir </> "refs/heads"
- tagsDir = gitDir </> "refs/tags"
-
-watchBranch :: MonadIO m => Repo -> Text -> m (STM (Maybe Commit))
-watchBranch repo@GitRepo {..} branch = liftIO $ do
- var <- newTVarIO =<< readBranch repo branch
- void $ repoInotify repo
- modifyMVar_ gitWatchedBranches $ return . M.insertWith (++) branch [ var ]
- return $ readTVar var
+ addBranchWatch GitInotify {..} dir = do
+ addWatch giInotify [ MoveIn ] (BC.pack $ gitDir </> dir) $ \event -> do
+ let branch = decodeUtf8 $ filePath event
+ withMVar giDirs $ \dirMap -> do
+ Just ( _, branchMap ) <- return $ M.lookup dir dirMap
+ case M.lookup branch branchMap of
+ Just tvar -> do
+ commit <- readCommitFromFile repo (dir </> T.unpack branch)
+ atomically $ writeTVar tvar commit
+ Nothing -> do
+ return ()
watchTags :: MonadIO m => Repo -> m (TChan (Tag Commit))
-watchTags repo = liftIO $ do
- tagsChan <- snd <$> repoInotify repo
- atomically $ dupTChan tagsChan
+watchTags repo@GitRepo {..} = liftIO $ do
+ GitInotify {..} <- repoInotify repo
+ chan <- modifyMVar giTags $ \case
+ cur@(Just ( _, chan )) -> do
+ return ( cur, chan )
+ Nothing -> do
+ chan <- newBroadcastTChanIO
+ wd <- addWatch giInotify [ MoveIn ] (BC.pack tagsDir) $ \event -> do
+ tryReadTag repo (decodeUtf8 $ filePath event) >>= \case
+ Just tag -> atomically $ writeTChan chan tag
+ Nothing -> return ()
+ return ( Just ( wd, chan ), chan )
+ atomically $ dupTChan chan
+ where
+ tagsDir = gitDir </> "refs/tags"
diff --git a/test/script/expression.et b/test/script/expression.et
index ce48c93..f137fe7 100644
--- a/test/script/expression.et
+++ b/test/script/expression.et
@@ -460,3 +460,102 @@ test WatchLastTag:
expect from p:
/job-start $td:single/
/job-finish $td:single done/
+
+
+test WatchRemoteRepo:
+ node n
+ shell on n as git_init:
+ mkdir a
+ cd a
+ git -c init.defaultBranch=master init -q
+ git -c user.name=test -c user.email=test commit -q --allow-empty -m 'initial commit'
+ cp "${scripts.path}/single.yaml" minici.yaml
+ git add minici.yaml
+ git -c user.name=test -c user.email=test commit -q -m 'minici.yaml'
+ git rev-parse HEAD
+
+ touch a
+ git add a
+ git -c user.name=test -c user.email=test commit -q -m a
+ git rev-parse HEAD
+ git rev-parse HEAD^{tree}
+
+ touch b
+ git add b
+ git -c user.name=test -c user.email=test commit -q -m b
+ git rev-parse HEAD
+ git rev-parse HEAD^{tree}
+
+ touch c
+ git add c
+ git -c user.name=test -c user.email=test commit -q -m c
+ git rev-parse HEAD
+ git rev-parse HEAD^{tree}
+
+ touch d
+ git add d
+ git -c user.name=test -c user.email=test commit -q -m d
+ git rev-parse HEAD
+ git rev-parse HEAD^{tree}
+
+ touch e
+ git add e
+ git -c user.name=test -c user.email=test commit -q -m e
+ git rev-parse HEAD
+ git rev-parse HEAD^{tree}
+
+ git reset --hard HEAD~5
+ git rev-parse HEAD
+
+ expect /([0-9a-f]+)/ from git_init capture c_init
+ expect /([0-9a-f]+)/ from git_init capture ca
+ expect /([0-9a-f]+)/ from git_init capture ta
+ expect /([0-9a-f]+)/ from git_init capture cb
+ expect /([0-9a-f]+)/ from git_init capture tb
+ expect /([0-9a-f]+)/ from git_init capture cc
+ expect /([0-9a-f]+)/ from git_init capture tc
+ expect /([0-9a-f]+)/ from git_init capture cd
+ expect /([0-9a-f]+)/ from git_init capture td
+ expect /([0-9a-f]+)/ from git_init capture ce
+ expect /([0-9a-f]+)/ from git_init capture te
+ expect /([0-9a-f]+)/ from git_init capture c_end
+
+ guard (c_init == c_end)
+
+ local:
+ shell on n:
+ git -C a checkout -q -b test $cb
+ git clone -q a b
+
+ local:
+ spawn on n as p args [ "./b", "run", "--rerun-all", "$ca..origin/test" ]
+ expect from p:
+ /job-enqueue $tb:single/
+ /job-start $tb:single/
+ /job-finish $tb:single done/
+ expect /(.*)/ from p capture finish
+ guard (finish == "run-finish")
+
+ local:
+ spawn on n as p args [ "./b", "run", "--rerun-all", "watch($ca..origin/test)" ] killwith SIGINT
+ expect from p:
+ /watch-branch-started origin\/test/
+ /job-enqueue $tb:single/
+ /job-start $tb:single/
+ /job-finish $tb:single done/
+
+ local:
+ shell on n:
+ git -C a merge -q --ff-only $cd
+
+ local:
+ shell on n:
+ git -C b fetch -q origin
+
+ expect from p:
+ /job-enqueue $tc:single/
+ /job-start $tc:single/
+ /job-finish $tc:single done/
+ /job-enqueue $td:single/
+ /job-start $td:single/
+ /job-finish $td:single done/
generated by cgit v1.2.3 (git 2.25.1) at 2026-11-06 01:06:41 +0000