diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 4bce381acadccc865237ed3ba79147a327e829a8..cc0327a9f2f0373bfbbfc10d5fb6a08620581881 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -1095,10 +1095,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|] >>= \opt@Options {..} -> do dirs <- getDirs - (settings, keybindings) <- toSettings opt - -- create ~/.ghcup dir - createDirRecursive' (baseDir dirs) + ensureDirectories dirs + + (settings, keybindings) <- toSettings opt -- logger interpreter logfile <- initGHCupFileLogging (logsDir dirs) diff --git a/lib/GHCup.hs b/lib/GHCup.hs index a301d945a52ccf7addbf9c4f7cc753e8e215c633..2c51c6df1e99c1b28702b31be2ae285e69fdac1b 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -661,7 +661,6 @@ setGHC ver sghc = do -- symlink destination AppState { dirs = Dirs {..} } <- lift ask - liftIO $ createDirRecursive' binDir -- first delete the old symlinks (this fixes compatibility issues -- with old ghcup) @@ -744,7 +743,6 @@ setCabal ver = do -- symlink destination AppState {dirs = Dirs {..}} <- lift ask - liftIO $ createDirRecursive' binDir whenM (liftIO $ not <$> doesFileExist (binDir </> targetFile)) $ throwE @@ -775,7 +773,6 @@ setHLS :: ( MonadCatch m -> Excepts '[NotInstalled] m () setHLS ver = do AppState { dirs = Dirs {..} } <- lift ask - liftIO $ createDirRecursive' binDir -- Delete old symlinks, since these might have different ghc versions than the -- selected version, so we could end up with stray or incorrect symlinks. @@ -818,7 +815,6 @@ setStack ver = do -- symlink destination AppState {dirs = Dirs {..}} <- lift ask - liftIO $ createDirRecursive' binDir whenM (liftIO $ not <$> doesFileExist (binDir </> targetFile)) $ throwE diff --git a/lib/GHCup/Download.hs b/lib/GHCup/Download.hs index 305f258e4156bb2ad92822725bbd698db11f5fb2..76a5d300ca95d2dc2071d095de4e6fd08d5a58f8 100644 --- a/lib/GHCup/Download.hs +++ b/lib/GHCup/Download.hs @@ -227,7 +227,6 @@ getBase dirs@Dirs{..} Settings{ downloader } = else -- access in less than 5 minutes, re-use file liftIO $ L.readFile json_file else do - liftIO $ createDirRecursive' cacheDir getModTime >>= \case Just modTime -> dlWithMod modTime json_file Nothing -> do diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs index b3bd570fe26bc300a90a90829c30db13e3a4777d..c95818a691e12002af24721cf64e1ab36e3b211b 100644 --- a/lib/GHCup/Utils.hs +++ b/lib/GHCup/Utils.hs @@ -1075,3 +1075,21 @@ ensureGlobalTools = do #else pure () #endif + + +-- | Ensure ghcup directory structure exists. +ensureDirectories :: Dirs -> IO () +ensureDirectories dirs = do + let Dirs + { baseDir + , binDir + , cacheDir + , logsDir + , confDir + } = dirs + createDirRecursive' baseDir + createDirRecursive' binDir + createDirRecursive' cacheDir + createDirRecursive' logsDir + createDirRecursive' confDir + pure () diff --git a/lib/GHCup/Utils/Logger.hs b/lib/GHCup/Utils/Logger.hs index 7c91f3a445da999869d5fb78b2e646e3781a3b9a..cbeb6c54981f932185f0292d2f62e6d2de37671e 100644 --- a/lib/GHCup/Utils/Logger.hs +++ b/lib/GHCup/Utils/Logger.hs @@ -22,7 +22,6 @@ import Control.Monad.IO.Class import Control.Monad.Logger import Prelude hiding ( appendFile ) import System.Console.Pretty -import System.Directory hiding ( findFiles ) import System.FilePath import System.IO.Error import Text.Regex.Posix @@ -70,7 +69,6 @@ initGHCupFileLogging :: (MonadIO m) => FilePath -> m FilePath initGHCupFileLogging logsDir = do let logfile = logsDir </> "ghcup.log" liftIO $ do - createDirectoryIfMissing True logsDir logFiles <- findFiles logsDir (makeRegexOpts compExtended