1{- git-annex-shell command 2 - 3 - Copyright 2014 Joey Hess <id@joeyh.name> 4 - 5 - Licensed under the GNU AGPL version 3 or higher. 6 -} 7 8module Command.NotifyChanges where 9 10import Command 11import Annex.ChangedRefs 12import RemoteDaemon.Transport.Ssh.Types 13import Utility.SimpleProtocol 14 15import Control.Concurrent.Async 16 17cmd :: Command 18cmd = noCommit $ 19 command "notifychanges" SectionPlumbing 20 "sends notification when git refs are changed" 21 paramNothing (withParams seek) 22 23seek :: CmdParams -> CommandSeek 24seek = withNothing (commandAction start) 25 26start :: CommandStart 27start = go =<< watchChangedRefs 28 where 29 go (Just h) = do 30 -- No messages need to be received from the caller, 31 -- but when it closes the connection, notice and terminate. 32 let receiver = forever $ void $ getProtocolLine stdin 33 let sender = forever $ send . CHANGED =<< waitChangedRefs h 34 35 liftIO $ send READY 36 void $ liftIO $ concurrently sender receiver 37 liftIO $ stopWatchingChangedRefs h 38 stop 39 go Nothing = stop 40 41send :: Notification -> IO () 42send n = do 43 putStrLn $ unwords $ formatMessage n 44 hFlush stdout 45