diff --git a/Cabal/src/Distribution/Simple/Build.hs b/Cabal/src/Distribution/Simple/Build.hs
index afe571d71960675b0d2f17928989cffca213ec2a..bc6ac7ae6be0dfe95b9c90015dc5be4ef1f2834a 100644
--- a/Cabal/src/Distribution/Simple/Build.hs
+++ b/Cabal/src/Distribution/Simple/Build.hs
@@ -20,12 +20,22 @@
-- compiler-specific actions. It does do some non-compiler specific bits like
-- running pre-processors.
module Distribution.Simple.Build
- ( build
+ ( -- * Build
+ build
+
+ -- * Repl
, repl
, startInterpreter
- , createInternalPackageDB
+
+ -- * Build preparation
, preBuildComponent
+ , AutogenFile (..)
+ , AutogenFileContents
+ , writeBuiltinAutogenFiles
, writeAutogenFiles
+
+ -- * Internal package database creation
+ , createInternalPackageDB
) where
import Distribution.Compat.Prelude
@@ -62,6 +72,7 @@ import qualified Distribution.Simple.Program.HcPkg as HcPkg
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import qualified Distribution.InstalledPackageInfo as IPI
+import Distribution.ModuleName (ModuleName)
import qualified Distribution.ModuleName as ModuleName
import Distribution.PackageDescription
import Distribution.Simple.Compiler
@@ -85,6 +96,7 @@ import Distribution.Simple.ShowBuildInfo
import Distribution.Simple.Test.LibV09
import Distribution.Simple.Utils
import Distribution.Utils.Json
+import Distribution.Utils.ShortText (ShortText, fromShortText, toShortText)
import Distribution.Pretty
import Distribution.System
@@ -95,6 +107,7 @@ import Distribution.Compat.Graph (IsNode (..))
import Control.Monad
import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Map as Map
import Distribution.Simple.Errors
import System.Directory (doesFileExist, getCurrentDirectory, removeFile)
import System.FilePath (takeDirectory, (<.>), (</>))
@@ -927,55 +940,110 @@ preBuildComponent verbosity lbi tgt = do
let pkg_descr = localPkgDescr lbi
clbi = targetCLBI tgt
createDirectoryIfMissingVerbose verbosity True (componentBuildDir lbi clbi)
- writeAutogenFiles verbosity pkg_descr lbi clbi
+ writeBuiltinAutogenFiles verbosity pkg_descr lbi clbi
--- | Generate and write out the Paths_<pkg>.hs, PackageInfo_<pkg>.hs, and cabal_macros.h files
-writeAutogenFiles
+-- | Generate and write to disk all built-in autogenerated files
+-- for the specified component. These files will be put in the
+-- autogenerated module directory for this component
+-- (see 'autogenComponentsModuleDir').
+--
+-- This includes:
+--
+-- - @Paths_<pkg>.hs@,
+-- - @PackageInfo_<pkg>.hs@,
+-- - Backpack signature files for components that are not fully instantiated,
+-- - @cabal_macros.h@.
+writeBuiltinAutogenFiles
:: Verbosity
-> PackageDescription
-> LocalBuildInfo
-> ComponentLocalBuildInfo
-> IO ()
-writeAutogenFiles verbosity pkg lbi clbi = do
- createDirectoryIfMissingVerbose verbosity True (autogenComponentModulesDir lbi clbi)
-
- let pathsModulePath =
- autogenComponentModulesDir lbi clbi
- </> ModuleName.toFilePath (autogenPathsModuleName pkg) <.> "hs"
- pathsModuleDir = takeDirectory pathsModulePath
- -- Ensure that the directory exists!
- createDirectoryIfMissingVerbose verbosity True pathsModuleDir
- rewriteFileEx verbosity pathsModulePath (generatePathsModule pkg lbi clbi)
-
- let packageInfoModulePath =
- autogenComponentModulesDir lbi clbi
- </> ModuleName.toFilePath (autogenPackageInfoModuleName pkg) <.> "hs"
- packageInfoModuleDir = takeDirectory packageInfoModulePath
- -- Ensure that the directory exists!
- createDirectoryIfMissingVerbose verbosity True packageInfoModuleDir
- rewriteFileEx verbosity packageInfoModulePath (generatePackageInfoModule pkg lbi)
-
- -- TODO: document what we're doing here, and move it to its own function
+writeBuiltinAutogenFiles verbosity pkg lbi clbi =
+ writeAutogenFiles verbosity lbi clbi $ builtinAutogenFiles pkg lbi clbi
+
+-- | Built-in autogenerated files and their contents. This includes:
+--
+-- - @Paths_<pkg>.hs@,
+-- - @PackageInfo_<pkg>.hs@,
+-- - Backpack signature files for components that are not fully instantiated,
+-- - @cabal_macros.h@.
+builtinAutogenFiles
+ :: PackageDescription
+ -> LocalBuildInfo
+ -> ComponentLocalBuildInfo
+ -> Map AutogenFile AutogenFileContents
+builtinAutogenFiles pkg lbi clbi =
+ Map.insert pathsFile pathsContents $
+ Map.insert packageInfoFile packageInfoContents $
+ Map.insert cppHeaderFile cppHeaderContents $
+ emptySignatureModules clbi
+ where
+ pathsFile = AutogenModule (autogenPathsModuleName pkg) (Suffix "hs")
+ pathsContents = toUTF8LBS $ generatePathsModule pkg lbi clbi
+ packageInfoFile = AutogenModule (autogenPackageInfoModuleName pkg) (Suffix "hs")
+ packageInfoContents = toUTF8LBS $ generatePackageInfoModule pkg lbi
+ cppHeaderFile = AutogenFile $ toShortText cppHeaderName
+ cppHeaderContents = toUTF8LBS $ generateCabalMacrosHeader pkg lbi clbi
+
+-- | An empty @".hsig"@ Backpack signature module for each requirement, so that
+-- GHC has a source file to look at it when it needs to typecheck
+-- a signature. It's harmless to generate these modules, even when
+-- there is a real @hsig@ file written by the user, since
+-- include path ordering ensures that the real @hsig@ file
+-- will always be picked up before the autogenerated one.
+emptySignatureModules
+ :: ComponentLocalBuildInfo
+ -> Map AutogenFile AutogenFileContents
+emptySignatureModules clbi =
case clbi of
LibComponentLocalBuildInfo{componentInstantiatedWith = insts} ->
- -- Write out empty hsig files for all requirements, so that GHC
- -- has a source file to look at it when it needs to typecheck
- -- a signature. It's harmless to write these out even when
- -- there is a real hsig file written by the user, since
- -- include path ordering ensures that the real hsig file
- -- will always be picked up before the autogenerated one.
- for_ (map fst insts) $ \mod_name -> do
- let sigPath =
- autogenComponentModulesDir lbi clbi
- </> ModuleName.toFilePath mod_name <.> "hsig"
- createDirectoryIfMissingVerbose verbosity True (takeDirectory sigPath)
- rewriteFileEx verbosity sigPath $
- "{-# OPTIONS_GHC -w #-}\n"
- ++ "{-# LANGUAGE NoImplicitPrelude #-}\n"
- ++ "signature "
- ++ prettyShow mod_name
- ++ " where"
- _ -> return ()
-
- let cppHeaderPath = autogenComponentModulesDir lbi clbi </> cppHeaderName
- rewriteFileEx verbosity cppHeaderPath (generateCabalMacrosHeader pkg lbi clbi)
+ Map.fromList
+ [ ( AutogenModule modName (Suffix "hsig")
+ , emptyHsigFile modName
+ )
+ | (modName, _) <- insts
+ ]
+ _ -> Map.empty
+ where
+ emptyHsigFile :: ModuleName -> AutogenFileContents
+ emptyHsigFile modName =
+ toUTF8LBS $
+ "{-# OPTIONS_GHC -w #-}\n"
+ ++ "{-# LANGUAGE NoImplicitPrelude #-}\n"
+ ++ "signature "
+ ++ prettyShow modName
+ ++ " where"
+
+data AutogenFile
+ = AutogenModule !ModuleName !Suffix
+ | AutogenFile !ShortText
+ deriving (Show, Eq, Ord)
+
+-- | A representation of the contents of an autogenerated file.
+type AutogenFileContents = LBS.ByteString
+
+-- | Write the given autogenerated files in the autogenerated modules
+-- directory for the component.
+writeAutogenFiles
+ :: Verbosity
+ -> LocalBuildInfo
+ -> ComponentLocalBuildInfo
+ -> Map AutogenFile AutogenFileContents
+ -> IO ()
+writeAutogenFiles verbosity lbi clbi autogenFiles = do
+ -- Ensure that the overall autogenerated files directory exists.
+ createDirectoryIfMissingVerbose verbosity True autogenDir
+ for_ (Map.assocs autogenFiles) $ \(file, contents) -> do
+ let path = case file of
+ AutogenModule modName (Suffix ext) ->
+ autogenDir </> ModuleName.toFilePath modName <.> ext
+ AutogenFile fileName ->
+ autogenDir </> fromShortText fileName
+ dir = takeDirectory path
+ -- Ensure that the directory subtree for this autogenerated file exists.
+ createDirectoryIfMissingVerbose verbosity True dir
+ -- Write the contents of the file.
+ rewriteFileLBS verbosity path contents
+ where
+ autogenDir = autogenComponentModulesDir lbi clbi