memoize parsing of annex.direct config setting

It occurs to me that all config settings should be parsed once at startup,
into a proper ADT, rather than all this ad-hoc parsing and memoization. One
day..
This commit is contained in:
Joey Hess 2012-12-29 13:37:11 -04:00
parent 3d57f0d356
commit 9f2150c7d3
2 changed files with 13 additions and 4 deletions

View file

@ -104,6 +104,7 @@ data AnnexState = AnnexState
, uuidmap :: Maybe UUIDMap , uuidmap :: Maybe UUIDMap
, preferredcontentmap :: Maybe PreferredContentMap , preferredcontentmap :: Maybe PreferredContentMap
, shared :: Maybe SharedRepository , shared :: Maybe SharedRepository
, direct :: Maybe Bool
, forcetrust :: TrustMap , forcetrust :: TrustMap
, trustmap :: Maybe TrustMap , trustmap :: Maybe TrustMap
, groupmap :: Maybe GroupMap , groupmap :: Maybe GroupMap
@ -133,6 +134,7 @@ newState gitrepo = AnnexState
, uuidmap = Nothing , uuidmap = Nothing
, preferredcontentmap = Nothing , preferredcontentmap = Nothing
, shared = Nothing , shared = Nothing
, direct = Nothing
, forcetrust = M.empty , forcetrust = M.empty
, trustmap = Nothing , trustmap = Nothing
, groupmap = Nothing , groupmap = Nothing

View file

@ -116,13 +116,20 @@ getDiskReserve = fromMaybe megabyte . readSize dataUnits
where where
megabyte = 1000000 megabyte = 1000000
{- Gets annex.direct setting. -} {- Gets annex.direct setting, cached for speed. -}
isDirect :: Annex Bool isDirect :: Annex Bool
isDirect = fromMaybe False . Git.Config.isTrue <$> isDirect = maybe fromconfig return =<< Annex.getState Annex.direct
where
fromconfig = do
direct <- fromMaybe False . Git.Config.isTrue <$>
getConfig (annexConfig "direct") "" getConfig (annexConfig "direct") ""
Annex.changeState $ \s -> s { Annex.direct = Just direct }
return direct
setDirect :: Bool -> Annex () setDirect :: Bool -> Annex ()
setDirect b = setConfig (annexConfig "direct") (if b then "true" else "false") setDirect b = do
setConfig (annexConfig "direct") (if b then "true" else "false")
Annex.changeState $ \s -> s { Annex.direct = Just b }
{- Gets annex.httpheaders or annex.httpheaders-command setting, {- Gets annex.httpheaders or annex.httpheaders-command setting,
- splitting it into lines. -} - splitting it into lines. -}