{-# LANGUAGE CPP #-}

-----------------------------------------------------------------------------
--
-- Makefile Dependency Generation
--
-- (c) The University of Glasgow 2005
--
-----------------------------------------------------------------------------

module GHC.Driver.MakeFile
   ( doMkDependHS
   )
where

#include "GhclibHsVersions.h"

import GHC.Prelude

import qualified GHC
import GHC.Driver.Monad
import GHC.Driver.Session
import GHC.Driver.Ppr
import GHC.Utils.Misc
import GHC.Driver.Env
import qualified GHC.SysTools as SysTools
import GHC.Data.Graph.Directed ( SCC(..) )
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Types.SourceError
import GHC.Types.SrcLoc
import Data.List
import GHC.Data.FastString
import GHC.SysTools.FileCleanup

import GHC.Unit.Module
import GHC.Unit.Module.ModSummary
import GHC.Unit.Module.Graph
import GHC.Unit.Finder

import GHC.Utils.Exception
import GHC.Utils.Error

import System.Directory
import System.FilePath
import System.IO
import System.IO.Error  ( isEOFError )
import Control.Monad    ( when )
import Data.Maybe       ( isJust )
import Data.IORef
import qualified Data.Set as Set

-----------------------------------------------------------------
--
--              The main function
--
-----------------------------------------------------------------

doMkDependHS :: GhcMonad m => [FilePath] -> m ()
doMkDependHS :: [FilePath] -> m ()
doMkDependHS [FilePath]
srcs = do
    -- Initialisation
    DynFlags
dflags0 <- m DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
GHC.getSessionDynFlags

    -- We kludge things a bit for dependency generation. Rather than
    -- generating dependencies for each way separately, we generate
    -- them once and then duplicate them for each way's osuf/hisuf.
    -- We therefore do the initial dependency generation with an empty
    -- way and .o/.hi extensions, regardless of any flags that might
    -- be specified.
    let dflags :: DynFlags
dflags = DynFlags
dflags0 {
                     ways :: Ways
ways = Ways
forall a. Set a
Set.empty,
                     hiSuf :: FilePath
hiSuf = FilePath
"hi",
                     objectSuf :: FilePath
objectSuf = FilePath
"o"
                 }
    DynFlags -> m ()
forall (m :: * -> *). GhcMonad m => DynFlags -> m ()
GHC.setSessionDynFlags DynFlags
dflags

    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DynFlags -> [FilePath]
depSuffixes DynFlags
dflags)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
        GhcException -> IO ()
forall a. GhcException -> IO a
throwGhcExceptionIO (FilePath -> GhcException
ProgramError FilePath
"You must specify at least one -dep-suffix")

    MkDepFiles
files <- IO MkDepFiles -> m MkDepFiles
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MkDepFiles -> m MkDepFiles) -> IO MkDepFiles -> m MkDepFiles
forall a b. (a -> b) -> a -> b
$ DynFlags -> IO MkDepFiles
beginMkDependHS DynFlags
dflags

    -- Do the downsweep to find all the modules
    [Target]
targets <- (FilePath -> m Target) -> [FilePath] -> m [Target]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\FilePath
s -> FilePath -> Maybe Phase -> m Target
forall (m :: * -> *).
GhcMonad m =>
FilePath -> Maybe Phase -> m Target
GHC.guessTarget FilePath
s Maybe Phase
forall a. Maybe a
Nothing) [FilePath]
srcs
    [Target] -> m ()
forall (m :: * -> *). GhcMonad m => [Target] -> m ()
GHC.setTargets [Target]
targets
    let excl_mods :: [ModuleName]
excl_mods = DynFlags -> [ModuleName]
depExcludeMods DynFlags
dflags
    ModuleGraph
module_graph <- [ModuleName] -> Bool -> m ModuleGraph
forall (m :: * -> *).
GhcMonad m =>
[ModuleName] -> Bool -> m ModuleGraph
GHC.depanal [ModuleName]
excl_mods Bool
True {- Allow dup roots -}

    -- Sort into dependency order
    -- There should be no cycles
    let sorted :: [SCC ModSummary]
