use DynamicConfig to handle cost-command
This commit was sponsored by Jake Vosloo on Patreon.
This commit is contained in:
parent
68a0f99ba6
commit
61e96621d8
3 changed files with 12 additions and 10 deletions
|
@ -15,6 +15,7 @@ import qualified Git.Config
|
||||||
import qualified Git.Command
|
import qualified Git.Command
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import Config.Cost
|
import Config.Cost
|
||||||
|
import Config.DynamicConfig
|
||||||
import Types.Availability
|
import Types.Availability
|
||||||
import Git.Types
|
import Git.Types
|
||||||
|
|
||||||
|
@ -70,10 +71,7 @@ remoteCost :: RemoteGitConfig -> Cost -> Annex Cost
|
||||||
remoteCost c d = fromMaybe d <$> remoteCost' c
|
remoteCost c d = fromMaybe d <$> remoteCost' c
|
||||||
|
|
||||||
remoteCost' :: RemoteGitConfig -> Annex (Maybe Cost)
|
remoteCost' :: RemoteGitConfig -> Annex (Maybe Cost)
|
||||||
remoteCost' c = case remoteAnnexCostCommand c of
|
remoteCost' = liftIO . getDynamicConfig . remoteAnnexCost
|
||||||
Just cmd | not (null cmd) -> liftIO $
|
|
||||||
readish <$> readProcess "sh" ["-c", cmd]
|
|
||||||
_ -> return $ remoteAnnexCost c
|
|
||||||
|
|
||||||
setRemoteCost :: Git.Repo -> Cost -> Annex ()
|
setRemoteCost :: Git.Repo -> Cost -> Annex ()
|
||||||
setRemoteCost r c = setConfig (remoteConfig r "cost") (show c)
|
setRemoteCost r c = setConfig (remoteConfig r "cost") (show c)
|
||||||
|
|
|
@ -7,9 +7,9 @@
|
||||||
|
|
||||||
module Config.DynamicConfig where
|
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
|
-- | 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
|
-- 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 :: CommandRunner Bool
|
||||||
unsuccessfullCommandRunner cmd = not <$> successfullCommandRunner cmd
|
unsuccessfullCommandRunner cmd = not <$> successfullCommandRunner cmd
|
||||||
|
|
||||||
|
readCommandRunner :: Read a => CommandRunner (Maybe a)
|
||||||
|
readCommandRunner cmd = readish <$> readProcess "sh" ["-c", cmd]
|
||||||
|
|
|
@ -192,8 +192,7 @@ mergeGitConfig gitconfig repoglobals = gitconfig
|
||||||
- key such as <remote>.annex-foo, or if that is not set, a default from
|
- key such as <remote>.annex-foo, or if that is not set, a default from
|
||||||
- annex.foo -}
|
- annex.foo -}
|
||||||
data RemoteGitConfig = RemoteGitConfig
|
data RemoteGitConfig = RemoteGitConfig
|
||||||
{ remoteAnnexCost :: Maybe Cost
|
{ remoteAnnexCost :: DynamicConfig (Maybe Cost)
|
||||||
, remoteAnnexCostCommand :: Maybe String
|
|
||||||
, remoteAnnexIgnore :: DynamicConfig Bool
|
, remoteAnnexIgnore :: DynamicConfig Bool
|
||||||
, remoteAnnexSync :: DynamicConfig Bool
|
, remoteAnnexSync :: DynamicConfig Bool
|
||||||
, remoteAnnexPull :: Bool
|
, remoteAnnexPull :: Bool
|
||||||
|
@ -231,6 +230,9 @@ data RemoteGitConfig = RemoteGitConfig
|
||||||
|
|
||||||
extractRemoteGitConfig :: Git.Repo -> String -> STM RemoteGitConfig
|
extractRemoteGitConfig :: Git.Repo -> String -> STM RemoteGitConfig
|
||||||
extractRemoteGitConfig r remotename = do
|
extractRemoteGitConfig r remotename = do
|
||||||
|
annexcost <- mkDynamicConfig readCommandRunner
|
||||||
|
(notempty $ getmaybe "cost-command")
|
||||||
|
(getmayberead "cost")
|
||||||
annexignore <- mkDynamicConfig unsuccessfullCommandRunner
|
annexignore <- mkDynamicConfig unsuccessfullCommandRunner
|
||||||
(notempty $ getmaybe "ignore-command")
|
(notempty $ getmaybe "ignore-command")
|
||||||
(getbool "ignore" False)
|
(getbool "ignore" False)
|
||||||
|
@ -238,8 +240,7 @@ extractRemoteGitConfig r remotename = do
|
||||||
(notempty $ getmaybe "sync-command")
|
(notempty $ getmaybe "sync-command")
|
||||||
(getbool "sync" True)
|
(getbool "sync" True)
|
||||||
return $ RemoteGitConfig
|
return $ RemoteGitConfig
|
||||||
{ remoteAnnexCost = getmayberead "cost"
|
{ remoteAnnexCost = annexcost
|
||||||
, remoteAnnexCostCommand = notempty $ getmaybe "cost-command"
|
|
||||||
, remoteAnnexIgnore = annexignore
|
, remoteAnnexIgnore = annexignore
|
||||||
, remoteAnnexSync = annexsync
|
, remoteAnnexSync = annexsync
|
||||||
, remoteAnnexPull = getbool "pull" True
|
, remoteAnnexPull = getbool "pull" True
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue