Reexported modules, take 3

haskell/private/actions/compile.bzl

@@ -305,11 +305,12 @@ def compile_binary(hs, cc, java, dep_info, srcs, ls_modules, import_dir_map, ext
             target_unique_name(hs, "exposed-modules"),
         )
         hs.actions.run(
-            inputs = [c.interfaces_dir],
+            inputs = [c.interfaces_dir, hs.toolchain.global_pkg_db],
             outputs = [exposed_modules_file],
             executable = ls_modules,
             arguments = [
                 c.interfaces_dir.path,
+                hs.toolchain.global_pkg_db.path,
                 "/dev/null",  # no hidden modules
                 "/dev/null",  # no reexported modules
                 exposed_modules_file.path,
@@ -375,13 +376,15 @@ def compile_library(hs, cc, java, dep_info, srcs, ls_modules, other_modules, exp
         hs.actions.run(
             inputs = [
                 c.interfaces_dir,
+                hs.toolchain.global_pkg_db,
                 hidden_modules_file,
                 reexported_modules_file,
             ],
             outputs = [exposed_modules_file],
             executable = ls_modules,
             arguments = [
                 c.interfaces_dir.path,
+                hs.toolchain.global_pkg_db.path,
                 hidden_modules_file.path,
                 reexported_modules_file.path,
                 exposed_modules_file.path,

haskell/private/ls_modules.py

@@ -1,20 +1,63 @@
 #!/usr/bin/env python
+#
+# Create a list of exposed modules (including reexported modules)
+# given a directory full of interface files and the content of the
+# global package database (to mine the versions of all prebuilt
+# dependencies). The exposed modules are filtered using a provided
+# list of hidden modules, and augmented with reexport declarations.
 
+import collections
 import fnmatch
 import itertools
 import os
+import re
 import sys
 
-if len(sys.argv) < 3:
-    sys.exit("Usage: %s <DIRECTORY> <HIDDEN_MODS_FILE> <REEXPORTED_MODS_FILE> <RESULT_FILE>" % sys.argv[0])
+if len(sys.argv) != 6:
+    sys.exit("Usage: %s <DIRECTORY> <GLOBAL_PKG_DB> <HIDDEN_MODS_FILE> <REEXPORTED_MODS_FILE> <RESULT_FILE>" % sys.argv[0])
 
 root = sys.argv[1]
-with open(sys.argv[2], "r") as f:
+global_pkg_db_dump = sys.argv[2]
+hidden_modules_file = sys.argv[3]
+reexported_modules_file = sys.argv[4]
+results_file = sys.argv[5]
+
+with open(global_pkg_db_dump, "r") as f:
+    names = [line.split()[1] for line in f if line.startswith("name:")]
+    f.seek(0)
+    ids = [line.split()[1] for line in f if line.startswith("id:")]
+
+    # A few sanity checks.
+    assert len(names) == len(ids)
+    if len(names) != len(set(names)):
+        duplicates = [
+            name for name, count in collections.Counter(names).items()
+            if count > 1
+        ]
+        sys.exit(
+            "\n".join([
+                "Multiple versions of the following packages installed: ",
+                ", ".join(duplicates),
+                "\nThis is not currently supported.",
+            ])
+        )
+
+    pkg_ids_map = dict(zip(names, ids))
+
+with open(hidden_modules_file, "r") as f:
     hidden_modules = [mod.strip() for mod in f.read().split(",")]
-with open(sys.argv[3], "r") as f:
-    reexported_modules = (
+
+with open(reexported_modules_file, "r") as f:
+    raw_reexported_modules = (
         mod.strip() for mod in f.read().split(",") if mod.strip()
     )
+    # Substitute package ids for package names in reexports, because
+    # GHC really wants package ids.
+    regexp = re.compile("from (%s):" % "|".join(map(re.escape, pkg_ids_map)))
+    reexported_modules = (
+        regexp.sub(lambda match: "from %s:" % pkg_ids_map[match.group(1)], mod)
+        for mod in raw_reexported_modules
+    )
 
 interface_files = (
     os.path.join(path, f)
@@ -33,6 +76,6 @@
     if m not in hidden_modules
 )
 
-with open(sys.argv[4], "w") as f:
+with open(results_file, "w") as f:
     sys.stdout = f
     print(", ".join(itertools.chain(exposed_modules, reexported_modules)))

haskell/toolchain.bzl

@@ -102,6 +102,21 @@ def _haskell_toolchain_impl(ctx):
         ),
     )
 
+    # Get the versions of every prebuilt package.
+    for t in ctx.files.tools:
+        if t.basename == "ghc-pkg":
+            ghc_pkg = t
+    pkgdb_file = ctx.actions.declare_file("ghc-global-pkgdb")
+    ctx.actions.run_shell(
+        inputs = [ghc_pkg],
+        outputs = [pkgdb_file],
+        mnemonic = "HaskellPackageDatabaseDump",
+        command = "{ghc_pkg} dump --global > {output}".format(
+            ghc_pkg = ghc_pkg.path,
+            output = pkgdb_file.path,
+        ),
+    )
+
     # NOTE The only way to let various executables know where other
     # executables are located is often only via the PATH environment variable.
     # For example, ghc uses gcc which is found on PATH. This forces us provide
@@ -266,6 +281,7 @@ def _haskell_toolchain_impl(ctx):
             visible_bin_path = set.to_list(symlinks)[0].dirname,
             is_darwin = ctx.attr.is_darwin,
             version = ctx.attr.version,
+            global_pkg_db = pkgdb_file,
         ),
         # Make everyone implicitly depend on the version_file, to force
         # the version check.

tests/library-exports/BUILD

@@ -9,8 +9,8 @@ load(
 haskell_library(
     name = "sublib",
     srcs = ["TestSubLib.hs"],
-    exports = {"//tests:base": "Data.List as SubLib.List"},
-    deps = ["//tests:base"],
+    exports = {"//tests:containers": "Data.Map as SubLib.Map"},
+    deps = ["//tests:base", "//tests:containers"],
 )
 
 haskell_library(
@@ -19,7 +19,7 @@ haskell_library(
     deps = ["//tests:base", ":sublib"],
     exports = {
         ":sublib": "TestSubLib",
-        "//tests:base": "Data.List as Lib.List",
+        "//tests:containers": "Data.Map as Lib.Map",
     },
 )
 

tests/library-exports/Bin.hs

@@ -1,7 +1,7 @@
 module Main (main) where
 
 import TestSubLib (messageEnd)
-import Lib.List
+import Lib.Map
 
 main :: IO ()
-main = putStrLn $ Lib.List.tail messageEnd
+main = print $ Lib.Map.singleton 1 messageEnd

tests/library-exports/TestLib.hs

@@ -1,7 +1,7 @@
 module TestLib (testMessage) where
 
 import TestSubLib (messageEnd)
-import SubLib.List
+import SubLib.Map
 
 testMessage :: String
-testMessage = "hello " ++ SubLib.List.nub messageEnd
+testMessage = "hello " ++ messageEnd