diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-08-17 12:26:14 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-08-17 13:54:14 -0400 |
commit | da0a1360d7b57d034620338996552752ab873045 (patch) | |
tree | 7cd5d994f15ae0d52e18321a129360b9e39a6d7d /Config | |
parent | 13ce429b5cbc3036e24613ce85e17af7acd9a480 (diff) |
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.
Diffstat (limited to 'Config')
-rw-r--r-- | Config/DynamicConfig.hs | 44 |
1 files changed, 44 insertions, 0 deletions
diff --git a/Config/DynamicConfig.hs b/Config/DynamicConfig.hs new file mode 100644 index 000000000..095c7c641 --- /dev/null +++ b/Config/DynamicConfig.hs @@ -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 |