{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}

module GHC.Toolchain.Utils
    ( expectJust
    , expectFileExists
    , withTempDir
    , oneOf
    , 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 = [FilePath] -> [M b] -> M b
forall b. [FilePath] -> [M b] -> M b
oneOf' [FilePath
err]

-- | Like 'oneOf' but takes a multi-line error message if none of the checks
-- succeed.
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
throwEs [FilePath]
err)

isSuccess :: ExitCode -> Bool
isSuccess :: ExitCode -> Bool
isSuccess = \case
  ExitCode
ExitSuccess -> Bool
True
  ExitFailure Int
_ -> Bool
False