diff options
Diffstat (limited to 'Annex')
| -rw-r--r-- | Annex/BranchState.hs | 6 | ||||
| -rw-r--r-- | Annex/CheckAttr.hs | 10 | ||||
| -rw-r--r-- | Annex/CheckIgnore.hs | 11 | ||||
| -rw-r--r-- | Annex/Concurrent.hs | 65 | ||||
| -rw-r--r-- | Annex/Drop.hs | 2 |
5 files changed, 87 insertions, 7 deletions
diff --git a/Annex/BranchState.hs b/Annex/BranchState.hs index 889a936b9..2885582cd 100644 --- a/Annex/BranchState.hs +++ b/Annex/BranchState.hs @@ -16,11 +16,9 @@ import qualified Annex getState :: Annex BranchState getState = Annex.getState Annex.branchstate -setState :: BranchState -> Annex () -setState state = Annex.changeState $ \s -> s { Annex.branchstate = state } - changeState :: (BranchState -> BranchState) -> Annex () -changeState changer = setState =<< changer <$> getState +changeState changer = Annex.changeState $ \s -> + s { Annex.branchstate = changer (Annex.branchstate s) } {- Runs an action to check that the index file exists, if it's not been - checked before in this run of git-annex. -} diff --git a/Annex/CheckAttr.hs b/Annex/CheckAttr.hs index 46c71fe72..bbe979b3e 100644 --- a/Annex/CheckAttr.hs +++ b/Annex/CheckAttr.hs @@ -7,7 +7,8 @@ module Annex.CheckAttr ( checkAttr, - checkAttrHandle + checkAttrHandle, + checkAttrStop, ) where import Common.Annex @@ -33,3 +34,10 @@ checkAttrHandle = maybe startup return =<< Annex.getState Annex.checkattrhandle h <- inRepo $ Git.checkAttrStart annexAttrs Annex.changeState $ \s -> s { Annex.checkattrhandle = Just h } return h + +checkAttrStop :: Annex () +checkAttrStop = maybe noop stop =<< Annex.getState Annex.checkattrhandle + where + stop h = do + liftIO $ Git.checkAttrStop h + Annex.changeState $ \s -> s { Annex.checkattrhandle = Nothing } diff --git a/Annex/CheckIgnore.hs b/Annex/CheckIgnore.hs index 8d7df1e2c..86b46f7c2 100644 --- a/Annex/CheckIgnore.hs +++ b/Annex/CheckIgnore.hs @@ -8,7 +8,8 @@ module Annex.CheckIgnore ( checkIgnored, - checkIgnoreHandle + checkIgnoreHandle, + checkIgnoreStop ) where import Common.Annex @@ -30,3 +31,11 @@ checkIgnoreHandle = maybe startup return =<< Annex.getState Annex.checkignorehan warning "The installed version of git is too old for .gitignores to be honored by git-annex." Annex.changeState $ \s -> s { Annex.checkignorehandle = Just v } return v + +checkIgnoreStop :: Annex () +checkIgnoreStop = maybe noop stop =<< Annex.getState Annex.checkignorehandle + where + stop (Just h) = do + liftIO $ Git.checkIgnoreStop h + Annex.changeState $ \s -> s { Annex.checkignorehandle = Nothing } + stop Nothing = noop diff --git a/Annex/Concurrent.hs b/Annex/Concurrent.hs new file mode 100644 index 000000000..d3585e04f --- /dev/null +++ b/Annex/Concurrent.hs @@ -0,0 +1,65 @@ +{- git-annex concurrent state + - + - Copyright 2015 Joey Hess <id@joeyh.name> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Annex.Concurrent where + +import Common.Annex +import Annex +import Annex.CatFile +import Annex.CheckAttr +import Annex.CheckIgnore + +import qualified Data.Map as M + +{- Allows forking off a thread that uses a copy of the current AnnexState + - to run an Annex action. + - + - The returned IO action can be used to start the thread. + - It returns an Annex action that must be run in the original + - calling context to merge the forked AnnexState back into the + - current AnnexState. + -} +forkState :: Annex a -> Annex (IO (Annex a)) +forkState a = do + st <- dupState + return $ do + (ret, newst) <- run st a + return $ do + mergeState newst + return ret + +{- Returns a copy of the current AnnexState that is safe to be + - used when forking off a thread. + - + - After an Annex action is run using this AnnexState, it + - should be merged back into the current Annex's state, + - by calling mergeState. + -} +dupState :: Annex AnnexState +dupState = do + st <- Annex.getState id + -- avoid sharing eg, open file handles + return $ st + { Annex.workers = [] + , Annex.catfilehandles = M.empty + , Annex.checkattrhandle = Nothing + , Annex.checkignorehandle = Nothing + } + +{- Merges the passed AnnexState into the current Annex state. + - Also shuts closes various handles in it. -} +mergeState :: AnnexState -> Annex () +mergeState st = do + st' <- liftIO $ snd <$> run st closehandles + forM_ (M.toList $ Annex.cleanup st') $ + uncurry addCleanup + changeState $ \s -> s { errcounter = errcounter s + errcounter st' } + where + closehandles = do + catFileStop + checkAttrStop + checkIgnoreStop diff --git a/Annex/Drop.hs b/Annex/Drop.hs index a99a1edff..973e51348 100644 --- a/Annex/Drop.hs +++ b/Annex/Drop.hs @@ -42,7 +42,7 @@ type Reason = String - The runner is used to run commands, and so can be either callCommand - or commandAction. -} -handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> Maybe Remote -> CommandActionRunner -> Annex () +handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> Maybe Remote -> (CommandStart -> CommandCleanup) -> Annex () handleDropsFrom locs rs reason fromhere key afile knownpresentremote runner = do fs <- ifM isDirect ( do |