Ensure directories
This commit is contained in:
parent
ef0c94fddd
commit
b56c44a210
@ -1095,10 +1095,10 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
|
|||||||
>>= \opt@Options {..} -> do
|
>>= \opt@Options {..} -> do
|
||||||
dirs <- getDirs
|
dirs <- getDirs
|
||||||
|
|
||||||
(settings, keybindings) <- toSettings opt
|
|
||||||
|
|
||||||
-- create ~/.ghcup dir
|
-- create ~/.ghcup dir
|
||||||
createDirRecursive' (baseDir dirs)
|
ensureDirectories dirs
|
||||||
|
|
||||||
|
(settings, keybindings) <- toSettings opt
|
||||||
|
|
||||||
-- logger interpreter
|
-- logger interpreter
|
||||||
logfile <- initGHCupFileLogging (logsDir dirs)
|
logfile <- initGHCupFileLogging (logsDir dirs)
|
||||||
|
@ -661,7 +661,6 @@ setGHC ver sghc = do
|
|||||||
|
|
||||||
-- symlink destination
|
-- symlink destination
|
||||||
AppState { dirs = Dirs {..} } <- lift ask
|
AppState { dirs = Dirs {..} } <- lift ask
|
||||||
liftIO $ createDirRecursive' binDir
|
|
||||||
|
|
||||||
-- first delete the old symlinks (this fixes compatibility issues
|
-- first delete the old symlinks (this fixes compatibility issues
|
||||||
-- with old ghcup)
|
-- with old ghcup)
|
||||||
@ -744,7 +743,6 @@ setCabal ver = do
|
|||||||
|
|
||||||
-- symlink destination
|
-- symlink destination
|
||||||
AppState {dirs = Dirs {..}} <- lift ask
|
AppState {dirs = Dirs {..}} <- lift ask
|
||||||
liftIO $ createDirRecursive' binDir
|
|
||||||
|
|
||||||
whenM (liftIO $ not <$> doesFileExist (binDir </> targetFile))
|
whenM (liftIO $ not <$> doesFileExist (binDir </> targetFile))
|
||||||
$ throwE
|
$ throwE
|
||||||
@ -775,7 +773,6 @@ setHLS :: ( MonadCatch m
|
|||||||
-> Excepts '[NotInstalled] m ()
|
-> Excepts '[NotInstalled] m ()
|
||||||
setHLS ver = do
|
setHLS ver = do
|
||||||
AppState { dirs = Dirs {..} } <- lift ask
|
AppState { dirs = Dirs {..} } <- lift ask
|
||||||
liftIO $ createDirRecursive' binDir
|
|
||||||
|
|
||||||
-- Delete old symlinks, since these might have different ghc versions than the
|
-- Delete old symlinks, since these might have different ghc versions than the
|
||||||
-- selected version, so we could end up with stray or incorrect symlinks.
|
-- selected version, so we could end up with stray or incorrect symlinks.
|
||||||
@ -818,7 +815,6 @@ setStack ver = do
|
|||||||
|
|
||||||
-- symlink destination
|
-- symlink destination
|
||||||
AppState {dirs = Dirs {..}} <- lift ask
|
AppState {dirs = Dirs {..}} <- lift ask
|
||||||
liftIO $ createDirRecursive' binDir
|
|
||||||
|
|
||||||
whenM (liftIO $ not <$> doesFileExist (binDir </> targetFile))
|
whenM (liftIO $ not <$> doesFileExist (binDir </> targetFile))
|
||||||
$ throwE
|
$ throwE
|
||||||
|
@ -227,7 +227,6 @@ getBase dirs@Dirs{..} Settings{ downloader } =
|
|||||||
else -- access in less than 5 minutes, re-use file
|
else -- access in less than 5 minutes, re-use file
|
||||||
liftIO $ L.readFile json_file
|
liftIO $ L.readFile json_file
|
||||||
else do
|
else do
|
||||||
liftIO $ createDirRecursive' cacheDir
|
|
||||||
getModTime >>= \case
|
getModTime >>= \case
|
||||||
Just modTime -> dlWithMod modTime json_file
|
Just modTime -> dlWithMod modTime json_file
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
|
@ -1075,3 +1075,21 @@ ensureGlobalTools = do
|
|||||||
#else
|
#else
|
||||||
pure ()
|
pure ()
|
||||||
#endif
|
#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 ()
|
||||||
|
@ -22,7 +22,6 @@ import Control.Monad.IO.Class
|
|||||||
import Control.Monad.Logger
|
import Control.Monad.Logger
|
||||||
import Prelude hiding ( appendFile )
|
import Prelude hiding ( appendFile )
|
||||||
import System.Console.Pretty
|
import System.Console.Pretty
|
||||||
import System.Directory hiding ( findFiles )
|
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
import System.IO.Error
|
import System.IO.Error
|
||||||
import Text.Regex.Posix
|
import Text.Regex.Posix
|
||||||
@ -70,7 +69,6 @@ initGHCupFileLogging :: (MonadIO m) => FilePath -> m FilePath
|
|||||||
initGHCupFileLogging logsDir = do
|
initGHCupFileLogging logsDir = do
|
||||||
let logfile = logsDir </> "ghcup.log"
|
let logfile = logsDir </> "ghcup.log"
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
createDirectoryIfMissing True logsDir
|
|
||||||
logFiles <- findFiles
|
logFiles <- findFiles
|
||||||
logsDir
|
logsDir
|
||||||
(makeRegexOpts compExtended
|
(makeRegexOpts compExtended
|
||||||
|
Loading…
Reference in New Issue
Block a user