From 190b5dedbaf83581375e0ac99297e95edf7b2906 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Sat, 30 Oct 2021 13:23:02 +0200 Subject: [PATCH] Allow to control the metadata cache, fixes #278 --- app/ghcup/BrickMain.hs | 12 +----------- app/ghcup/GHCup/OptParse.hs | 2 ++ app/ghcup/GHCup/OptParse/Common.hs | 4 ++-- app/ghcup/GHCup/OptParse/Config.hs | 3 ++- app/ghcup/GHCup/OptParse/DInfo.hs | 2 +- app/ghcup/Main.hs | 16 +++++++++------- data/config.yaml | 4 ++++ docs/guide.md | 19 +++++++++++++++++++ lib/GHCup/Download.hs | 10 +++++++--- lib/GHCup/Types.hs | 12 +++++++++++- lib/GHCup/Utils.hs | 2 +- test/GHCup/Types/JSONSpec.hs | 2 +- 12 files changed, 60 insertions(+), 28 deletions(-) diff --git a/app/ghcup/BrickMain.hs b/app/ghcup/BrickMain.hs index f20428e..15f4e4d 100644 --- a/app/ghcup/BrickMain.hs +++ b/app/ghcup/BrickMain.hs @@ -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) diff --git a/app/ghcup/GHCup/OptParse.hs b/app/ghcup/GHCup/OptParse.hs index 1d01312..1dc74e5 100644 --- a/app/ghcup/GHCup/OptParse.hs +++ b/app/ghcup/GHCup/OptParse.hs @@ -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) diff --git a/app/ghcup/GHCup/OptParse/Common.hs b/app/ghcup/GHCup/OptParse/Common.hs index 64dcdd9..896f82f 100644 --- a/app/ghcup/GHCup/OptParse/Common.hs +++ b/app/ghcup/GHCup/OptParse/Common.hs @@ -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' diff --git a/app/ghcup/GHCup/OptParse/Config.hs b/app/ghcup/GHCup/OptParse/Config.hs index d2ff786..13014ef 100644 --- a/app/ghcup/GHCup/OptParse/Config.hs +++ b/app/ghcup/GHCup/OptParse/Config.hs @@ -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 diff --git a/app/ghcup/GHCup/OptParse/DInfo.hs b/app/ghcup/GHCup/OptParse/DInfo.hs index 281f33a..46c3d3d 100644 --- a/app/ghcup/GHCup/OptParse/DInfo.hs +++ b/app/ghcup/GHCup/OptParse/DInfo.hs @@ -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 diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 38bed06..d550316 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -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 diff --git a/data/config.yaml b/data/config.yaml index dbed446..3cca0ec 100644 --- a/data/config.yaml +++ b/data/config.yaml @@ -36,6 +36,10 @@ key-bindings: show-all-tools: KChar: 't' +# The caching for the metadata files containing download info, depending on last access time +# of the file. These usually are in '~/.ghcup/cache/ghcup-.yaml'. +meta-cache: 300 # in seconds + # Where to get GHC/cabal/hls download info/versions from. For more detailed explanation # check the 'URLSource' type in the code. url-source: diff --git a/docs/guide.md b/docs/guide.md index 2d4e748..629c4ba 100644 --- a/docs/guide.md +++ b/docs/guide.md @@ -53,6 +53,25 @@ as e.g. `/etc/bash_completion.d/ghcup` (depending on distro) and make sure your bashrc sources the startup script (`/usr/share/bash-completion/bash_completion` on some distros). +## Caching + +GHCup has a few caching mechanisms to avoid redownloads. All cached files end up in `~/.ghcup/cache` by default. + +### Downloads cache + +Downloaded tarballs (such as GHC, cabal, etc.) are not cached by default unless you pass `ghcup --cache` or set caching +in your [config](#configuration) via `ghcup config set cache true`. + +### Metadata cache + +The metadata files (also see [github.com/haskell/ghcup-metadata](https://github.com/haskell/ghcup-metadata)) +have a 5 minutes cache per default depending on the last access time of the file. That means if you run +`ghcup list` 10 times in a row, only the first time will trigger a download attempt. + +### Clearing the cache + +If you experience problems, consider clearing the cache via `ghcup gc --cache`. + ## Compiling GHC from source Compiling from source is supported for both source tarballs and arbitrary git refs. See `ghcup compile ghc --help` diff --git a/lib/GHCup/Download.hs b/lib/GHCup/Download.hs index 47fba0f..acb6e4d 100644 --- a/lib/GHCup/Download.hs +++ b/lib/GHCup/Download.hs @@ -242,14 +242,18 @@ getBase uri = do e <- liftIO $ doesFileExist json_file currentTime <- liftIO getCurrentTime Dirs { cacheDir } <- lift getDirs + Settings { metaCache } <- lift getSettings -- for local files, let's short-circuit and ignore access time if | scheme == "file" -> liftE $ download uri' Nothing Nothing cacheDir Nothing True | e -> do - accessTime <- liftIO $ getAccessTime json_file - + accessTime <- fmap utcTimeToPOSIXSeconds $ liftIO $ getAccessTime json_file + let sinceLastAccess = utcTimeToPOSIXSeconds currentTime - accessTime + let cacheInterval = fromInteger metaCache + lift $ logDebug $ "last access was " <> T.pack (show sinceLastAccess) <> " ago, cache interval is " <> T.pack (show cacheInterval) -- access time won't work on most linuxes, but we can try regardless - if | ((utcTimeToPOSIXSeconds currentTime - utcTimeToPOSIXSeconds accessTime) > 300) -> + if | metaCache <= 0 -> dlWithMod currentTime json_file + | (sinceLastAccess > cacheInterval) -> -- no access in last 5 minutes, re-check upstream mod time dlWithMod currentTime json_file | otherwise -> pure json_file diff --git a/lib/GHCup/Types.hs b/lib/GHCup/Types.hs index e4c3a7c..d4fb570 100644 --- a/lib/GHCup/Types.hs +++ b/lib/GHCup/Types.hs @@ -294,6 +294,7 @@ instance NFData (URIRef Absolute) where data UserSettings = UserSettings { uCache :: Maybe Bool + , uMetaCache :: Maybe Integer , uNoVerify :: Maybe Bool , uVerbose :: Maybe Bool , uKeepDirs :: Maybe KeepDirs @@ -306,12 +307,13 @@ data UserSettings = UserSettings deriving (Show, GHC.Generic) defaultUserSettings :: UserSettings -defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing +defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing fromSettings :: Settings -> Maybe KeyBindings -> UserSettings fromSettings Settings{..} Nothing = UserSettings { uCache = Just cache + , uMetaCache = Just metaCache , uNoVerify = Just noVerify , uVerbose = Just verbose , uKeepDirs = Just keepDirs @@ -335,6 +337,7 @@ fromSettings Settings{..} (Just KeyBindings{..}) = } in UserSettings { uCache = Just cache + , uMetaCache = Just metaCache , uNoVerify = Just noVerify , uVerbose = Just verbose , uKeepDirs = Just keepDirs @@ -410,6 +413,7 @@ instance NFData LeanAppState data Settings = Settings { cache :: Bool + , metaCache :: Integer , noVerify :: Bool , keepDirs :: KeepDirs , downloader :: Downloader @@ -421,6 +425,12 @@ data Settings = Settings } deriving (Show, GHC.Generic) +defaultMetaCache :: Integer +defaultMetaCache = 300 -- 5 minutes + +defaultSettings :: Settings +defaultSettings = Settings False defaultMetaCache False Never Curl False GHCupURL False GPGNone False + instance NFData Settings data Dirs = Dirs diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs index a07229b..4a09ae5 100644 --- a/lib/GHCup/Utils.hs +++ b/lib/GHCup/Utils.hs @@ -111,7 +111,7 @@ import qualified Data.List.NonEmpty as NE -- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False } -- >>> dirs' <- getAllDirs -- >>> let installedVersions = [ ([pver|8.10.7|], Nothing), ([pver|8.10.4|], Nothing), ([pver|8.8.4|], Nothing), ([pver|8.8.3|], Nothing) ] --- >>> let settings = Settings True False Never Curl False GHCupURL True GPGNone False +-- >>> let settings = Settings True 0 False Never Curl False GHCupURL True GPGNone False -- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc -- >>> cwd <- getCurrentDirectory -- >>> (Right ref) <- pure $ parseURI strictURIParserOptions $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL) diff --git a/test/GHCup/Types/JSONSpec.hs b/test/GHCup/Types/JSONSpec.hs index 951bfc0..9753bc9 100644 --- a/test/GHCup/Types/JSONSpec.hs +++ b/test/GHCup/Types/JSONSpec.hs @@ -3,7 +3,7 @@ module GHCup.Types.JSONSpec where import GHCup.ArbitraryTypes () -import GHCup.Types +import GHCup.Types hiding ( defaultSettings ) import GHCup.Types.JSON () import Test.Aeson.GenericSpecs