hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Allow to control the metadata cache, fixes #278

Browse Source
This commit is contained in:
Julian Ospald
2021-10-30 13:23:02 +02:00
parent 7bb67dd4c6
commit 190b5dedba
12 changed files with 60 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
app/ghcup/BrickMain.hs
View File

@@ -536,17 +536,7 @@ settings' = unsafePerformIO $ do
, fileOutter = \_ -> pure ()
, fancyColors = True
}
newIORef $ AppState (Settings { cache = True
, noVerify = False
, keepDirs = Never
, downloader = Curl
, verbose = False
, urlSource = GHCupURL
, noNetwork = False
, gpgSetting = GPGNone
, noColor = False
, ..
})
newIORef $ AppState defaultSettings
dirs
defaultKeyBindings
(GHCupInfo mempty mempty mempty)

2
app/ghcup/GHCup/OptParse.hs
View File

@@ -67,6 +67,7 @@ data Options = Options
-- global options
optVerbose :: Maybe Bool
, optCache :: Maybe Bool
, optMetaCache :: Maybe Integer
, optUrlSource :: Maybe URI
, optNoVerify :: Maybe Bool
, optKeepDirs :: Maybe KeepDirs
@@ -105,6 +106,7 @@ opts =
Options
<$> invertableSwitch "verbose" 'v' False (help "Enable verbosity (default: disabled)")
<*> invertableSwitch "cache" 'c' False (help "Cache downloads in ~/.ghcup/cache (default: disabled)")
<*> optional (option auto (long "metadata-caching" <> help "How long the yaml metadata caching interval is (in seconds), 0 to disable" <> internal))
<*> optional
(option
(eitherReader parseUri)

4
app/ghcup/GHCup/OptParse/Common.hs
View File

@@ -299,7 +299,7 @@ tagCompleter tool add = listIOCompleter $ do
, fancyColors = False
}
let appState = LeanAppState
(Settings True False Never Curl False GHCupURL True GPGNone False)
(defaultSettings { noNetwork = True })
dirs'
defaultKeyBindings
loggerConfig
@@ -322,7 +322,7 @@ versionCompleter criteria tool = listIOCompleter $ do
, fileOutter = mempty
, fancyColors = False
}
let settings = Settings True False Never Curl False GHCupURL True GPGNone False
let settings = defaultSettings { noNetwork = True }
let leanAppState = LeanAppState
settings
dirs'

3
app/ghcup/GHCup/OptParse/Config.hs
View File

@@ -122,6 +122,7 @@ updateSettings config' settings = do
mergeConf :: UserSettings -> Settings -> Settings
mergeConf UserSettings{..} Settings{..} =
let cache' = fromMaybe cache uCache
metaCache' = fromMaybe metaCache uMetaCache
noVerify' = fromMaybe noVerify uNoVerify
keepDirs' = fromMaybe keepDirs uKeepDirs
downloader' = fromMaybe downloader uDownloader
@@ -129,7 +130,7 @@ updateSettings config' settings = do
urlSource' = fromMaybe urlSource uUrlSource
noNetwork' = fromMaybe noNetwork uNoNetwork
gpgSetting' = fromMaybe gpgSetting uGPGSetting
in Settings cache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor
in Settings cache' metaCache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor

2
app/ghcup/GHCup/OptParse/DInfo.hs
View File

@@ -51,7 +51,7 @@ describe_result = $( LitE . StringL <$>
runIO (do
CapturedProcess{..} <- do
dirs <- liftIO getAllDirs
let settings = AppState (Settings True False Never Curl False GHCupURL False GPGNone False)
let settings = AppState (defaultSettings { noNetwork = True })
dirs
defaultKeyBindings
flip runReaderT settings $ executeOut "git" ["describe"] Nothing

16
app/ghcup/Main.hs
View File

@@ -55,6 +55,7 @@ import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as E
import qualified GHCup.Types as Types
@@ -72,15 +73,16 @@ toSettings options = do
where
mergeConf :: Options -> UserSettings -> Bool -> (Settings, KeyBindings)
mergeConf Options{..} UserSettings{..} noColor =
let cache = fromMaybe (fromMaybe False uCache) optCache
noVerify = fromMaybe (fromMaybe False uNoVerify) optNoVerify
verbose = fromMaybe (fromMaybe False uVerbose) optVerbose
keepDirs = fromMaybe (fromMaybe Errors uKeepDirs) optKeepDirs
let cache = fromMaybe (fromMaybe (Types.cache defaultSettings) uCache) optCache
metaCache = fromMaybe (fromMaybe (Types.metaCache defaultSettings) uMetaCache) optMetaCache
noVerify = fromMaybe (fromMaybe (Types.noVerify defaultSettings) uNoVerify) optNoVerify
verbose = fromMaybe (fromMaybe (Types.verbose defaultSettings) uVerbose) optVerbose
keepDirs = fromMaybe (fromMaybe (Types.keepDirs defaultSettings) uKeepDirs) optKeepDirs
downloader = fromMaybe (fromMaybe defaultDownloader uDownloader) optsDownloader
keyBindings = maybe defaultKeyBindings mergeKeys uKeyBindings
urlSource = maybe (fromMaybe GHCupURL uUrlSource) OwnSource optUrlSource
noNetwork = fromMaybe (fromMaybe False uNoNetwork) optNoNetwork
gpgSetting = fromMaybe (fromMaybe GPGNone uGPGSetting) optGpg
urlSource = maybe (fromMaybe (Types.urlSource defaultSettings) uUrlSource) OwnSource optUrlSource
noNetwork = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
gpgSetting = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
in (Settings {..}, keyBindings)
#if defined(INTERNAL_DOWNLOADER)
defaultDownloader = Internal