split BranchChange and lifted
This commit is contained in:
parent
0c584bf70d
commit
39a3adf434
5 changed files with 29 additions and 13 deletions
|
@ -7,16 +7,13 @@
|
||||||
|
|
||||||
module Assistant.BranchChange where
|
module Assistant.BranchChange where
|
||||||
|
|
||||||
|
import Assistant.Common
|
||||||
|
import Assistant.Types.BranchChange
|
||||||
|
|
||||||
import Control.Concurrent.MSampleVar
|
import Control.Concurrent.MSampleVar
|
||||||
import Common.Annex
|
|
||||||
|
|
||||||
newtype BranchChangeHandle = BranchChangeHandle (MSampleVar ())
|
branchChanged :: Assistant ()
|
||||||
|
branchChanged = flip writeSV () <<~ (fromBranchChangeHandle . branchChangeHandle)
|
||||||
|
|
||||||
newBranchChangeHandle :: IO BranchChangeHandle
|
waitBranchChange :: Assistant ()
|
||||||
newBranchChangeHandle = BranchChangeHandle <$> newEmptySV
|
waitBranchChange = readSV <<~ (fromBranchChangeHandle . branchChangeHandle)
|
||||||
|
|
||||||
branchChanged :: BranchChangeHandle -> IO ()
|
|
||||||
branchChanged (BranchChangeHandle h) = writeSV h ()
|
|
||||||
|
|
||||||
waitBranchChange :: BranchChangeHandle -> IO ()
|
|
||||||
waitBranchChange (BranchChangeHandle h) = readSV h
|
|
||||||
|
|
|
@ -32,9 +32,9 @@ import Assistant.Types.ScanRemotes
|
||||||
import Assistant.TransferQueue
|
import Assistant.TransferQueue
|
||||||
import Assistant.TransferSlots
|
import Assistant.TransferSlots
|
||||||
import Assistant.Types.Pushes
|
import Assistant.Types.Pushes
|
||||||
|
import Assistant.Types.BranchChange
|
||||||
import Assistant.Commits
|
import Assistant.Commits
|
||||||
import Assistant.Changes
|
import Assistant.Changes
|
||||||
import Assistant.BranchChange
|
|
||||||
|
|
||||||
newtype Assistant a = Assistant { mkAssistant :: ReaderT AssistantData IO a }
|
newtype Assistant a = Assistant { mkAssistant :: ReaderT AssistantData IO a }
|
||||||
deriving (
|
deriving (
|
||||||
|
|
|
@ -39,7 +39,7 @@ configMonitorThread = NamedThread "ConfigMonitor" $ loop =<< getConfigs
|
||||||
where
|
where
|
||||||
loop old = do
|
loop old = do
|
||||||
liftIO $ threadDelaySeconds (Seconds 60)
|
liftIO $ threadDelaySeconds (Seconds 60)
|
||||||
waitBranchChange <<~ branchChangeHandle
|
waitBranchChange
|
||||||
new <- getConfigs
|
new <- getConfigs
|
||||||
when (old /= new) $ do
|
when (old /= new) $ do
|
||||||
let changedconfigs = new `S.difference` old
|
let changedconfigs = new `S.difference` old
|
||||||
|
|
|
@ -66,7 +66,7 @@ onAdd :: Handler
|
||||||
onAdd file
|
onAdd file
|
||||||
| ".lock" `isSuffixOf` file = noop
|
| ".lock" `isSuffixOf` file = noop
|
||||||
| isAnnexBranch file = do
|
| isAnnexBranch file = do
|
||||||
branchChanged <<~ branchChangeHandle
|
branchChanged
|
||||||
transferqueue <- getAssistant transferQueue
|
transferqueue <- getAssistant transferQueue
|
||||||
dstatus <- getAssistant daemonStatusHandle
|
dstatus <- getAssistant daemonStatusHandle
|
||||||
liftAnnex $
|
liftAnnex $
|
||||||
|
|
19
Assistant/Types/BranchChange.hs
Normal file
19
Assistant/Types/BranchChange.hs
Normal file
|
@ -0,0 +1,19 @@
|
||||||
|
{- git-annex assistant git-annex branch change tracking
|
||||||
|
-
|
||||||
|
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
||||||
|
-
|
||||||
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Assistant.Types.BranchChange where
|
||||||
|
|
||||||
|
import Control.Concurrent.MSampleVar
|
||||||
|
import Common.Annex
|
||||||
|
|
||||||
|
newtype BranchChangeHandle = BranchChangeHandle (MSampleVar ())
|
||||||
|
|
||||||
|
newBranchChangeHandle :: IO BranchChangeHandle
|
||||||
|
newBranchChangeHandle = BranchChangeHandle <$> newEmptySV
|
||||||
|
|
||||||
|
fromBranchChangeHandle :: BranchChangeHandle -> MSampleVar ()
|
||||||
|
fromBranchChangeHandle (BranchChangeHandle v) = v
|
Loading…
Reference in a new issue