{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} module GHC.Toolchain.Utils ( expectJust , expectFileExists , withTempDir , oneOf , isSuccess ) where import Control.Exception import Control.Monad import Control.Monad.IO.Class import System.Directory import System.FilePath import System.IO.Error import System.Exit import GHC.Toolchain.Prelude createTempDirectory :: IO FilePath createTempDirectory :: IO FilePath createTempDirectory = do root <- IO FilePath getTemporaryDirectory go root 0 where go :: FilePath -> Int -> IO FilePath go :: FilePath -> Int -> IO FilePath go FilePath root Int n = do let path :: FilePath path = FilePath root FilePath -> FilePath -> FilePath </> FilePath "tmp"FilePath -> FilePath -> FilePath forall a. [a] -> [a] -> [a] ++Int -> FilePath forall a. Show a => a -> FilePath show Int n res <- IO () -> IO (Either IOError ()) forall e a. Exception e => IO a -> IO (Either e a) try (IO () -> IO (Either IOError ())) -> IO () -> IO (Either IOError ()) forall a b. (a -> b) -> a -> b $ FilePath -> IO () createDirectory FilePath path case res of Right () -> FilePath -> IO FilePath forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return FilePath path Left IOError err | IOError -> Bool isAlreadyExistsError IOError err -> FilePath -> Int -> IO FilePath go FilePath root (Int nInt -> Int -> Int forall a. Num a => a -> a -> a +Int 1) | Bool otherwise -> IOError -> IO FilePath forall e a. (HasCallStack, Exception e) => e -> IO a throwIO IOError err withTempDir :: (FilePath -> M a) -> M a withTempDir :: forall a. (FilePath -> M a) -> M a withTempDir FilePath -> M a f = do env <- M Env getEnv let close FilePath dir | Env -> Bool keepTemp Env env = () -> IO () forall a. a -> IO a forall (m :: * -> *) a. Monad m => a -> m a return () | Bool otherwise = FilePath -> IO () removeDirectoryRecursive FilePath dir makeM (bracket createTempDirectory close (runM env . f)) expectJust :: String -> Maybe a -> M a expectJust :: forall a. FilePath -> Maybe a -> M a expectJust FilePath err Maybe a Nothing = FilePath -> M a forall a. FilePath -> M a throwE FilePath err expectJust FilePath _ (Just a x) = a -> M a forall a. a -> M a forall (m :: * -> *) a. Monad m => a -> m a return a x expectFileExists :: FilePath -> String -> M () expectFileExists :: FilePath -> FilePath -> M () expectFileExists FilePath path FilePath err = do exists <- IO Bool -> M Bool forall a. IO a -> M a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO Bool -> M Bool) -> IO Bool -> M Bool forall a b. (a -> b) -> a -> b $ FilePath -> IO Bool doesFileExist FilePath path unless exists $ throwE err oneOf :: String -> [M b] -> M b oneOf :: forall b. FilePath -> [M b] -> M b oneOf FilePath err = (M b -> M b -> M b) -> M b -> [M b] -> M b forall a b. (a -> b -> b) -> b -> [a] -> b forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr M b -> M b -> M b forall a. M a -> M a -> M a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a (<|>) (FilePath -> M b forall a. FilePath -> M a throwE FilePath err) isSuccess :: ExitCode -> Bool isSuccess :: ExitCode -> Bool isSuccess = \case ExitCode ExitSuccess -> Bool True ExitFailure Int _ -> Bool False