add annex-ignore-command and annex-sync-command configs

Added remote configuration settings annex-ignore-command and
annex-sync-command, which are dynamic equivilants of the annex-ignore
and annex-sync configurations.

For this I needed a new DynamicConfig infrastructure. Its implementation
should be as fast as before when there is no dynamic config, and it caches
so shell commands are only run once.

Note that annex-ignore-command exits nonzero when the remote should be ignored.
While that may seem backwards, it allows using the same command for it as
for annex-sync-command when you want to disable both.

This commit was sponsored by Trenton Cronholm on Patreon.
This commit is contained in:
Joey Hess 2017-08-17 12:26:14 -04:00
parent 86428f6261
commit d39c120afa
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
21 changed files with 201 additions and 92 deletions

44
Config/DynamicConfig.hs Normal file
View file

@ -0,0 +1,44 @@
{- dynamic configuration
-
- Copyright 2017 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Config.DynamicConfig where
import Control.Concurrent.STM
import Utility.SafeCommand
-- | A configuration value that may only be known after performing an IO
-- action. The IO action will only be run the first time the configuration
-- is accessed; its result is then cached.
data DynamicConfig a = DynamicConfig (IO a, TMVar a) | StaticConfig a
mkDynamicConfig :: CommandRunner a -> Maybe String -> a -> STM (DynamicConfig a)
mkDynamicConfig _ Nothing static = return $ StaticConfig static
mkDynamicConfig cmdrunner (Just cmd) _ = do
tmvar <- newEmptyTMVar
return $ DynamicConfig (cmdrunner cmd, tmvar)
getDynamicConfig :: DynamicConfig a -> IO a
getDynamicConfig (StaticConfig v) = return v
getDynamicConfig (DynamicConfig (a, tmvar)) =
go =<< atomically (tryReadTMVar tmvar)
where
go Nothing = do
v <- a
atomically $ do
_ <- tryTakeTMVar tmvar
putTMVar tmvar v
return v
go (Just v) = return v
type CommandRunner a = String -> IO a
successfullCommandRunner :: CommandRunner Bool
successfullCommandRunner cmd = boolSystem "sh" [Param "-c", Param cmd]
unsuccessfullCommandRunner :: CommandRunner Bool
unsuccessfullCommandRunner cmd = not <$> successfullCommandRunner cmd