    {-# LANGUAGE CPP #-}

    -- | Temporary file-system management
    module GHC.Utils.TmpFs
        ( TmpFs
        , initTmpFs
        , forkTmpFsFrom
        , mergeTmpFsInto
        , PathsToClean(..)
        , emptyPathsToClean
        , TempFileLifetime(..)
        , TempDir (..)
        , cleanTempDirs
        , cleanTempFiles
        , cleanCurrentModuleTempFiles
        , keepCurrentModuleTempFiles
        , addFilesToClean
        , changeTempFilesLifetime
        , newTempName
        , newTempLibName
        , newTempSubDir
        , withSystemTempDirectory
        , withTempDirectory
        )
    where

    import GHC.Prelude

    import GHC.Utils.Error
    import GHC.Utils.Outputable
    import GHC.Utils.Logger
    import GHC.Utils.Misc
    import GHC.Utils.Exception as Exception
    import GHC.Driver.Phases

    import Data.List (partition)
    import qualified Data.Set as Set
    import Data.Set (Set)
    import qualified Data.Map as Map
    import Data.Map (Map)
    import Data.IORef
    import System.Directory
    import System.FilePath
    import System.IO.Error

    #if !defined(mingw32_HOST_OS)
    import qualified System.Posix.Internals
    #endif

    -- | Temporary file-system
    data TmpFs = TmpFs
      { TmpFs -> IORef (Map FilePath FilePath)
    tmp_dirs_to_clean :: IORef (Map FilePath FilePath)
          -- ^ Maps system temporary directory (passed via settings or DynFlags) to
          -- an actual temporary directory for this process.
          --
          -- It's a Map probably to support changing the system temporary directory
          -- over time.
          --
          -- Shared with forked TmpFs.

      , TmpFs -> IORef Int
    tmp_next_suffix :: IORef Int
          -- ^ The next available suffix to uniquely name a temp file, updated
          -- atomically.
          --
          -- Shared with forked TmpFs.

      , TmpFs -> FilePath
    tmp_dir_prefix :: String

      , TmpFs -> IORef PathsToClean
    tmp_files_to_clean :: IORef PathsToClean
          -- ^ Files to clean (per session or per module)
          --
          -- Not shared with forked TmpFs.
      , TmpFs -> IORef PathsToClean
    tmp_subdirs_to_clean :: IORef PathsToClean
          -- ^ Subdirs to clean (per session or per module)
          --
          -- Not shared with forked TmpFs.
      }

    -- | A collection of paths that must be deleted before ghc exits.
    data PathsToClean = PathsToClean
        { PathsToClean -> Set FilePath
    ptcGhcSession :: !(Set FilePath)
            -- ^ Paths that will be deleted at the end of runGhc(T)

        , PathsToClean -> Set FilePath
    ptcCurrentModule :: !(Set FilePath)
            -- ^ Paths that will be deleted the next time
            -- 'cleanCurrentModuleTempFiles' is called, or otherwise at the end of
            -- the session.
        }

    -- | Used when a temp file is created. This determines which component Set of
    -- PathsToClean will get the temp file
    data TempFileLifetime
      = TFL_CurrentModule
      -- ^ A file with lifetime TFL_CurrentModule will be cleaned up at the
      -- end of upweep_mod
      | TFL_GhcSession
      -- ^ A file with lifetime TFL_GhcSession will be cleaned up at the end of
      -- runGhc(T)
      deriving (Int -> TempFileLifetime -> ShowS
    [TempFileLifetime] -> ShowS
    TempFileLifetime -> FilePath
    (Int -> TempFileLifetime -> ShowS)
    -> (TempFileLifetime -> FilePath)
    -> ([TempFileLifetime] -> ShowS)
    -> Show TempFileLifetime
    forall a.
    (Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> TempFileLifetime -> ShowS
    showsPrec :: Int -> TempFileLifetime -> ShowS
    $cshow :: TempFileLifetime -> FilePath
    show :: TempFileLifetime -> FilePath
    $cshowList :: [TempFileLifetime] -> ShowS
    showList :: [TempFileLifetime] -> ShowS
    Show)

    newtype TempDir = TempDir FilePath

    -- | An empty PathsToClean
    emptyPathsToClean :: PathsToClean
    emptyPathsToClean :: PathsToClean
    emptyPathsToClean = Set FilePath -> Set FilePath -> PathsToClean
    PathsToClean Set FilePath
    forall a. Set a
    Set.empty Set FilePath
    forall a. Set a
    Set.empty

    -- | Merge two PathsToClean
    mergePathsToClean :: PathsToClean -> PathsToClean -> PathsToClean
    mergePathsToClean :: PathsToClean -> PathsToClean -> PathsToClean
    mergePathsToClean PathsToClean
    x PathsToClean
    y = PathsToClean
        { ptcGhcSession :: Set FilePath
    ptcGhcSession    = Set FilePath -> Set FilePath -> Set FilePath
    forall a. Ord a => Set a -> Set a -> Set a
    Set.union (PathsToClean -> Set FilePath
    ptcGhcSession PathsToClean
    x) (PathsToClean -> Set FilePath
    ptcGhcSession PathsToClean
    y)
        , ptcCurrentModule :: Set FilePath
    ptcCurrentModule = Set FilePath -> Set FilePath -> Set FilePath
    forall a. Ord a => Set a -> Set a -> Set a
    Set.union (PathsToClean -> Set FilePath
    ptcCurrentModule PathsToClean
    x) (PathsToClean -> Set FilePath
    ptcCurrentModule PathsToClean
    y)
        }

    -- | Initialise an empty TmpFs
    initTmpFs :: IO TmpFs
    initTmpFs :: IO TmpFs
    initTmpFs = do
        files   <- PathsToClean -> IO (IORef PathsToClean)
    forall a. a -> IO (IORef a)
    newIORef PathsToClean
    emptyPathsToClean
        subdirs <- newIORef emptyPathsToClean
        dirs    <- newIORef Map.empty
        next    <- newIORef 0
        return $ TmpFs
            { tmp_files_to_clean   = files
            , tmp_subdirs_to_clean = subdirs
            , tmp_dirs_to_clean    = dirs
            , tmp_next_suffix      = next
            , tmp_dir_prefix       = "tmp"
            }

    -- | Initialise an empty TmpFs sharing unique numbers and per-process temporary
    -- directories with the given TmpFs
    --
    -- It's not safe to use the subdirs created by the original TmpFs with the
    -- forked one. Use @newTempSubDir@ to create new subdirs instead.
    forkTmpFsFrom :: TmpFs -> IO TmpFs
    forkTmpFsFrom :: TmpFs -> IO TmpFs
    forkTmpFsFrom TmpFs
    old = do
        files <- PathsToClean -> IO (IORef PathsToClean)
    forall a. a -> IO (IORef a)
    newIORef PathsToClean
    emptyPathsToClean
        subdirs <- newIORef emptyPathsToClean
        counter <- newIORef 0
        prefix  <- newTempSuffix old

        return $ TmpFs
            { tmp_files_to_clean   = files
            , tmp_subdirs_to_clean = subdirs
            , tmp_dirs_to_clean    = tmp_dirs_to_clean old
            , tmp_next_suffix      = counter
            , tmp_dir_prefix       = prefix
            }

    -- | Merge the first TmpFs into the second.
    --
    -- The first TmpFs is returned emptied.
    mergeTmpFsInto :: TmpFs -> TmpFs -> IO ()
    mergeTmpFsInto :: TmpFs -> TmpFs -> IO ()
    mergeTmpFsInto TmpFs
    src TmpFs
    dst = do
        src_files <- IORef PathsToClean
    -> (PathsToClean -> (PathsToClean, PathsToClean))
    -> IO PathsToClean
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' (TmpFs -> IORef PathsToClean
    tmp_files_to_clean TmpFs
    src) (\PathsToClean
    s -> (PathsToClean
    emptyPathsToClean, PathsToClean
    s))
        src_subdirs <- atomicModifyIORef' (tmp_subdirs_to_clean src) (\PathsToClean
    s -> (PathsToClean
    emptyPathsToClean, PathsToClean
    s))
        atomicModifyIORef' (tmp_files_to_clean dst) (\PathsToClean
    s -> (PathsToClean -> PathsToClean -> PathsToClean
    mergePathsToClean PathsToClean
    src_files PathsToClean
    s, ()))
        atomicModifyIORef' (tmp_subdirs_to_clean dst) (\PathsToClean
    s -> (PathsToClean -> PathsToClean -> PathsToClean
    mergePathsToClean PathsToClean
    src_subdirs PathsToClean
    s, ()))

    cleanTempDirs :: Logger -> TmpFs -> IO ()
    cleanTempDirs :: Logger -> TmpFs -> IO ()
    cleanTempDirs Logger
    logger TmpFs
    tmpfs
       = IO () -> IO ()
    forall a. IO a -> IO a
    mask_
       (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do let ref :: IORef (Map FilePath FilePath)
    ref = TmpFs -> IORef (Map FilePath FilePath)
    tmp_dirs_to_clean TmpFs
    tmpfs
            ds <- IORef (Map FilePath FilePath)
    -> (Map FilePath FilePath
        -> (Map FilePath FilePath, Map FilePath FilePath))
    -> IO (Map FilePath FilePath)
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef (Map FilePath FilePath)
    ref ((Map FilePath FilePath
      -> (Map FilePath FilePath, Map FilePath FilePath))
     -> IO (Map FilePath FilePath))
    -> (Map FilePath FilePath
        -> (Map FilePath FilePath, Map FilePath FilePath))
    -> IO (Map FilePath FilePath)
    forall a b. (a -> b) -> a -> b
    $ \Map FilePath FilePath
    ds -> (Map FilePath FilePath
    forall k a. Map k a
    Map.empty, Map FilePath FilePath
    ds)
            removeTmpDirs logger (Map.elems ds)

    -- | Delete all paths in @tmp_files_to_clean@ and @tmp_subdirs_to_clean@.
    cleanTempFiles :: Logger -> TmpFs -> IO ()
    cleanTempFiles :: Logger -> TmpFs -> IO ()
    cleanTempFiles Logger
    logger TmpFs
    tmpfs
       = IO () -> IO ()
    forall a. IO a -> IO a
    mask_
       (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do ([FilePath] -> IO ()) -> IORef PathsToClean -> IO ()
    forall {b}. ([FilePath] -> IO b) -> IORef PathsToClean -> IO b
    removeWith (Logger -> [FilePath] -> IO ()
    removeTmpFiles Logger
    logger) (TmpFs -> IORef PathsToClean
    tmp_files_to_clean TmpFs
    tmpfs)
            ([FilePath] -> IO ()) -> IORef PathsToClean -> IO ()
    forall {b}. ([FilePath] -> IO b) -> IORef PathsToClean -> IO b
    removeWith (Logger -> [FilePath] -> IO ()
    removeTmpSubdirs Logger
    logger) (TmpFs -> IORef PathsToClean
    tmp_subdirs_to_clean TmpFs
    tmpfs)
      where
        removeWith :: ([FilePath] -> IO b) -> IORef PathsToClean -> IO b
    removeWith [FilePath] -> IO b
    remove IORef PathsToClean
    ref = do
          to_delete <- IORef PathsToClean
    -> (PathsToClean -> (PathsToClean, [FilePath])) -> IO [FilePath]
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef PathsToClean
    ref ((PathsToClean -> (PathsToClean, [FilePath])) -> IO [FilePath])
    -> (PathsToClean -> (PathsToClean, [FilePath])) -> IO [FilePath]
    forall a b. (a -> b) -> a -> b
    $
            \PathsToClean
                { ptcCurrentModule :: PathsToClean -> Set FilePath
    ptcCurrentModule = Set FilePath
    cm_paths
                , ptcGhcSession :: PathsToClean -> Set FilePath
    ptcGhcSession = Set FilePath
    gs_paths
                } -> ( PathsToClean
    emptyPathsToClean
                      , Set FilePath -> [FilePath]
    forall a. Set a -> [a]
    Set.toList Set FilePath
    cm_paths [FilePath] -> [FilePath] -> [FilePath]
    forall a. [a] -> [a] -> [a]
    ++ Set FilePath -> [FilePath]
    forall a. Set a -> [a]
    Set.toList Set FilePath
    gs_paths)
          remove to_delete

    -- | Keep all the paths in @tmp_files_to_clean@ and @tmp_subdirs_to_clean@
    -- that have lifetime TFL_CurrentModule. This function is used when `-keep-tmp-files` is
    -- used in an OPTIONS_GHC pragma.
    -- This function removes the temporary file from the TmpFs so we no longer remove
    -- it at the env when cleanTempFiles is called.
    keepCurrentModuleTempFiles :: HasCallStack => Logger -> TmpFs -> IO ()
    keepCurrentModuleTempFiles :: HasCallStack => Logger -> TmpFs -> IO ()
    keepCurrentModuleTempFiles Logger
    logger TmpFs
    tmpfs
       = IO () -> IO ()
    forall a. IO a -> IO a
    mask_
       (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do to_keep_files <- IORef PathsToClean -> IO [FilePath]
    keep  (TmpFs -> IORef PathsToClean
    tmp_files_to_clean TmpFs
    tmpfs)
            to_keep_subdirs <- keep  (tmp_subdirs_to_clean tmpfs)
            -- Remove any folders which contain any files we want to keep from the
            -- directories we are tracking. A new temporary directory will be created
            -- the next time a temporary file is needed (by perhaps another module).
            keepDirs (to_keep_files ++ to_keep_subdirs) (tmp_dirs_to_clean tmpfs)
      where
        keepDirs :: [FilePath] -> IORef (Map k FilePath) -> IO ()
    keepDirs [FilePath]
    keeps IORef (Map k FilePath)
    ref = do
          let keep_dirs :: Set FilePath
    keep_dirs = [FilePath] -> Set FilePath
    forall a. Ord a => [a] -> Set a
    Set.fromList (ShowS -> [FilePath] -> [FilePath]
    forall a b. (a -> b) -> [a] -> [b]
    map ShowS
    takeDirectory [FilePath]
    keeps)
          IORef (Map k FilePath)
    -> (Map k FilePath -> (Map k FilePath, ())) -> IO ()
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef (Map k FilePath)
    ref  ((Map k FilePath -> (Map k FilePath, ())) -> IO ())
    -> (Map k FilePath -> (Map k FilePath, ())) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Map k FilePath
    m -> ((FilePath -> Bool) -> Map k FilePath -> Map k FilePath
    forall a k. (a -> Bool) -> Map k a -> Map k a
    Map.filter (\FilePath
    fp -> FilePath
    fp FilePath -> Set FilePath -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.notMember` Set FilePath
    keep_dirs) Map k FilePath
    m, ())

        keep :: IORef PathsToClean -> IO [FilePath]
    keep IORef PathsToClean
    ref = do
            to_keep <- IORef PathsToClean
    -> (PathsToClean -> (PathsToClean, [FilePath])) -> IO [FilePath]
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef PathsToClean
    ref ((PathsToClean -> (PathsToClean, [FilePath])) -> IO [FilePath])
    -> (PathsToClean -> (PathsToClean, [FilePath])) -> IO [FilePath]
    forall a b. (a -> b) -> a -> b
    $
                \ptc :: PathsToClean
    ptc@PathsToClean{ptcCurrentModule :: PathsToClean -> Set FilePath
    ptcCurrentModule = Set FilePath
    cm_paths} ->
                    (PathsToClean
    ptc {ptcCurrentModule = Set.empty}, Set FilePath -> [FilePath]
    forall a. Set a -> [a]
    Set.toList Set FilePath
    cm_paths)
            debugTraceMsg logger 2 (text "Keeping:" <+> hsep (map text to_keep))
            return to_keep

    -- | Delete all paths in @tmp_files_to_clean@ and @tmp_subdirs_to_clean@
    -- That have lifetime TFL_CurrentModule.
    -- If a file must be cleaned eventually, but must survive a
    -- cleanCurrentModuleTempFiles, ensure it has lifetime TFL_GhcSession.
    cleanCurrentModuleTempFiles :: Logger -> TmpFs -> IO ()
    cleanCurrentModuleTempFiles :: Logger -> TmpFs -> IO ()
    cleanCurrentModuleTempFiles Logger
    logger TmpFs
    tmpfs
       = IO () -> IO ()
    forall a. IO a -> IO a
    mask_
       (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do ([FilePath] -> IO ()) -> IORef PathsToClean -> IO ()
    forall {b}. ([FilePath] -> IO b) -> IORef PathsToClean -> IO b
    removeWith (Logger -> [FilePath] -> IO ()
    removeTmpFiles Logger
    logger) (TmpFs -> IORef PathsToClean
    tmp_files_to_clean TmpFs
    tmpfs)
            ([FilePath] -> IO ()) -> IORef PathsToClean -> IO ()
    forall {b}. ([FilePath] -> IO b) -> IORef PathsToClean -> IO b
    removeWith (Logger -> [FilePath] -> IO ()
    removeTmpSubdirs Logger
    logger) (TmpFs -> IORef PathsToClean
    tmp_subdirs_to_clean TmpFs
    tmpfs)
      where
        removeWith :: ([FilePath] -> IO b) -> IORef PathsToClean -> IO b
    removeWith [FilePath] -> IO b
    remove IORef PathsToClean
    ref = do
            to_delete <- IORef PathsToClean
    -> (PathsToClean -> (PathsToClean, [FilePath])) -> IO [FilePath]
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef PathsToClean
    ref ((PathsToClean -> (PathsToClean, [FilePath])) -> IO [FilePath])
    -> (PathsToClean -> (PathsToClean, [FilePath])) -> IO [FilePath]
    forall a b. (a -> b) -> a -> b
    $
                \ptc :: PathsToClean
    ptc@PathsToClean{ptcCurrentModule :: PathsToClean -> Set FilePath
    ptcCurrentModule = Set FilePath
    cm_paths} ->
                    (PathsToClean
    ptc {ptcCurrentModule = Set.empty}, Set FilePath -> [FilePath]
    forall a. Set a -> [a]
    Set.toList Set FilePath
    cm_paths)
            remove to_delete

    -- | Ensure that new_files are cleaned on the next call of
    -- 'cleanTempFiles' or 'cleanCurrentModuleTempFiles', depending on lifetime.
    -- If any of new_files are already tracked, they will have their lifetime
    -- updated.
    addFilesToClean :: TmpFs -> TempFileLifetime -> [FilePath] -> IO ()
    addFilesToClean :: TmpFs -> TempFileLifetime -> [FilePath] -> IO ()
    addFilesToClean TmpFs
    tmpfs TempFileLifetime
    lifetime [FilePath]
    new_files =
      IORef PathsToClean -> TempFileLifetime -> [FilePath] -> IO ()
    addToClean (TmpFs -> IORef PathsToClean
    tmp_files_to_clean TmpFs
    tmpfs) TempFileLifetime
    lifetime [FilePath]
    new_files

    addSubdirsToClean :: TmpFs -> TempFileLifetime -> [FilePath] -> IO ()
    addSubdirsToClean :: TmpFs -> TempFileLifetime -> [FilePath] -> IO ()
    addSubdirsToClean TmpFs
    tmpfs TempFileLifetime
    lifetime [FilePath]
    new_subdirs =
      IORef PathsToClean -> TempFileLifetime -> [FilePath] -> IO ()
    addToClean (TmpFs -> IORef PathsToClean
    tmp_subdirs_to_clean TmpFs
    tmpfs) TempFileLifetime
    lifetime [FilePath]
    new_subdirs

    addToClean :: IORef PathsToClean -> TempFileLifetime -> [FilePath] -> IO ()
    addToClean :: IORef PathsToClean -> TempFileLifetime -> [FilePath] -> IO ()
    addToClean IORef PathsToClean
    ref TempFileLifetime
    lifetime [FilePath]
    new_filepaths = IORef PathsToClean -> (PathsToClean -> PathsToClean) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef' IORef PathsToClean
    ref ((PathsToClean -> PathsToClean) -> IO ())
    -> (PathsToClean -> PathsToClean) -> IO ()
    forall a b. (a -> b) -> a -> b
    $
      \PathsToClean
        { ptcCurrentModule :: PathsToClean -> Set FilePath
    ptcCurrentModule = Set FilePath
    cm_paths
        , ptcGhcSession :: PathsToClean -> Set FilePath
    ptcGhcSession = Set FilePath
    gs_paths
        } -> case TempFileLifetime
    lifetime of
          TempFileLifetime
    TFL_CurrentModule -> PathsToClean
            { ptcCurrentModule :: Set FilePath
    ptcCurrentModule = Set FilePath
    cm_paths Set FilePath -> Set FilePath -> Set FilePath
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.union` Set FilePath
    new_filepaths_set
            , ptcGhcSession :: Set FilePath
    ptcGhcSession = Set FilePath
    gs_paths Set FilePath -> Set FilePath -> Set FilePath
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.difference` Set FilePath
    new_filepaths_set
            }
          TempFileLifetime
    TFL_GhcSession -> PathsToClean
            { ptcCurrentModule :: Set FilePath
    ptcCurrentModule = Set FilePath
    cm_paths Set FilePath -> Set FilePath -> Set FilePath
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.difference` Set FilePath
    new_filepaths_set
            , ptcGhcSession :: Set FilePath
    ptcGhcSession = Set FilePath
    gs_paths Set FilePath -> Set FilePath -> Set FilePath
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.union` Set FilePath
    new_filepaths_set
            }
      where
        new_filepaths_set :: Set FilePath
    new_filepaths_set = [FilePath] -> Set FilePath
    forall a. Ord a => [a] -> Set a
    Set.fromList [FilePath]
    new_filepaths

    -- | Update the lifetime of files already being tracked. If any files are
    -- not being tracked they will be discarded.
    changeTempFilesLifetime :: TmpFs -> TempFileLifetime -> [FilePath] -> IO ()
    changeTempFilesLifetime :: TmpFs -> TempFileLifetime -> [FilePath] -> IO ()
    changeTempFilesLifetime TmpFs
    tmpfs TempFileLifetime
    lifetime [FilePath]
    files = do
      PathsToClean
        { ptcCurrentModule = cm_paths
        , ptcGhcSession = gs_paths
        } <- IORef PathsToClean -> IO PathsToClean
    forall a. IORef a -> IO a
    readIORef (TmpFs -> IORef PathsToClean
    tmp_files_to_clean TmpFs
    tmpfs)
      let old_set = case TempFileLifetime
    lifetime of
            TempFileLifetime
    TFL_CurrentModule -> Set FilePath
    gs_paths
            TempFileLifetime
    TFL_GhcSession -> Set FilePath
    cm_paths
          existing_files = [FilePath
    f | FilePath
    f <- [FilePath]
    files, FilePath
    f FilePath -> Set FilePath -> Bool
    forall a. Ord a => a -> Set a -> Bool
    `Set.member` Set FilePath
    old_set]
      addFilesToClean tmpfs lifetime existing_files

    -- Return a unique numeric temp file suffix
    newTempSuffix :: TmpFs -> IO String
    newTempSuffix :: TmpFs -> IO FilePath
    newTempSuffix TmpFs
    tmpfs = do
      n <- IORef Int -> (Int -> (Int, Int)) -> IO Int
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' (TmpFs -> IORef Int
    tmp_next_suffix TmpFs
    tmpfs) ((Int -> (Int, Int)) -> IO Int) -> (Int -> (Int, Int)) -> IO Int
    forall a b. (a -> b) -> a -> b
    $ \Int
    n -> (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1,Int
    n)
      return $ tmp_dir_prefix tmpfs ++ "_" ++ show n

    -- Find a temporary name that doesn't already exist.
    newTempName :: Logger -> TmpFs -> TempDir -> TempFileLifetime -> Suffix -> IO FilePath
    newTempName :: Logger
    -> TmpFs -> TempDir -> TempFileLifetime -> FilePath -> IO FilePath
    newTempName Logger
    logger TmpFs
    tmpfs TempDir
    tmp_dir TempFileLifetime
    lifetime FilePath
    extn
      = do d <- Logger -> TmpFs -> TempDir -> IO FilePath
    getTempDir Logger
    logger TmpFs
    tmpfs TempDir
    tmp_dir
           findTempName (d </> "ghc_") -- See Note [Deterministic base name]
      where
        findTempName :: FilePath -> IO FilePath
        findTempName :: FilePath -> IO FilePath
    findTempName FilePath
    prefix
          = do suffix <- TmpFs -> IO FilePath
    newTempSuffix TmpFs
    tmpfs
               let filename = FilePath
    prefix FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    suffix FilePath -> ShowS
    <.> FilePath
    extn
               b <- doesFileExist filename
               if b then findTempName prefix
                    else do -- clean it up later
                            addFilesToClean tmpfs lifetime [filename]
                            return filename

    -- | Create a new temporary subdirectory that doesn't already exist
    -- The temporary subdirectory is automatically removed at the end of the
    -- GHC session, but its contents aren't. Make sure to leave the directory
    -- empty before the end of the session, either by removing content
    -- directly or by using @addFilesToClean@.
    --
    -- If the created subdirectory is not empty, it will not be removed (along
    -- with its parent temporary directory) and a warning message will be
    -- printed at verbosity 2 and higher.
    newTempSubDir :: Logger -> TmpFs -> TempDir -> IO FilePath
    newTempSubDir :: Logger -> TmpFs -> TempDir -> IO FilePath
    newTempSubDir Logger
    logger TmpFs
    tmpfs TempDir
    tmp_dir
      = do d <- Logger -> TmpFs -> TempDir -> IO FilePath
    getTempDir Logger
    logger TmpFs
    tmpfs TempDir
    tmp_dir
           findTempDir (d </> "ghc_")
      where
        findTempDir :: FilePath -> IO FilePath
        findTempDir :: FilePath -> IO FilePath
    findTempDir FilePath
    prefix
          = do suffix <- TmpFs -> IO FilePath
    newTempSuffix TmpFs
    tmpfs
               let name = FilePath
    prefix FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    suffix
               b <- doesDirectoryExist name
               if b then findTempDir prefix
                    else (do
                      createDirectory name
                      addSubdirsToClean tmpfs TFL_GhcSession [name]
                      return name)
                `Exception.catchIO` \IOException
    e -> if IOException -> Bool
    isAlreadyExistsError IOException
    e
                      then FilePath -> IO FilePath
    findTempDir FilePath
    prefix else IOException -> IO FilePath
    forall a. IOException -> IO a
    ioError IOException
    e

    newTempLibName :: Logger -> TmpFs -> TempDir -> TempFileLifetime -> Suffix
      -> IO (FilePath, FilePath, String)
    newTempLibName :: Logger
    -> TmpFs
    -> TempDir
    -> TempFileLifetime
    -> FilePath
    -> IO (FilePath, FilePath, FilePath)
    newTempLibName Logger
    logger TmpFs
    tmpfs TempDir
    tmp_dir TempFileLifetime
    lifetime FilePath
    extn
      = do d <- Logger -> TmpFs -> TempDir -> IO FilePath
    getTempDir Logger
    logger TmpFs
    tmpfs TempDir
    tmp_dir
           findTempName d ("ghc_")
      where
        findTempName :: FilePath -> String -> IO (FilePath, FilePath, String)
        findTempName :: FilePath -> FilePath -> IO (FilePath, FilePath, FilePath)
    findTempName FilePath
    dir FilePath
    prefix
          = do suffix <- TmpFs -> IO FilePath
    newTempSuffix TmpFs
    tmpfs -- See Note [Deterministic base name]
               let libname = FilePath
    prefix FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    suffix
                   filename = FilePath
    dir FilePath -> ShowS
    </> FilePath
    "lib" FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    libname FilePath -> ShowS
    <.> FilePath
    extn
               b <- doesFileExist filename
               if b then findTempName dir prefix
                    else do -- clean it up later
                            addFilesToClean tmpfs lifetime [filename]
                            return (filename, dir, libname)

    -- Return our temporary directory within tmp_dir, creating one if we
    -- don't have one yet.
    getTempDir :: Logger -> TmpFs -> TempDir -> IO FilePath
    getTempDir :: Logger -> TmpFs -> TempDir -> IO FilePath
    getTempDir Logger
    logger TmpFs
    tmpfs (TempDir FilePath
    tmp_dir) = do
        mapping <- IORef (Map FilePath FilePath) -> IO (Map FilePath FilePath)
    forall a. IORef a -> IO a
    readIORef IORef (Map FilePath FilePath)
    dir_ref
        case Map.lookup tmp_dir mapping of
            Maybe FilePath
    Nothing -> do
                pid <- IO Int
    getProcessID
                let prefix = FilePath
    tmp_dir FilePath -> ShowS
    </> FilePath
    "ghc" FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    pid FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "_"
                mask_ $ mkTempDir prefix
            Just FilePath
    dir -> FilePath -> IO FilePath
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return FilePath
    dir
      where
        dir_ref :: IORef (Map FilePath FilePath)
    dir_ref = TmpFs -> IORef (Map FilePath FilePath)
    tmp_dirs_to_clean TmpFs
    tmpfs

        mkTempDir :: FilePath -> IO FilePath
        mkTempDir :: FilePath -> IO FilePath
    mkTempDir FilePath
    prefix = do
            suffix <- TmpFs -> IO FilePath
    newTempSuffix TmpFs
    tmpfs
            let our_dir = FilePath
    prefix FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    suffix

            -- 1. Speculatively create our new directory.
            createDirectory our_dir

            -- 2. Update the tmp_dirs_to_clean mapping unless an entry already exists
            -- (i.e. unless another thread beat us to it).
            their_dir <- atomicModifyIORef' dir_ref $ \Map FilePath FilePath
    mapping ->
                case FilePath -> Map FilePath FilePath -> Maybe FilePath
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup FilePath
    tmp_dir Map FilePath FilePath
    mapping of
                    Just FilePath
    dir -> (Map FilePath FilePath
    mapping, FilePath -> Maybe FilePath
    forall a. a -> Maybe a
    Just FilePath
    dir)
                    Maybe FilePath
    Nothing  -> (FilePath
    -> FilePath -> Map FilePath FilePath -> Map FilePath FilePath
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert FilePath
    tmp_dir FilePath
    our_dir Map FilePath FilePath
    mapping, Maybe FilePath
    forall a. Maybe a
    Nothing)

            -- 3. If there was an existing entry, return it and delete the
            -- directory we created.  Otherwise return the directory we created.
            case their_dir of
                Maybe FilePath
    Nothing  -> do
                    Logger -> Int -> SDoc -> IO ()
    debugTraceMsg Logger
    logger Int
    2 (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                        FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Created temporary directory:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    our_dir
                    FilePath -> IO FilePath
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return FilePath
    our_dir
                Just FilePath
    dir -> do
                    FilePath -> IO ()
    removeDirectory FilePath
    our_dir
                    FilePath -> IO FilePath
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return FilePath
    dir
          IO FilePath -> (IOException -> IO FilePath) -> IO FilePath
    forall a. IO a -> (IOException -> IO a) -> IO a
    `Exception.catchIO` \IOException
    e -> if IOException -> Bool
    isAlreadyExistsError IOException
    e
                          then FilePath -> IO FilePath
    mkTempDir FilePath
    prefix else IOException -> IO FilePath
    forall a. IOException -> IO a
    ioError IOException
    e

    {- Note [Deterministic base name]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    The filename of temporary files, especially the basename of C files, can end
    up in the output in some form, e.g. as part of linker debug information. In the
    interest of bit-wise exactly reproducible compilation (#4012), the basename of
    the temporary file no longer contains random information (it used to contain
    the process id).

    This is ok, as the temporary directory used contains the pid (see getTempDir).

    In addition to this, multiple threads can race against each other creating temporary
    files. Therefore we supply a prefix when creating temporary files, when a thread is
    forked, each thread must be given an TmpFs with a unique prefix. This is achieved
    by forkTmpFsFrom creating a fresh prefix from the parent TmpFs.
    -}

    manyWithTrace :: Logger -> String -> ([FilePath] -> IO ()) -> [FilePath] -> IO ()
    manyWithTrace :: Logger -> FilePath -> ([FilePath] -> IO ()) -> [FilePath] -> IO ()
    manyWithTrace Logger
    _ FilePath
    _ [FilePath] -> IO ()
    _ [] = () -> IO ()
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure () -- do silent nothing on zero filepaths
    manyWithTrace Logger
    logger FilePath
    phase [FilePath] -> IO ()
    act [FilePath]
    paths
      = Logger -> FilePath -> FilePath -> IO () -> IO ()
    forall a. Logger -> FilePath -> FilePath -> IO a -> IO a
    traceCmd Logger
    logger FilePath
    phase (FilePath
    "Deleting: " FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [FilePath] -> FilePath
    unwords [FilePath]
    paths) ([FilePath] -> IO ()
    act [FilePath]
    paths)

    removeTmpDirs :: Logger -> [FilePath] -> IO ()
    removeTmpDirs :: Logger -> [FilePath] -> IO ()
    removeTmpDirs Logger
    logger
      = Logger -> FilePath -> ([FilePath] -> IO ()) -> [FilePath] -> IO ()
    manyWithTrace Logger
    logger FilePath
    "Deleting temp dirs"
                      ((FilePath -> IO ()) -> [FilePath] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Logger -> (FilePath -> IO ()) -> FilePath -> IO ()
    removeWith Logger
    logger FilePath -> IO ()
    removeDirectory))

    removeTmpSubdirs :: Logger -> [FilePath] -> IO ()
    removeTmpSubdirs :: Logger -> [FilePath] -> IO ()
    removeTmpSubdirs Logger
    logger
      = Logger -> FilePath -> ([FilePath] -> IO ()) -> [FilePath] -> IO ()
    manyWithTrace Logger
    logger FilePath
    "Deleting temp subdirs"
                      ((FilePath -> IO ()) -> [FilePath] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Logger -> (FilePath -> IO ()) -> FilePath -> IO ()
    removeWith Logger
    logger FilePath -> IO ()
    removeDirectory))

    removeTmpFiles :: Logger -> [FilePath] -> IO ()
    removeTmpFiles :: Logger -> [FilePath] -> IO ()
    removeTmpFiles Logger
    logger [FilePath]
    fs
      = IO () -> IO ()
    warnNon (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        Logger -> FilePath -> ([FilePath] -> IO ()) -> [FilePath] -> IO ()
    manyWithTrace Logger
    logger FilePath
    "Deleting temp files"
                      ((FilePath -> IO ()) -> [FilePath] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Logger -> (FilePath -> IO ()) -> FilePath -> IO ()
    removeWith Logger
    logger FilePath -> IO ()
    removeFile)) [FilePath]
    deletees
      where
         -- Flat out refuse to delete files that are likely to be source input
         -- files (is there a worse bug than having a compiler delete your source
         -- files?)
         --
         -- Deleting source files is a sign of a bug elsewhere, so prominently flag
         -- the condition.
        warnNon :: IO () -> IO ()
    warnNon IO ()
    act
         | [FilePath] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FilePath]
    non_deletees = IO ()
    act
         | Bool
    otherwise         = do
            Logger -> SDoc -> IO ()
    putMsg Logger
    logger (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "WARNING - NOT deleting source files:"
                       SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [SDoc] -> SDoc
    forall doc. IsLine doc => [doc] -> doc
    hsep ((FilePath -> SDoc) -> [FilePath] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text [FilePath]
    non_deletees))
            IO ()
    act

        ([FilePath]
    non_deletees, [FilePath]
    deletees) = (FilePath -> Bool) -> [FilePath] -> ([FilePath], [FilePath])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition FilePath -> Bool
    isHaskellUserSrcFilename [FilePath]
    fs

    removeWith :: Logger -> (FilePath -> IO ()) -> FilePath -> IO ()
    removeWith :: Logger -> (FilePath -> IO ()) -> FilePath -> IO ()
    removeWith Logger
    logger FilePath -> IO ()
    remover FilePath
    f = FilePath -> IO ()
    remover FilePath
    f IO () -> (IOException -> IO ()) -> IO ()
    forall a. IO a -> (IOException -> IO a) -> IO a
    `Exception.catchIO`
      (\IOException
    e ->
       let msg :: SDoc
    msg = if IOException -> Bool
    isDoesNotExistError IOException
    e
                 then FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Warning: deleting non-existent" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    f
                 else FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Warning: exception raised when deleting"
                                                SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    f SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    colon
                   SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text (IOException -> FilePath
    forall a. Show a => a -> FilePath
    show IOException
    e)
       in Logger -> Int -> SDoc -> IO ()
    debugTraceMsg Logger
    logger Int
    2 SDoc
    msg
      )

    #if defined(mingw32_HOST_OS)
    -- relies on Int == Int32 on Windows
    foreign import ccall unsafe "_getpid" getProcessID :: IO Int
    #else
    getProcessID :: IO Int
    getProcessID :: IO Int
    getProcessID = IO CPid
    System.Posix.Internals.c_getpid IO CPid -> (CPid -> IO Int) -> IO Int
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Int -> IO Int
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int -> IO Int) -> (CPid -> Int) -> CPid -> IO Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CPid -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral
    #endif

    -- The following three functions are from the `temporary` package.

    -- | Create and use a temporary directory in the system standard temporary
    -- directory.
    --
    -- Behaves exactly the same as 'withTempDirectory', except that the parent
    -- temporary directory will be that returned by 'getTemporaryDirectory'.
    withSystemTempDirectory :: String   -- ^ Directory name template. See 'openTempFile'.
                            -> (FilePath -> IO a) -- ^ Callback that can use the directory
                            -> IO a
    withSystemTempDirectory :: forall a. FilePath -> (FilePath -> IO a) -> IO a
    withSystemTempDirectory FilePath
    template FilePath -> IO a
    action =
      IO FilePath
    getTemporaryDirectory IO FilePath -> (FilePath -> IO a) -> IO a
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \FilePath
    tmpDir -> FilePath -> FilePath -> (FilePath -> IO a) -> IO a
    forall a. FilePath -> FilePath -> (FilePath -> IO a) -> IO a
    withTempDirectory FilePath
    tmpDir FilePath
    template FilePath -> IO a
    action

    -- | Create and use a temporary directory.
    --
    -- Creates a new temporary directory inside the given directory, making use
    -- of the template. The temp directory is deleted after use. For example:
    --
    -- > withTempDirectory "src" "sdist." $ \tmpDir -> do ...
    --
    -- The @tmpDir@ will be a new subdirectory of the given directory, e.g.
    -- @src/sdist.342@.
    withTempDirectory :: FilePath -- ^ Temp directory to create the directory in
                      -> String   -- ^ Directory name template. See 'openTempFile'.
                      -> (FilePath -> IO a) -- ^ Callback that can use the directory
                      -> IO a
    withTempDirectory :: forall a. FilePath -> FilePath -> (FilePath -> IO a) -> IO a
    withTempDirectory FilePath
    targetDir FilePath
    template =
      IO FilePath -> (FilePath -> IO ()) -> (FilePath -> IO a) -> IO a
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    Exception.bracket
        (FilePath -> FilePath -> IO FilePath
    createTempDirectory FilePath
    targetDir FilePath
    template)
        (IO () -> IO ()
    ignoringIOErrors (IO () -> IO ()) -> (FilePath -> IO ()) -> FilePath -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FilePath -> IO ()
    removeDirectoryRecursive)

    ignoringIOErrors :: IO () -> IO ()
    ignoringIOErrors :: IO () -> IO ()
    ignoringIOErrors IO ()
    ioe = IO ()
    ioe IO () -> (IOException -> IO ()) -> IO ()
    forall a. IO a -> (IOException -> IO a) -> IO a
    `Exception.catchIO` IO () -> IOException -> IO ()
    forall a b. a -> b -> a
    const (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())

    createTempDirectory :: FilePath -> String -> IO FilePath
    createTempDirectory :: FilePath -> FilePath -> IO FilePath
    createTempDirectory FilePath
    dir FilePath
    template = do
      pid <- IO Int
    getProcessID
      findTempName pid
      where findTempName :: Int -> IO FilePath
    findTempName Int
    x = do
                let path :: FilePath
    path = FilePath
    dir FilePath -> ShowS
    </> FilePath
    template FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    x
                FilePath -> IO ()
    createDirectory FilePath
    path
                FilePath -> IO FilePath
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return FilePath
    path
              IO FilePath -> (IOException -> IO FilePath) -> IO FilePath
    forall a. IO a -> (IOException -> IO a) -> IO a
    `Exception.catchIO` \IOException
    e -> if IOException -> Bool
    isAlreadyExistsError IOException
    e
                              then Int -> IO FilePath
    findTempName (Int
    xInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) else IOException -> IO FilePath
    forall a. IOException -> IO a
    ioError IOException
    e