Ensure directories

This commit is contained in:
Julian Ospald 2021-06-13 13:41:06 +02:00
parent ef0c94fddd
commit b56c44a210
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
5 changed files with 21 additions and 10 deletions

View File

@ -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)

View File

@ -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

View File

@ -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

View File

@ -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 ()

View File

@ -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