Refactor autogen modules

This commit modularises the logic for generation of autogenerated files
and autogenerated modules.

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