Watching of remote branches and other refs

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/