sorted = Bool -> ModuleGraph -> Maybe ModuleName -> [SCC ModSummary]
GHC.topSortModuleGraph Bool
False ModuleGraph
module_graph Maybe ModuleName
forall a. Maybe a
Nothing

    -- Print out the dependencies if wanted
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> Int -> MsgDoc -> IO ()
debugTraceMsg DynFlags
dflags Int
2 (FilePath -> MsgDoc
text FilePath
"Module dependencies" MsgDoc -> MsgDoc -> MsgDoc
$$ [SCC ModSummary] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [SCC ModSummary]
sorted)

    -- Process them one by one, dumping results into makefile
    -- and complaining about cycles
    HscEnv
hsc_env <- m HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
getSession
    FilePath
root <- IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getCurrentDirectory
    (SCC ModSummary -> m ()) -> [SCC ModSummary] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ())
-> (SCC ModSummary -> IO ()) -> SCC ModSummary -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags
-> HscEnv
-> [ModuleName]
-> FilePath
-> Handle
-> SCC ModSummary
-> IO ()
processDeps DynFlags
dflags HscEnv
hsc_env [ModuleName]
excl_mods FilePath
root (MkDepFiles -> Handle
mkd_tmp_hdl MkDepFiles
files)) [SCC ModSummary]
sorted

    -- If -ddump-mod-cycles, show cycles in the module graph
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> ModuleGraph -> IO ()
dumpModCycles DynFlags
dflags ModuleGraph
module_graph

    -- Tidy up
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> MkDepFiles -> IO ()
endMkDependHS DynFlags
dflags MkDepFiles
files

    -- Unconditional exiting is a bad idea.  If an error occurs we'll get an
    --exception; if that is not caught it's fine, but at least we have a
    --chance to find out exactly what went wrong.  Uncomment the following
    --line if you disagree.

    --`GHC.ghcCatch` \_ -> io $ exitWith (ExitFailure 1)

-----------------------------------------------------------------
--
--              beginMkDependHs
--      Create a temporary file,
--      find the Makefile,
--      slurp through it, etc
--
-----------------------------------------------------------------

data MkDepFiles
  = MkDep { MkDepFiles -> FilePath
mkd_make_file :: FilePath,          -- Name of the makefile
            MkDepFiles -> Maybe Handle
mkd_make_hdl  :: Maybe Handle,      -- Handle for the open makefile
            MkDepFiles -> FilePath
mkd_tmp_file  :: FilePath,          -- Name of the temporary file
            MkDepFiles -> Handle
mkd_tmp_hdl   :: Handle }           -- Handle of the open temporary file

beginMkDependHS :: DynFlags -> IO MkDepFiles
beginMkDependHS :: DynFlags -> IO MkDepFiles
beginMkDependHS DynFlags
dflags = do
        -- open a new temp file in which to stuff the dependency info
        -- as we go along.
  FilePath
tmp_file <- DynFlags -> TempFileLifetime -> FilePath -> IO FilePath
newTempName DynFlags
dflags TempFileLifetime
TFL_CurrentModule FilePath
"dep"
  Handle
tmp_hdl <- FilePath -> IOMode -> IO Handle
openFile FilePath
tmp_file IOMode
WriteMode

        -- open the makefile
  let makefile :: FilePath
makefile = DynFlags -> FilePath
depMakefile DynFlags
dflags
  Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
makefile
  Maybe Handle
mb_make_hdl <-
        if Bool -> Bool
