    {-# LANGUAGE CPP #-}

    -- | Temporary file-system management
    module GHC.Utils.TmpFs
        ( TmpFs
        , initTmpFs
        , forkTmpFsFrom
        , mergeTmpFsInto
        , FilesToClean(..)
        , emptyFilesToClean
        , TempFileLifetime(..)
        , TempDir (..)
        , cleanTempDirs
        , cleanTempFiles
        , cleanCurrentModuleTempFiles
        , addFilesToClean
        , changeTempFilesLifetime
        , newTempName
        , newTempLibName
        , newTempDir
        , 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 -> IORef FilesToClean
    tmp_files_to_clean :: IORef FilesToClean
          -- ^ Files to clean (per session or per module)
          --
          -- Not shared with forked TmpFs.
      }

    -- | A collection of files that must be deleted before ghc exits.
    data FilesToClean = FilesToClean
        { FilesToClean -> Set FilePath
    ftcGhcSession :: !(Set FilePath)
            -- ^ Files that will be deleted at the end of runGhc(T)

        , FilesToClean -> Set FilePath
    ftcCurrentModule :: !(Set FilePath)
            -- ^ Files 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
    -- FilesToClean 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 FilesToClean
    emptyFilesToClean :: FilesToClean
    emptyFilesToClean :: FilesToClean
    emptyFilesToClean = Set FilePath -> Set FilePath -> FilesToClean
    FilesToClean Set FilePath
    forall a. Set a
    Set.empty Set FilePath
    forall a. Set a
    Set.empty

    -- | Merge two FilesToClean
    mergeFilesToClean :: FilesToClean -> FilesToClean -> FilesToClean
    mergeFilesToClean :: FilesToClean -> FilesToClean -> FilesToClean
    mergeFilesToClean FilesToClean
    x FilesToClean
    y = FilesToClean
        { ftcGhcSession :: Set FilePath
    ftcGhcSession    = Set FilePath -> Set FilePath -> Set FilePath
    forall a. Ord a => Set a -> Set a -> Set a
    Set.union (FilesToClean -> Set FilePath
    ftcGhcSession FilesToClean
    x) (FilesToClean -> Set FilePath
    ftcGhcSession FilesToClean
    y)
        , ftcCurrentModule :: Set FilePath
    ftcCurrentModule = Set FilePath -> Set FilePath -> Set FilePath
    forall a. Ord a => Set a -> Set a -> Set a
    Set.union (FilesToClean -> Set FilePath
    ftcCurrentModule FilesToClean
    x) (FilesToClean -> Set FilePath
    ftcCurrentModule FilesToClean
    y)
        }

    -- | Initialise an empty TmpFs
    initTmpFs :: IO TmpFs
    initTmpFs :: IO TmpFs
    initTmpFs = do
        IORef FilesToClean
    files <- FilesToClean -> IO (IORef FilesToClean)
    forall a. a -> IO (IORef a)
    newIORef FilesToClean
    emptyFilesToClean
        IORef (Map FilePath FilePath)
    dirs  <- Map FilePath FilePath -> IO (IORef (Map FilePath FilePath))
    forall a. a -> IO (IORef a)
    newIORef Map FilePath FilePath
    forall k a. Map k a
    Map.empty
        IORef Int
    next  <- Int -> IO (IORef Int)
    forall a. a -> IO (IORef a)
    newIORef Int
    0
        TmpFs -> IO TmpFs
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TmpFs -> IO TmpFs) -> TmpFs -> IO TmpFs
    forall a b. (a -> b) -> a -> b
    $ TmpFs
            { tmp_files_to_clean :: IORef FilesToClean
    tmp_files_to_clean = IORef FilesToClean
    files
            , tmp_dirs_to_clean :: IORef (Map FilePath FilePath)
    tmp_dirs_to_clean  = IORef (Map FilePath FilePath)
    dirs
            , tmp_next_suffix :: IORef Int
    tmp_next_suffix    = IORef Int
    next
            }

    -- | Initialise an empty TmpFs sharing unique numbers and per-process temporary
    -- directories with the given TmpFs
    forkTmpFsFrom :: TmpFs -> IO TmpFs
    forkTmpFsFrom :: TmpFs -> IO TmpFs
    forkTmpFsFrom TmpFs
    old = do
        IORef FilesToClean
    files <- FilesToClean -> IO (IORef FilesToClean)
    forall a. a -> IO (IORef a)
    newIORef FilesToClean
    emptyFilesToClean
        TmpFs -> IO TmpFs
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TmpFs -> IO TmpFs) -> TmpFs -> IO TmpFs
    forall a b. (a -> b) -> a -> b
    $ TmpFs
            { tmp_files_to_clean :: IORef FilesToClean
    tmp_files_to_clean = IORef FilesToClean
    files
            , tmp_dirs_to_clean :: IORef (Map FilePath FilePath)
    tmp_dirs_to_clean  = TmpFs -> IORef (Map FilePath FilePath)
    tmp_dirs_to_clean TmpFs
    old
            , tmp_next_suffix :: IORef Int
    tmp_next_suffix    = TmpFs -> IORef Int
    tmp_next_suffix TmpFs
    old
            }

    -- | 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
        FilesToClean
    src_files <- IORef FilesToClean
    -> (FilesToClean -> (FilesToClean, FilesToClean))
    -> IO FilesToClean
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' (TmpFs -> IORef FilesToClean
    tmp_files_to_clean TmpFs
    src) (\FilesToClean
    s -> (FilesToClean
    emptyFilesToClean, FilesToClean
    s))
        IORef FilesToClean -> (FilesToClean -> (FilesToClean, ())) -> IO ()
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' (TmpFs -> IORef FilesToClean
    tmp_files_to_clean TmpFs
    dst) (\FilesToClean
    s -> (FilesToClean -> FilesToClean -> FilesToClean
    mergeFilesToClean FilesToClean
    src_files FilesToClean
    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
            Map FilePath FilePath
    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)
            Logger -> [FilePath] -> IO ()
    removeTmpDirs Logger
    logger (Map FilePath FilePath -> [FilePath]
    forall k a. Map k a -> [a]
    Map.elems Map FilePath FilePath
    ds)

    -- | Delete all files in @tmp_files_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 let ref :: IORef FilesToClean
    ref = TmpFs -> IORef FilesToClean
    tmp_files_to_clean TmpFs
    tmpfs
            [FilePath]
    to_delete <- IORef FilesToClean
    -> (FilesToClean -> (FilesToClean, [FilePath])) -> IO [FilePath]
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef FilesToClean
    ref ((FilesToClean -> (FilesToClean, [FilePath])) -> IO [FilePath])
    -> (FilesToClean -> (FilesToClean, [FilePath])) -> IO [FilePath]
    forall a b. (a -> b) -> a -> b
    $
                \FilesToClean
                    { ftcCurrentModule :: FilesToClean -> Set FilePath
    ftcCurrentModule = Set FilePath
    cm_files
                    , ftcGhcSession :: FilesToClean -> Set FilePath
    ftcGhcSession = Set FilePath
    gs_files
                    } -> ( FilesToClean
    emptyFilesToClean
                         , Set FilePath -> [FilePath]
    forall a. Set a -> [a]
    Set.toList Set FilePath
    cm_files [FilePath] -> [FilePath] -> [FilePath]
    forall a. [a] -> [a] -> [a]
    ++ Set FilePath -> [FilePath]
    forall a. Set a -> [a]
    Set.toList Set FilePath
    gs_files)
            Logger -> [FilePath] -> IO ()
    removeTmpFiles Logger
    logger [FilePath]
    to_delete

    -- | Delete all files in @tmp_files_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 let ref :: IORef FilesToClean
    ref = TmpFs -> IORef FilesToClean
    tmp_files_to_clean TmpFs
    tmpfs
            [FilePath]
    to_delete <- IORef FilesToClean
    -> (FilesToClean -> (FilesToClean, [FilePath])) -> IO [FilePath]
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef FilesToClean
    ref ((FilesToClean -> (FilesToClean, [FilePath])) -> IO [FilePath])
    -> (FilesToClean -> (FilesToClean, [FilePath])) -> IO [FilePath]
    forall a b. (a -> b) -> a -> b
    $
                \ftc :: FilesToClean
    ftc@FilesToClean{ftcCurrentModule :: FilesToClean -> Set FilePath
    ftcCurrentModule = Set FilePath
    cm_files} ->
                    (FilesToClean
    ftc {ftcCurrentModule :: Set FilePath
    ftcCurrentModule = Set FilePath
    forall a. Set a
    Set.empty}, Set FilePath -> [FilePath]
    forall a. Set a -> [a]
    Set.toList Set FilePath
    cm_files)
            Logger -> [FilePath] -> IO ()
    removeTmpFiles Logger
    logger [FilePath]
    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 FilesToClean -> (FilesToClean -> FilesToClean) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef' (TmpFs -> IORef FilesToClean
    tmp_files_to_clean TmpFs
    tmpfs) ((FilesToClean -> FilesToClean) -> IO ())
    -> (FilesToClean -> FilesToClean) -> IO ()
    forall a b. (a -> b) -> a -> b
    $
      \FilesToClean
        { ftcCurrentModule :: FilesToClean -> Set FilePath
    ftcCurrentModule = Set FilePath
    cm_files
        , ftcGhcSession :: FilesToClean -> Set FilePath
    ftcGhcSession = Set FilePath
    gs_files
        } -> case TempFileLifetime
    lifetime of
          TempFileLifetime
    TFL_CurrentModule -> FilesToClean
            { ftcCurrentModule :: Set FilePath
    ftcCurrentModule = Set FilePath
    cm_files Set FilePath -> Set FilePath -> Set FilePath
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.union` Set FilePath
    new_files_set
            , ftcGhcSession :: Set FilePath
    ftcGhcSession = Set FilePath
    gs_files Set FilePath -> Set FilePath -> Set FilePath
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.difference` Set FilePath
    new_files_set
            }
          TempFileLifetime
    TFL_GhcSession -> FilesToClean
            { ftcCurrentModule :: Set FilePath
    ftcCurrentModule = Set FilePath
    cm_files Set FilePath -> Set FilePath -> Set FilePath
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.difference` Set FilePath
    new_files_set
            , ftcGhcSession :: Set FilePath
    ftcGhcSession = Set FilePath
    gs_files Set FilePath -> Set FilePath -> Set FilePath
    forall a. Ord a => Set a -> Set a -> Set a
    `Set.union` Set FilePath
    new_files_set
            }
      where
        new_files_set :: Set FilePath
    new_files_set = [FilePath] -> Set FilePath
    forall a. Ord a => [a] -> Set a
    Set.fromList [FilePath]
    new_files

    -- | 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
      FilesToClean
        { ftcCurrentModule :: FilesToClean -> Set FilePath
    ftcCurrentModule = Set FilePath
    cm_files
        , ftcGhcSession :: FilesToClean -> Set FilePath
    ftcGhcSession = Set FilePath
    gs_files
        } <- IORef FilesToClean -> IO FilesToClean
    forall a. IORef a -> IO a
    readIORef (TmpFs -> IORef FilesToClean
    tmp_files_to_clean TmpFs
    tmpfs)
      let old_set :: Set FilePath
    old_set = case TempFileLifetime
    lifetime of
            TempFileLifetime
    TFL_CurrentModule -> Set FilePath
    gs_files
            TempFileLifetime
    TFL_GhcSession -> Set FilePath
    cm_files
          existing_files :: [FilePath]
    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]
      TmpFs -> TempFileLifetime -> [FilePath] -> IO ()
    addFilesToClean TmpFs
    tmpfs TempFileLifetime
    lifetime [FilePath]
    existing_files

    -- Return a unique numeric temp file suffix
    newTempSuffix :: TmpFs -> IO Int
    newTempSuffix :: TmpFs -> IO Int
    newTempSuffix TmpFs
    tmpfs =
      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)

    -- 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 FilePath
    d <- Logger -> TmpFs -> TempDir -> IO FilePath
    getTempDir Logger
    logger TmpFs
    tmpfs TempDir
    tmp_dir
           FilePath -> IO FilePath
    findTempName (FilePath
    d FilePath -> ShowS
    </> FilePath
    "ghc_") -- See Note [Deterministic base name]
      where
        findTempName :: FilePath -> IO FilePath
        findTempName :: FilePath -> IO FilePath
    findTempName FilePath
    prefix
          = do Int
    n <- TmpFs -> IO Int
    newTempSuffix TmpFs
    tmpfs
               let filename :: FilePath
    filename = FilePath
    prefix FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    n FilePath -> ShowS
    <.> FilePath
    extn
               Bool
    b <- FilePath -> IO Bool
    doesFileExist FilePath
    filename
               if Bool
    b then FilePath -> IO FilePath
    findTempName FilePath
    prefix
                    else do -- clean it up later
                            TmpFs -> TempFileLifetime -> [FilePath] -> IO ()
    addFilesToClean TmpFs
    tmpfs TempFileLifetime
    lifetime [FilePath
    filename]
                            FilePath -> IO FilePath
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return FilePath
    filename

    newTempDir :: Logger -> TmpFs -> TempDir -> IO FilePath
    newTempDir :: Logger -> TmpFs -> TempDir -> IO FilePath
    newTempDir Logger
    logger TmpFs
    tmpfs TempDir
    tmp_dir
      = do FilePath
    d <- Logger -> TmpFs -> TempDir -> IO FilePath
    getTempDir Logger
    logger TmpFs
    tmpfs TempDir
    tmp_dir
           FilePath -> IO FilePath
    findTempDir (FilePath
    d FilePath -> ShowS
    </> FilePath
    "ghc_")
      where
        findTempDir :: FilePath -> IO FilePath
        findTempDir :: FilePath -> IO FilePath
    findTempDir FilePath
    prefix
          = do Int
    n <- TmpFs -> IO Int
    newTempSuffix TmpFs
    tmpfs
               let filename :: FilePath
    filename = FilePath
    prefix FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    n
               Bool
    b <- FilePath -> IO Bool
    doesDirectoryExist FilePath
    filename
               if Bool
    b then FilePath -> IO FilePath
    findTempDir FilePath
    prefix
                    else do FilePath -> IO ()
    createDirectory FilePath
    filename
                            -- see mkTempDir below; this is wrong: -> consIORef (tmp_dirs_to_clean tmpfs) filename
                            FilePath -> IO FilePath
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return FilePath
    filename

    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 FilePath
    d <- Logger -> TmpFs -> TempDir -> IO FilePath
    getTempDir Logger
    logger TmpFs
    tmpfs TempDir
    tmp_dir
           FilePath -> FilePath -> IO (FilePath, FilePath, FilePath)
    findTempName FilePath
    d (FilePath
    "ghc_")
      where
        findTempName :: FilePath -> String -> IO (FilePath, FilePath, String)
        findTempName :: FilePath -> FilePath -> IO (FilePath, FilePath, FilePath)
    findTempName FilePath
    dir FilePath
    prefix
          = do Int
    n <- TmpFs -> IO Int
    newTempSuffix TmpFs
    tmpfs -- See Note [Deterministic base name]
               let libname :: FilePath
    libname = FilePath
    prefix FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    n
                   filename :: FilePath
    filename = FilePath
    dir FilePath -> ShowS
    </> FilePath
    "lib" FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    libname FilePath -> ShowS
    <.> FilePath
    extn
               Bool
    b <- FilePath -> IO Bool
    doesFileExist FilePath
    filename
               if Bool
    b then FilePath -> FilePath -> IO (FilePath, FilePath, FilePath)
    findTempName FilePath
    dir FilePath
    prefix
                    else do -- clean it up later
                            TmpFs -> TempFileLifetime -> [FilePath] -> IO ()
    addFilesToClean TmpFs
    tmpfs TempFileLifetime
    lifetime [FilePath
    filename]
                            (FilePath, FilePath, FilePath) -> IO (FilePath, FilePath, FilePath)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FilePath
    filename, FilePath
    dir, FilePath
    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
        Map FilePath FilePath
    mapping <- IORef (Map FilePath FilePath) -> IO (Map FilePath FilePath)
    forall a. IORef a -> IO a
    readIORef IORef (Map FilePath FilePath)
    dir_ref
        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
            Maybe FilePath
    Nothing -> do
                Int
    pid <- IO Int
    getProcessID
                let prefix :: FilePath
    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
    "_"
                IO FilePath -> IO FilePath
    forall a. IO a -> IO a
    mask_ (IO FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath -> IO FilePath
    mkTempDir FilePath
    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
            Int
    n <- TmpFs -> IO Int
    newTempSuffix TmpFs
    tmpfs
            let our_dir :: FilePath
    our_dir = FilePath
    prefix FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> FilePath
    forall a. Show a => a -> FilePath
    show Int
    n

            -- 1. Speculatively create our new directory.
            FilePath -> IO ()
    createDirectory FilePath
    our_dir

            -- 2. Update the tmp_dirs_to_clean mapping unless an entry already exists
            -- (i.e. unless another thread beat us to it).
            Maybe FilePath
    their_dir <- IORef (Map FilePath FilePath)
    -> (Map FilePath FilePath
        -> (Map FilePath FilePath, Maybe FilePath))
    -> IO (Maybe FilePath)
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef (Map FilePath FilePath)
    dir_ref ((Map FilePath FilePath -> (Map FilePath FilePath, Maybe FilePath))
     -> IO (Maybe FilePath))
    -> (Map FilePath FilePath
        -> (Map FilePath FilePath, Maybe FilePath))
    -> IO (Maybe FilePath)
    forall a b. (a -> b) -> a -> b
    $ \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 Maybe FilePath
    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
    text FilePath
    "Created temporary directory:" SDoc -> SDoc -> SDoc
    <+> FilePath -> SDoc
    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).
    -}
    removeTmpDirs :: Logger -> [FilePath] -> IO ()
    removeTmpDirs :: Logger -> [FilePath] -> IO ()
    removeTmpDirs Logger
    logger [FilePath]
    ds
      = Logger -> FilePath -> FilePath -> IO () -> IO ()
    forall a. Logger -> FilePath -> FilePath -> IO a -> IO a
    traceCmd Logger
    logger FilePath
    "Deleting temp dirs"
                 (FilePath
    "Deleting: " FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [FilePath] -> FilePath
    unwords [FilePath]
    ds)
                 ((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) [FilePath]
    ds)

    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 () -> IO ()
    forall a. Logger -> FilePath -> FilePath -> IO a -> IO a
    traceCmd Logger
    logger FilePath
    "Deleting temp files"
                 (FilePath
    "Deleting: " FilePath -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [FilePath] -> FilePath
    unwords [FilePath]
    deletees)
                 ((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
    text FilePath
    "WARNING - NOT deleting source files:"
                       SDoc -> SDoc -> SDoc
    <+> [SDoc] -> SDoc
    hsep ((FilePath -> SDoc) -> [FilePath] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map FilePath -> SDoc
    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
    text FilePath
    "Warning: deleting non-existent" SDoc -> SDoc -> SDoc
    <+> FilePath -> SDoc
    text FilePath
    f
                 else FilePath -> SDoc
    text FilePath
    "Warning: exception raised when deleting"
                                                SDoc -> SDoc -> SDoc
    <+> FilePath -> SDoc
    text FilePath
    f SDoc -> SDoc -> SDoc
    <> SDoc
    colon
                   SDoc -> SDoc -> SDoc
    $$ FilePath -> SDoc
    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
      Int
    pid <- IO Int
    getProcessID
      Int -> IO FilePath
    findTempName Int
    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