summaryrefslogtreecommitdiff
path: root/Config
diff options
context:
space:
mode:
authorJoey Hess <joeyh@joeyh.name>2017-08-17 12:26:14 -0400
committerJoey Hess <joeyh@joeyh.name>2017-08-17 13:54:14 -0400
commitd39c120afab776d19c91244ccaf056f15ee8e8fb (patch)
tree666b12ffa4466119049cce1e8b41a9e4176e0c04 /Config
parent86428f62617f10ec5132bd8c5dbde1e11d6f6494 (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.hs44
1 files changed, 44 insertions, 0 deletions
diff --git a/Config/DynamicConfig.hs b/Config/DynamicConfig.hs
new file mode 100644
index 0000000000..095c7c6411
--- /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