not Bool
exists
        then Maybe Handle -> IO (Maybe Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Handle
forall a. Maybe a
Nothing
        else do
           Handle
makefile_hdl <- FilePath -> IOMode -> IO Handle
openFile FilePath
makefile IOMode
ReadMode

                -- slurp through until we get the magic start string,
                -- copying the contents into dep_makefile
           let slurp :: IO ()
slurp = do
                FilePath
l <- Handle -> IO FilePath
hGetLine Handle
makefile_hdl
                if (FilePath
l FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
depStartMarker)
                        then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        else do Handle -> FilePath -> IO ()
hPutStrLn Handle
tmp_hdl FilePath
l; IO ()
slurp

                -- slurp through until we get the magic end marker,
                -- throwing away the contents
           let chuck :: IO ()
chuck = do
                FilePath
l <- Handle -> IO FilePath
hGetLine Handle
makefile_hdl
                if (FilePath
l FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
depEndMarker)
                        then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        else IO ()
chuck

           IO () -> (IOException -> IO ()) -> IO ()
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO IO ()
slurp
                (\IOException
e -> if IOException -> Bool
isEOFError IOException
e then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else IOException -> IO ()
forall a. IOException -> IO a
ioError IOException
e)
           IO () -> (IOException -> IO ()) -> IO ()
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO IO ()
chuck
                (\IOException
e -> if IOException -> Bool
isEOFError IOException
e then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else IOException -> IO ()
forall a. IOException -> IO a
ioError IOException
e)

           Maybe Handle -> IO (Maybe Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
makefile_hdl)


        -- write the magic marker into the tmp file
  Handle -> FilePath -> IO ()
hPutStrLn Handle
tmp_hdl FilePath
depStartMarker

  MkDepFiles -> IO MkDepFiles
forall (m :: * -> *) a. Monad m => a -> m a
return (MkDep :: FilePath -> Maybe Handle -> FilePath -> Handle -> MkDepFiles
MkDep { mkd_make_file :: FilePath
mkd_make_file = FilePath
makefile, mkd_make_hdl :: Maybe Handle
mkd_make_hdl = Maybe Handle
mb_make_hdl,
                  mkd_tmp_file :: FilePath
mkd_tmp_file  = FilePath
tmp_file, mkd_tmp_hdl :: Handle
mkd_tmp_hdl  = Handle
tmp_hdl})


-----------------------------------------------------------------
--
--              processDeps
--
-----------------------------------------------------------------

processDeps :: DynFlags
            -> HscEnv
            -> [ModuleName]
            -> FilePath
            -> Handle           -- Write dependencies to here
            -> SCC ModSummary
            -> IO ()
-- Write suitable dependencies to handle
-- Always:
--                      this.o : this.hs
--
-- If the dependency is on something other than a .hi file:
--                      this.o this.p_o ... : dep
-- otherwise
--                      this.o ...   : dep.hi
--                      this.p_o ... : dep.p_hi
--                      ...
-- (where .o is $osuf, and the other suffixes come from
-- the cmdline -s options).
--
-- For {-# SOURCE #-} imports the "hi" will be "hi-boot".

processDeps :: DynFlags
-> HscEnv
-> [ModuleName]
-> FilePath
-> Handle
-> SCC ModSummary
-> IO ()
processDeps DynFlags
dflags HscEnv
_ [ModuleName]
_ FilePath
_ Handle
_ (CyclicSCC [ModSummary]
nodes)
  =     -- There shouldn't be any cycles; report them
    GhcException -> IO ()
forall a. GhcException -> IO a
throwGhcExceptionIO (FilePath -> GhcException
ProgramError (DynFlags -> MsgDoc -> FilePath
showSDoc DynFlags
dflags (MsgDoc -> FilePath) -> MsgDoc -> FilePath
forall a b. (a -> b) -> a -> b
$ [ModSummary] -> MsgDoc
GHC.cyclicModuleErr [ModSummary]
nodes))

processDeps DynFlags
dflags HscEnv
hsc_env [ModuleName]
excl_mods FilePath
root Handle
hdl (AcyclicSCC ModSummary
node)
  = do  { let extra_suffixes :: [FilePath]
extra_suffixes = DynFlags -> [FilePath]
depSuffixes DynFlags
dflags
              include_pkg_deps :: Bool
include_pkg_deps = DynFlags -> Bool
depIncludePkgDeps DynFlags
dflags
              src_file :: FilePath
src_file  = ModSummary -> FilePath
msHsFilePath ModSummary
node
              obj_file :: FilePath
obj_file  = ModSummary -> FilePath
msObjFilePath ModSummary
node
              obj_files :: [FilePath]
obj_files = FilePath -> [FilePath] -> [FilePath]
insertSuffixes FilePath
obj_file [FilePath]
extra_suffixes

              do_imp :: SrcSpan
-> IsBootInterface -> Maybe FastString -> ModuleName -> IO ()
do_imp SrcSpan
loc IsBootInterface
is_boot Maybe FastString
pkg_qual ModuleName
imp_mod
                = do { Maybe FilePath
mb_hi <- HscEnv
-> SrcSpan
-> Maybe FastString
-> ModuleName
-> IsBootInterface
-> Bool
-> IO (Maybe FilePath)
findDependency HscEnv
hsc_env SrcSpan
loc Maybe FastString
pkg_qual ModuleName
imp_mod
                                               IsBootInterface
is_boot Bool
include_pkg_deps
                     ; case Maybe FilePath
mb_hi of {
                           Maybe FilePath
Nothing      -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () ;
                           Just FilePath
hi_file -> do
                     { let hi_files :: [FilePath]
hi_files = FilePath -> [FilePath] -> [FilePath]
insertSuffixes FilePath
hi_file [FilePath]
extra_suffixes
                           write_dep :: (FilePath, FilePath) -> IO ()
write_dep (FilePath
obj,FilePath
hi) = FilePath -> Handle -> [FilePath] -> FilePath -> IO ()
writeDependency FilePath
root Handle
hdl [FilePath
obj] FilePath
hi

                        -- Add one dependency for each suffix;
                        -- e.g.         A.o   : B.hi
                        --              A.x_o : B.x_hi
                     ; ((FilePath, FilePath) -> IO ()) -> [(FilePath, FilePath)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath, FilePath) -> IO ()
write_dep ([FilePath]
obj_files [FilePath] -> [FilePath] -> [(FilePath, FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [FilePath]
hi_files) }}}


                -- Emit std dependency of the object(s) on the source file
                -- Something like       A.o : A.hs
        ; FilePath -> Handle -> [FilePath] -> FilePath -> IO ()
writeDependency FilePath
root Handle
hdl [FilePath]
obj_files FilePath
src_file

                -- Emit a dependency for each CPP import
        ; Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DynFlags -> Bool
depIncludeCppDeps DynFlags
dflags) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            -- CPP deps are descovered in the module parsing phase by parsing
            -- comment lines left by the preprocessor.
            -- Note that GHC.parseModule may throw an exception if the module
            -- fails to parse, which may not be desirable (see #16616).
          { Session
session <- IORef HscEnv -> Session
Session (IORef HscEnv -> Session) -> IO (IORef HscEnv) -> IO Session
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HscEnv -> IO (IORef HscEnv)
forall a. a -> IO (IORef a)
newIORef HscEnv
hsc_env
          ; ParsedModule
parsedMod <- Ghc ParsedModule -> Session -> IO ParsedModule
forall a. Ghc a -> Session -> IO a
reflectGhc (ModSummary -> Ghc ParsedModule
forall (m :: * -> *). GhcMonad m => ModSummary -> m ParsedModule
GHC.parseModule ModSummary
node) Session
session
          ; (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> Handle -> [FilePath] -> FilePath -> IO ()
writeDependency FilePath
root Handle
hdl [FilePath]
obj_files)
                  (ParsedModule -> [FilePath]
GHC.pm_extra_src_files ParsedModule
parsedMod)
          }

                -- Emit a dependency for each import

        ; let do_imps :: IsBootInterface
-> [(Maybe FastString, GenLocated SrcSpan ModuleName)] -> IO ()
do_imps IsBootInterface
is_boot [(Maybe FastString, GenLocated SrcSpan ModuleName)]
idecls = [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
                    [ SrcSpan
-> IsBootInterface -> Maybe FastString -> ModuleName -> IO ()
do_imp SrcSpan
loc IsBootInterface
is_boot Maybe FastString
mb_pkg ModuleName
mod
                    | (Maybe FastString
mb_pkg, L SrcSpan
loc ModuleName
mod) <- [(Maybe FastString, GenLocated SrcSpan ModuleName)]
idecls,
                      ModuleName
mod ModuleName -> [ModuleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ModuleName]
excl_mods ]

        ; IsBootInterface
-> [(Maybe FastString, GenLocated SrcSpan ModuleName)] -> IO ()
do_imps IsBootInterface
IsBoot (ModSummary -> [(Maybe FastString, GenLocated SrcSpan ModuleName)]
ms_srcimps ModSummary
node)
        ; IsBootInterface
-> [(Maybe FastString, GenLocated SrcSpan ModuleName)] -> IO ()
do_imps IsBootInterface
NotBoot (ModSummary -> [(Maybe FastString, GenLocated SrcSpan ModuleName)]
ms_imps ModSummary
node)
        }


findDependency  :: HscEnv
                -> SrcSpan
                -> Maybe FastString     -- package qualifier, if any
                -> ModuleName           -- Imported module
                -> IsBootInterface      -- Source import
                -> Bool                 -- Record dependency on package modules
                -> IO (Maybe FilePath)  -- Interface file
findDependency :: HscEnv
-> SrcSpan
-> Maybe FastString
-> ModuleName
-> IsBootInterface
-> Bool
-> IO (Maybe FilePath)
findDependency HscEnv
hsc_env SrcSpan
srcloc Maybe FastString
pkg ModuleName
imp IsBootInterface
is_boot Bool
include_pkg_deps
  = do  {       -- Find the module; this will be fast because
                -- we've done it once during downsweep
          FindResult
r <- HscEnv -> ModuleName -> Maybe FastString -> IO FindResult
findImportedModule HscEnv
hsc_env ModuleName
imp Maybe FastString
pkg
        ; case FindResult
r of
            Found ModLocation
loc Module
_
                -- Home package: just depend on the .hi or hi-boot file
                | Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (ModLocation -> Maybe FilePath
ml_hs_file ModLocation
loc) Bool -> Bool -> Bool
|| Bool
include_pkg_deps
                -> Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (IsBootInterface -> FilePath -> FilePath
addBootSuffix_maybe IsBootInterface
is_boot (ModLocation -> FilePath
ml_hi_file ModLocation
loc)))

                -- Not in this package: we don't need a dependency
                | Bool
otherwise
                -> Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing

            FindResult
fail ->
                let dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
                in ErrMsg -> IO (Maybe FilePath)
forall (io :: * -> *) a. MonadIO io => ErrMsg -> io a
throwOneError (ErrMsg -> IO (Maybe FilePath)) -> ErrMsg -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ DynFlags -> SrcSpan -> MsgDoc -> ErrMsg
mkPlainErrMsg DynFlags
dflags SrcSpan
srcloc (MsgDoc -> ErrMsg) -> MsgDoc -> ErrMsg
forall a b. (a -> b) -> a -> b
$
                        DynFlags -> ModuleName -> FindResult -> MsgDoc
cannotFindModule DynFlags
dflags ModuleName
imp FindResult
fail
        }

-----------------------------
writeDependency :: FilePath -> Handle -> [FilePath] -> FilePath -> IO ()
-- (writeDependency r h [t1,t2] dep) writes to handle h the dependency
--      t1 t2 : dep
writeDependency :: FilePath -> Handle -> [FilePath] -> FilePath -> IO ()
writeDependency FilePath
root Handle
hdl [FilePath]
targets FilePath
dep
  = do let -- We need to avoid making deps on
           --     c:/foo/...
           -- on cygwin as make gets confused by the :
           -- Making relative deps avoids some instances of this.
           dep' :: FilePath
dep' = FilePath -> FilePath -> FilePath
makeRelative FilePath
root FilePath
dep
           forOutput :: FilePath -> FilePath
forOutput = FilePath -> FilePath
escapeSpaces (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Direction -> FilePath -> FilePath
reslash Direction
Forwards (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
normalise
           output :: FilePath
output = [FilePath] -> FilePath
unwords ((FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
forOutput [FilePath]
targets) FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" : " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forOutput FilePath
dep'
       Handle -> FilePath -> IO ()
hPutStrLn Handle
hdl FilePath
output

-----------------------------
insertSuffixes
        :: FilePath     -- Original filename;   e.g. "foo.o"
        -> [String]     -- Suffix prefixes      e.g. ["x_", "y_"]
        -> [FilePath]   -- Zapped filenames     e.g. ["foo.x_o", "foo.y_o"]
        -- Note that the extra bit gets inserted *before* the old suffix
        -- We assume the old suffix contains no dots, so we know where to
        -- split it
insertSuffixes :: FilePath -> [FilePath] -> [FilePath]
insertSuffixes FilePath
file_name [FilePath]
extras
  = [ FilePath
basename FilePath -> FilePath -> FilePath
<.> (FilePath
extra FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
suffix) | FilePath
extra <- [FilePath]
extras ]
  where
    (FilePath
basename, FilePath
suffix) = case FilePath -> (FilePath, FilePath)
splitExtension FilePath
file_name of
                         -- Drop the "." from the extension
                         (FilePath
b, FilePath
s) -> (FilePath
b, Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
s)


-----------------------------------------------------------------
--
--              endMkDependHs
--      Complete the makefile, close the tmp file etc
--
-----------------------------------------------------------------

endMkDependHS :: DynFlags -> MkDepFiles -> IO ()

endMkDependHS :: DynFlags -> MkDepFiles -> IO ()
endMkDependHS DynFlags
dflags
   (MkDep { mkd_make_file :: MkDepFiles -> FilePath
mkd_make_file = FilePath
makefile, mkd_make_hdl :: MkDepFiles -> Maybe Handle
mkd_make_hdl =  Maybe Handle
makefile_hdl,
            mkd_tmp_file :: MkDepFiles -> FilePath
mkd_tmp_file  = FilePath
tmp_file, mkd_tmp_hdl :: MkDepFiles -> Handle
mkd_tmp_hdl  =  Handle
tmp_hdl })
  = do
  -- write the magic marker into the tmp file
  Handle -> FilePath -> IO ()
hPutStrLn Handle
tmp_hdl FilePath
depEndMarker

  case Maybe Handle
makefile_hdl of
     Maybe Handle
Nothing  -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     Just Handle
hdl -> do

          -- slurp the rest of the original makefile and copy it into the output
        let slurp :: IO ()
slurp = do
                FilePath
l <- Handle -> IO FilePath
hGetLine Handle
hdl
                Handle -> FilePath -> IO ()
hPutStrLn Handle
tmp_hdl FilePath
l
                IO ()
slurp

        IO () -> (IOException -> IO ()) -> IO ()
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO IO ()
slurp
                (\IOException
e -> if IOException -> Bool
isEOFError IOException
e then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else IOException -> IO ()
forall a. IOException -> IO a
ioError IOException
e)

        Handle -> IO ()
hClose Handle
hdl

  Handle -> IO ()
hClose Handle
tmp_hdl  -- make sure it's flushed

        -- Create a backup of the original makefile
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Handle -> Bool
forall a. Maybe a -> Bool
isJust Maybe Handle
makefile_hdl)
       (DynFlags -> FilePath -> FilePath -> FilePath -> IO ()
SysTools.copy DynFlags
dflags (FilePath
"Backing up " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
makefile)
          FilePath
makefile (FilePath
makefileFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
".bak"))

        -- Copy the new makefile in place
  DynFlags -> FilePath -> FilePath -> FilePath -> IO ()
SysTools.copy DynFlags
dflags FilePath
"Installing new makefile" FilePath
tmp_file FilePath
makefile


-----------------------------------------------------------------
--              Module cycles
-----------------------------------------------------------------

dumpModCycles :: DynFlags -> ModuleGraph -> IO ()
dumpModCycles :: DynFlags -> ModuleGraph -> IO ()
dumpModCycles DynFlags
dflags ModuleGraph
module_graph
  | Bool -> Bool
not (DumpFlag -> DynFlags -> Bool
dopt DumpFlag
Opt_D_dump_mod_cycles DynFlags
dflags)
  = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  | [[ModSummary]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[ModSummary]]
cycles
  = DynFlags -> MsgDoc -> IO ()
putMsg DynFlags
dflags (FilePath -> MsgDoc
text FilePath
"No module cycles")

  | Bool
otherwise
  = DynFlags -> MsgDoc -> IO ()
putMsg DynFlags
dflags (MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (FilePath -> MsgDoc
text FilePath
"Module cycles found:") Int
2 MsgDoc
pp_cycles)
  where

    cycles :: [[ModSummary]]
    cycles :: [[ModSummary]]
cycles =
      [ [ModSummary]
c | CyclicSCC [ModSummary]
c <- Bool -> ModuleGraph -> Maybe ModuleName -> [SCC ModSummary]
GHC.topSortModuleGraph Bool
True ModuleGraph
module_graph Maybe ModuleName
forall a. Maybe a
Nothing ]

    pp_cycles :: MsgDoc
pp_cycles = [MsgDoc] -> MsgDoc
vcat [ (FilePath -> MsgDoc
text FilePath
"---------- Cycle" MsgDoc -> MsgDoc -> MsgDoc
<+> Int -> MsgDoc
int Int
n MsgDoc -> MsgDoc -> MsgDoc
<+> PtrString -> MsgDoc
ptext (FilePath -> PtrString
sLit FilePath
"----------"))
                        MsgDoc -> MsgDoc -> MsgDoc
$$ [ModSummary] -> MsgDoc
pprCycle [ModSummary]
c MsgDoc -> MsgDoc -> MsgDoc
$$ MsgDoc
blankLine
                     | (Int
n,[ModSummary]
c) <- [Int
1..] [Int] -> [[ModSummary]] -> [(Int, [ModSummary])]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [[ModSummary]]
cycles ]

pprCycle :: [ModSummary] -> SDoc
-- Print a cycle, but show only the imports within the cycle
pprCycle :: [ModSummary] -> MsgDoc
pprCycle [ModSummary]
summaries = SCC ModSummary -> MsgDoc
pp_group ([ModSummary] -> SCC ModSummary
forall vertex. [vertex] -> SCC vertex
CyclicSCC [ModSummary]
summaries)
  where
    cycle_mods :: [ModuleName]  -- The modules in this cycle
    cycle_mods :: [ModuleName]
cycle_mods = (ModSummary -> ModuleName) -> [ModSummary] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (Module -> ModuleName)
-> (ModSummary -> Module) -> ModSummary -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> Module
ms_mod) [ModSummary]
summaries

    pp_group :: SCC ModSummary -> MsgDoc
pp_group (AcyclicSCC ModSummary
ms) = ModSummary -> MsgDoc
pp_ms ModSummary
ms
    pp_group (CyclicSCC [ModSummary]
mss)
        = ASSERT( not (null boot_only) )
                -- The boot-only list must be non-empty, else there would
                -- be an infinite chain of non-boot imports, and we've
                -- already checked for that in processModDeps
          ModSummary -> MsgDoc
pp_ms ModSummary
loop_breaker MsgDoc -> MsgDoc -> MsgDoc
$$ [MsgDoc] -> MsgDoc
vcat ((SCC ModSummary -> MsgDoc) -> [SCC ModSummary] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map SCC ModSummary -> MsgDoc
pp_group [SCC ModSummary]
groups)
        where
          ([ModSummary]
boot_only, [ModSummary]
others) = (ModSummary -> Bool)
-> [ModSummary] -> ([ModSummary], [ModSummary])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ModSummary -> Bool
is_boot_only [ModSummary]
mss
          is_boot_only :: ModSummary -> Bool
is_boot_only ModSummary
ms = Bool -> Bool
not ((GenLocated SrcSpan ModuleName -> Bool)
-> [GenLocated SrcSpan ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any GenLocated SrcSpan ModuleName -> Bool
in_group (((Maybe FastString, GenLocated SrcSpan ModuleName)
 -> GenLocated SrcSpan ModuleName)
-> [(Maybe FastString, GenLocated SrcSpan ModuleName)]
-> [GenLocated SrcSpan ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe FastString, GenLocated SrcSpan ModuleName)
-> GenLocated SrcSpan ModuleName
forall a b. (a, b) -> b
snd (ModSummary -> [(Maybe FastString, GenLocated SrcSpan ModuleName)]
ms_imps ModSummary
ms)))
          in_group :: GenLocated SrcSpan ModuleName -> Bool
in_group (L SrcSpan
_ ModuleName
m) = ModuleName
m ModuleName -> [ModuleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ModuleName]
group_mods
          group_mods :: [ModuleName]
group_mods = (ModSummary -> ModuleName) -> [ModSummary] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (Module -> ModuleName)
-> (ModSummary -> Module) -> ModSummary -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> Module
ms_mod) [ModSummary]
mss

          loop_breaker :: ModSummary
loop_breaker = [ModSummary] -> ModSummary
forall a. [a] -> a
head [ModSummary]
boot_only
          all_others :: [ModSummary]
all_others   = [ModSummary] -> [ModSummary]
forall a. [a] -> [a]
tail [ModSummary]
boot_only [ModSummary] -> [ModSummary] -> [ModSummary]
forall a. [a] -> [a] -> [a]
++ [ModSummary]
others
          groups :: [SCC ModSummary]
groups =
            Bool -> ModuleGraph -> Maybe ModuleName -> [SCC ModSummary]
GHC.topSortModuleGraph Bool
True ([ModSummary] -> ModuleGraph
mkModuleGraph [ModSummary]
all_others) Maybe ModuleName
forall a. Maybe a
Nothing

    pp_ms :: ModSummary -> MsgDoc
pp_ms ModSummary
summary = FilePath -> MsgDoc
text FilePath
mod_str MsgDoc -> MsgDoc -> MsgDoc
<> FilePath -> MsgDoc
text (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take (Int
20 Int -> Int -> Int
forall a. Num a => a -> a -> a
- FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
mod_str) (Char -> FilePath
forall a. a -> [a]
repeat Char
' '))
                       MsgDoc -> MsgDoc -> MsgDoc
<+> (MsgDoc -> [GenLocated SrcSpan ModuleName] -> MsgDoc
pp_imps MsgDoc
empty (((Maybe FastString, GenLocated SrcSpan ModuleName)
 -> GenLocated SrcSpan ModuleName)
-> [(Maybe FastString, GenLocated SrcSpan ModuleName)]
-> [GenLocated SrcSpan ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe FastString, GenLocated SrcSpan ModuleName)
-> GenLocated SrcSpan ModuleName
forall a b. (a, b) -> b
snd (ModSummary -> [(Maybe FastString, GenLocated SrcSpan ModuleName)]
ms_imps ModSummary
summary)) MsgDoc -> MsgDoc -> MsgDoc
$$
                            MsgDoc -> [GenLocated SrcSpan ModuleName] -> MsgDoc
pp_imps (FilePath -> MsgDoc
text FilePath
"{-# SOURCE #-}") (((Maybe FastString, GenLocated SrcSpan ModuleName)
 -> GenLocated SrcSpan ModuleName)
-> [(Maybe FastString, GenLocated SrcSpan ModuleName)]
-> [GenLocated SrcSpan ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe FastString, GenLocated SrcSpan ModuleName)
-> GenLocated SrcSpan ModuleName
forall a b. (a, b) -> b
snd (ModSummary -> [(Maybe FastString, GenLocated SrcSpan ModuleName)]
ms_srcimps ModSummary
summary)))
        where
          mod_str :: FilePath
mod_str = ModuleName -> FilePath
moduleNameString (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (ModSummary -> Module
ms_mod ModSummary
summary))

    pp_imps :: SDoc -> [Located ModuleName] -> SDoc
    pp_imps :: MsgDoc -> [GenLocated SrcSpan ModuleName] -> MsgDoc
pp_imps MsgDoc
_    [] = MsgDoc
empty
    pp_imps MsgDoc
what [GenLocated SrcSpan ModuleName]
lms
        = case [ModuleName
m | L SrcSpan
_ ModuleName
m <- [GenLocated SrcSpan ModuleName]
lms, ModuleName
m ModuleName -> [ModuleName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ModuleName]
cycle_mods] of
            [] -> MsgDoc
empty
            [ModuleName]
ms -> MsgDoc
what MsgDoc -> MsgDoc -> MsgDoc
<+> FilePath -> MsgDoc
text FilePath
"imports" MsgDoc -> MsgDoc -> MsgDoc
<+>
                                (ModuleName -> MsgDoc) -> [ModuleName] -> MsgDoc
forall a. (a -> MsgDoc) -> [a] -> MsgDoc
pprWithCommas ModuleName -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [ModuleName]
ms

-----------------------------------------------------------------
--
--              Flags
--
-----------------------------------------------------------------

depStartMarker, depEndMarker :: String
depStartMarker :: FilePath
depStartMarker = FilePath
"# DO NOT DELETE: Beginning of Haskell dependencies"
depEndMarker :: FilePath
depEndMarker   = FilePath
"# DO NOT DELETE: End of Haskell dependencies"