@@ -7,9 +7,11 @@ module Distribution.Simple.GHC.Build.Link where
7
7
import Distribution.Compat.Prelude
8
8
import Prelude ()
9
9
10
+ import Control.Monad
10
11
import Control.Monad.IO.Class
11
12
import qualified Data.ByteString.Lazy.Char8 as BS
12
13
import qualified Data.Set as Set
14
+ import Distribution.Backpack
13
15
import Distribution.Compat.Binary (encode )
14
16
import Distribution.Compat.ResponseFile
15
17
import Distribution.InstalledPackageInfo (InstalledPackageInfo )
@@ -23,6 +25,7 @@ import Distribution.Pretty
23
25
import Distribution.Simple.Build.Inputs
24
26
import Distribution.Simple.BuildPaths
25
27
import Distribution.Simple.Compiler
28
+ import Distribution.Simple.Errors
26
29
import Distribution.Simple.GHC.Build.Modules
27
30
import Distribution.Simple.GHC.Build.Utils (exeTargetName , flibBuildName , flibTargetName , withDynFLib )
28
31
import Distribution.Simple.GHC.ImplInfo
@@ -740,6 +743,7 @@ runReplOrWriteFlags
740
743
runReplOrWriteFlags ghcProg lbi rflags ghcOpts pkg_name target =
741
744
let bi = componentBuildInfo $ targetComponent target
742
745
clbi = targetCLBI target
746
+ cname = componentName (targetComponent target)
743
747
comp = compiler lbi
744
748
platform = hostPlatform lbi
745
749
common = configCommonFlags $ configFlags lbi
@@ -761,28 +765,40 @@ runReplOrWriteFlags ghcProg lbi rflags ghcOpts pkg_name target =
761
765
Flag out_dir -> do
762
766
let uid = componentUnitId clbi
763
767
this_unit = prettyShow uid
768
+ getOpenModName (OpenModule _ mn) = Just mn
769
+ getOpenModName (OpenModuleVar {}) = Nothing
764
770
reexported_modules =
765
- [ mn | LibComponentLocalBuildInfo {componentExposedModules = exposed_mods} <- [clbi], IPI. ExposedModule mn (Just {} ) <- exposed_mods
771
+ [ (from_mn, to_mn) | LibComponentLocalBuildInfo {componentExposedModules = exposed_mods} <- [clbi], IPI. ExposedModule to_mn (Just m ) <- exposed_mods, Just from_mn <- [getOpenModName m]
766
772
]
773
+ renderReexportedModule (from_mn, to_mn) =
774
+ if reexportedAsSupported comp
775
+ then pure $ prettyShow from_mn ++ " as " ++ prettyShow to_mn
776
+ else
777
+ if from_mn == to_mn
778
+ then pure $ prettyShow to_mn
779
+ else dieWithException verbosity (MultiReplDoesNotSupportComplexReexportedModules pkg_name cname)
767
780
hidden_modules = otherModules bi
768
- extra_opts =
769
- concat $
770
- [ [" -this-package-name" , prettyShow pkg_name]
771
- , case mbWorkDir of
772
- Nothing -> []
773
- Just wd -> [" -working-dir" , getSymbolicPath wd]
774
- ]
775
- ++ [ [" -reexported-module" , prettyShow m] | m <- reexported_modules
776
- ]
777
- ++ [ [" -hidden-module" , prettyShow m] | m <- hidden_modules
778
- ]
781
+ render_extra_opts = do
782
+ rexp_mods <- mapM renderReexportedModule reexported_modules
783
+ pure $
784
+ concat $
785
+ [ [" -this-package-name" , prettyShow pkg_name]
786
+ , case mbWorkDir of
787
+ Nothing -> []
788
+ Just wd -> [" -working-dir" , getSymbolicPath wd]
789
+ ]
790
+ ++ [ [" -reexported-module" , m] | m <- rexp_mods
791
+ ]
792
+ ++ [ [" -hidden-module" , prettyShow m] | m <- hidden_modules
793
+ ]
779
794
-- Create "paths" subdirectory if it doesn't exist. This is where we write
780
795
-- information about how the PATH was augmented.
781
796
createDirectoryIfMissing False (out_dir </> " paths" )
782
797
-- Write out the PATH information into `paths` subdirectory.
783
798
writeFileAtomic (out_dir </> " paths" </> this_unit) (encode ghcProg)
784
799
-- Write out options for this component into a file ready for loading into
785
800
-- the multi-repl
801
+ extra_opts <- render_extra_opts
786
802
writeFileAtomic (out_dir </> this_unit) $
787
803
BS. pack $
788
804
escapeArgs $
0 commit comments