diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-08-17 14:04:29 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-08-17 14:04:29 -0400 |
commit | 4bdd8083ad7d77de41a2389aed87805eb354d358 (patch) | |
tree | 1a2f8e485859013c564773ff458fa223476bcc9b | |
parent | ecab35e095a97083285911809cc81d44a4384196 (diff) |
use DynamicConfig to handle cost-command
This commit was sponsored by Jake Vosloo on Patreon.
-rw-r--r-- | Config.hs | 6 | ||||
-rw-r--r-- | Config/DynamicConfig.hs | 7 | ||||
-rw-r--r-- | Types/GitConfig.hs | 9 |
3 files changed, 12 insertions, 10 deletions
@@ -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 |