aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2017-08-17 14:04:29 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2017-08-17 14:04:29 -0400
commit4bdd8083ad7d77de41a2389aed87805eb354d358 (patch)
tree1a2f8e485859013c564773ff458fa223476bcc9b
parentecab35e095a97083285911809cc81d44a4384196 (diff)
use DynamicConfig to handle cost-command
This commit was sponsored by Jake Vosloo on Patreon.
-rw-r--r--Config.hs6
-rw-r--r--Config/DynamicConfig.hs7
-rw-r--r--Types/GitConfig.hs9
3 files changed, 12 insertions, 10 deletions
diff --git a/Config.hs b/Config.hs
index 3eecf4a4e..783f07238 100644
--- a/Config.hs
+++ b/Config.hs
@@ -15,6 +15,7 @@ import qualified Git.Config
import qualified Git.Command
import qualified Annex
import Config.Cost
+import Config.DynamicConfig
import Types.Availability
import Git.Types
@@ -70,10 +71,7 @@ remoteCost :: RemoteGitConfig -> Cost -> Annex Cost
remoteCost c d = fromMaybe d <$> remoteCost' c
remoteCost' :: RemoteGitConfig -> Annex (Maybe Cost)
-remoteCost' c = case remoteAnnexCostCommand c of
- Just cmd | not (null cmd) -> liftIO $
- readish <$> readProcess "sh" ["-c", cmd]
- _ -> return $ remoteAnnexCost c
+remoteCost' = liftIO . getDynamicConfig . remoteAnnexCost
setRemoteCost :: Git.Repo -> Cost -> Annex ()
setRemoteCost r c = setConfig (remoteConfig r "cost") (show c)
diff --git a/Config/DynamicConfig.hs b/Config/DynamicConfig.hs
index 095c7c641..de76e007b 100644
--- a/Config/DynamicConfig.hs
+++ b/Config/DynamicConfig.hs
@@ -7,9 +7,9 @@
module Config.DynamicConfig where
-import Control.Concurrent.STM
+import Common
-import Utility.SafeCommand
+import Control.Concurrent.STM
-- | 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
@@ -42,3 +42,6 @@ successfullCommandRunner cmd = boolSystem "sh" [Param "-c", Param cmd]
unsuccessfullCommandRunner :: CommandRunner Bool
unsuccessfullCommandRunner cmd = not <$> successfullCommandRunner cmd
+
+readCommandRunner :: Read a => CommandRunner (Maybe a)
+readCommandRunner cmd = readish <$> readProcess "sh" ["-c", cmd]
diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs
index 6eea51998..d523c745a 100644
--- a/Types/GitConfig.hs
+++ b/Types/GitConfig.hs
@@ -192,8 +192,7 @@ mergeGitConfig gitconfig repoglobals = gitconfig
- key such as <remote>.annex-foo, or if that is not set, a default from
- annex.foo -}
data RemoteGitConfig = RemoteGitConfig
- { remoteAnnexCost :: Maybe Cost
- , remoteAnnexCostCommand :: Maybe String
+ { remoteAnnexCost :: DynamicConfig (Maybe Cost)
, remoteAnnexIgnore :: DynamicConfig Bool
, remoteAnnexSync :: DynamicConfig Bool
, remoteAnnexPull :: Bool
@@ -231,6 +230,9 @@ data RemoteGitConfig = RemoteGitConfig
extractRemoteGitConfig :: Git.Repo -> String -> STM RemoteGitConfig
extractRemoteGitConfig r remotename = do
+ annexcost <- mkDynamicConfig readCommandRunner
+ (notempty $ getmaybe "cost-command")
+ (getmayberead "cost")
annexignore <- mkDynamicConfig unsuccessfullCommandRunner
(notempty $ getmaybe "ignore-command")
(getbool "ignore" False)
@@ -238,8 +240,7 @@ extractRemoteGitConfig r remotename = do
(notempty $ getmaybe "sync-command")
(getbool "sync" True)
return $ RemoteGitConfig
- { remoteAnnexCost = getmayberead "cost"
- , remoteAnnexCostCommand = notempty $ getmaybe "cost-command"
+ { remoteAnnexCost = annexcost
, remoteAnnexIgnore = annexignore
, remoteAnnexSync = annexsync
, remoteAnnexPull = getbool "pull" True