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 | ||||
|           dirs <- getDirs | ||||
| 
 | ||||
|           (settings, keybindings) <- toSettings opt | ||||
| 
 | ||||
|           -- create ~/.ghcup dir | ||||
|           createDirRecursive' (baseDir dirs) | ||||
|           ensureDirectories dirs | ||||
| 
 | ||||
|           (settings, keybindings) <- toSettings opt | ||||
| 
 | ||||
|           -- logger interpreter | ||||
|           logfile <- initGHCupFileLogging (logsDir dirs) | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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 () | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user