GHC: Shorten linker library search paths (#1964)

bazel_tools/haskell-windows-library-dirs.patch

@@ -0,0 +1,324 @@
+Linking can fail on Windows if the library search paths exceed the Windows path
+length limit. This typically happens because GHC combines relative paths that
+include up-level references (..) without normalizing the resulting paths. This
+patch adds a gcc wrapper that normalizes library search paths before passing
+them on.
+diff --git a/haskell/BUILD.bazel b/haskell/BUILD.bazel
+index f08921a..c936795 100644
+--- a/haskell/BUILD.bazel
++++ b/haskell/BUILD.bazel
+@@ -2,6 +2,10 @@ load(
+     "@io_tweag_rules_haskell//haskell:haskell.bzl",
+     "haskell_toolchain_libraries",
+ )
++load(
++    "@io_tweag_rules_haskell//haskell:private/cc_wrapper.bzl",
++    "cc_wrapper",
++)
+ 
+ exports_files(
+     glob(["*.bzl"]) + [
+@@ -10,6 +14,7 @@ exports_files(
+         "private/coverage_wrapper.sh.tpl",
+         "private/ghci_repl_wrapper.sh",
+         "private/haddock_wrapper.sh.tpl",
++        "private/cc_wrapper.py.tpl",
+         "private/osx_cc_wrapper.sh.tpl",
+         "private/pkgdb_to_bzl.py",
+     ],
+@@ -21,6 +26,11 @@ exports_files(
+     visibility = ["//tests/unit-tests:__pkg__"],
+ )
+ 
++cc_wrapper(
++    name = "cc_wrapper",
++    visibility = ["//visibility:public"],
++)
++
+ py_binary(
+     name = "pkgdb_to_bzl",
+     srcs = ["private/pkgdb_to_bzl.py"],
+diff --git a/haskell/cc.bzl b/haskell/cc.bzl
+index 99e70c6..1a53e68 100644
+--- a/haskell/cc.bzl
++++ b/haskell/cc.bzl
+@@ -114,8 +114,8 @@ def cc_interop_info(ctx):
+             cc_wrapper,
+         ]
+     else:
+-        cc = cc_toolchain.compiler_executable()
+-        cc_files = ctx.files._cc_toolchain
++        cc = hs_toolchain.cc_wrapper.executable.path
++        cc_files = ctx.files._cc_toolchain + hs_toolchain.cc_wrapper.inputs.to_list()
+ 
+     # XXX Workaround https://github.com/bazelbuild/bazel/issues/6876.
+     linker_flags = [flag for flag in linker_flags if flag not in ["-shared"]]
+diff --git a/haskell/private/cc_wrapper.bzl b/haskell/private/cc_wrapper.bzl
+new file mode 100644
+index 0000000..ec944e5
+--- /dev/null
++++ b/haskell/private/cc_wrapper.bzl
+@@ -0,0 +1,50 @@
++load("@bazel_tools//tools/cpp:toolchain_utils.bzl", "find_cpp_toolchain")
++load("@bazel_tools//tools/build_defs/cc:action_names.bzl", "ACTION_NAMES")
++
++def _cc_wrapper_impl(ctx):
++    cc_toolchain = find_cpp_toolchain(ctx)
++    feature_configuration = cc_common.configure_features(
++        cc_toolchain = cc_toolchain,
++        requested_features = ctx.features,
++        unsupported_features = ctx.disabled_features,
++    )
++    cc = cc_common.get_tool_for_action(
++        feature_configuration = feature_configuration,
++        action_name = ACTION_NAMES.c_compile,
++    )
++    cc_wrapper = ctx.actions.declare_file(ctx.label.name + ".py")
++    ctx.actions.expand_template(
++        template = ctx.file._template,
++        output = cc_wrapper,
++        is_executable = True,
++        substitutions = {
++            "{:cc:}": cc,
++        },
++    )
++    return [DefaultInfo(files = depset([cc_wrapper]))]
++
++
++_cc_wrapper = rule(
++    implementation = _cc_wrapper_impl,
++    attrs = {
++        "_template": attr.label(
++            allow_single_file = True,
++            default = Label("@io_tweag_rules_haskell//haskell:private/cc_wrapper.py.tpl"),
++        ),
++        "_cc_toolchain": attr.label(
++            default = Label("@bazel_tools//tools/cpp:current_cc_toolchain"),
++        ),
++    }
++)
++
++def cc_wrapper(name, **kwargs):
++    _cc_wrapper(
++        name = name + "-source",
++    )
++    native.py_binary(
++        name = name,
++        srcs = [name + "-source"],
++        main = name + "-source.py",
++        python_version = "PY3",
++        **kwargs
++    )
+diff --git a/haskell/private/cc_wrapper.py.tpl b/haskell/private/cc_wrapper.py.tpl
+new file mode 100644
+index 0000000..f0ecd07
+--- /dev/null
++++ b/haskell/private/cc_wrapper.py.tpl
+@@ -0,0 +1,111 @@
++#!/usr/bin/env python3
++"""CC toolchain wrapper
++
++Usage: cc_wrapper [ARG]...
++
++Wraps the C compiler of the Bazel CC toolchain. Transforms arguments to work
++around limitations of Bazel and GHC and passes those via response file to the C
++compiler.
++
++"""
++
++from contextlib import contextmanager
++import os
++import shlex
++import subprocess
++import sys
++import tempfile
++
++CC = "{:cc:}"
++
++
++def main():
++    with response_file(handle_args(sys.argv[1:])) as rsp:
++        exit_code = subprocess.call([CC, "@" + rsp])
++
++    sys.exit(exit_code)
++
++
++def handle_args(args):
++    """Argument handling pipe
++
++    Returns a generator over transformed arguments.
++    """
++    args = iter(args)
++    for arg in args:
++        if arg.startswith("@"):
++            with open(arg[1:], "r") as rsp:
++                for inner in handle_args(x for line in rsp for x in parse_response_line(line)):
++                    yield inner
++        elif arg.startswith("-L") or arg == "--library-path":
++            if arg == "-L" or arg == "--library-path":
++                libdir = next(args)
++            else:
++                libdir = arg[2:]
++            yield "-L" + shorten_path(libdir)
++        else:
++            yield arg
++
++
++def shorten_path(input_path):
++    exists = os.path.exists(input_path)
++    shortened = input_path
++
++    # Try relativizing to current working directory.
++    rel = os.path.relpath(shortened)
++    if len(rel) < len(shortened):
++        shortened = rel
++
++    # Try normalizing the path if possible.
++    norm = os.path.normpath(shortened)
++    if len(norm) < len(shortened):
++        # Ensure that the path is still correct. Reducing up-level references
++        # may change the meaning of the path in the presence of symbolic links.
++        try:
++            if not exists or os.path.samefile(norm, shortened):
++                shortened = norm
++        except IOError:
++            # stat may fail if the path became invalid or does not exist.
++            pass
++
++    # Try resolving symlinks.
++    try:
++        real = os.path.relpath(os.path.realpath(shortened))
++        if len(real) < len(shortened):
++            shortened = real
++    except IOError:
++        # realpath may fail if the path does not exist.
++        pass
++
++    return shortened
++
++
++@contextmanager
++def response_file(args):
++    try:
++        with tempfile.NamedTemporaryFile(mode="w", prefix="rsp", delete=False) as f:
++            for arg in args:
++                line = generate_response_line(arg)
++                f.write(line)
++            f.close()
++            yield f.name
++    finally:
++        try:
++            os.remove(f.name)
++        except OSError:
++            pass
++
++
++def parse_response_line(s):
++    # GHC writes response files with quoted lines.
++    return shlex.split(s)
++
++
++def generate_response_line(arg):
++    # Python 2 shlex doesn't provide quote, yet. There's an issue with the
++    # Python toolchain causing this script to be interpreted by Python2.
++    return '"{}"\n'.format(arg.replace("\\", "\\\\").replace('"', '\\"'))
++
++
++if __name__ == "__main__":
++    main()
+diff --git a/haskell/toolchain.bzl b/haskell/toolchain.bzl
+index 2a453b8..c8952c4 100644
+--- a/haskell/toolchain.bzl
++++ b/haskell/toolchain.bzl
+@@ -24,29 +24,27 @@ def _run_ghc(hs, cc, inputs, outputs, mnemonic, arguments, params_file = None, e
+     args = hs.actions.args()
+     args.add(hs.tools.ghc)
+ 
+-    # Do not use Bazel's CC toolchain on Windows, as it leads to linker and librarty compatibility issues.
+     # XXX: We should also tether Bazel's CC toolchain to GHC's, so that we can properly mix Bazel-compiled
+     # C libraries with Haskell targets.
+-    if not hs.toolchain.is_windows:
+-        args.add_all([
+-            # GHC uses C compiler for assemly, linking and preprocessing as well.
+-            "-pgma",
+-            cc.tools.cc,
+-            "-pgmc",
+-            cc.tools.cc,
+-            "-pgml",
+-            cc.tools.cc,
+-            "-pgmP",
+-            cc.tools.cc,
+-            # Setting -pgm* flags explicitly has the unfortunate side effect
+-            # of resetting any program flags in the GHC settings file. So we
+-            # restore them here. See
+-            # https://ghc.haskell.org/trac/ghc/ticket/7929.
+-            "-optc-fno-stack-protector",
+-            "-optP-E",
+-            "-optP-undef",
+-            "-optP-traditional",
+-        ])
++    args.add_all([
++        # GHC uses C compiler for assemly, linking and preprocessing as well.
++        "-pgma",
++        cc.tools.cc,
++        "-pgmc",
++        cc.tools.cc,
++        "-pgml",
++        cc.tools.cc,
++        "-pgmP",
++        cc.tools.cc,
++        # Setting -pgm* flags explicitly has the unfortunate side effect
++        # of resetting any program flags in the GHC settings file. So we
++        # restore them here. See
++        # https://ghc.haskell.org/trac/ghc/ticket/7929.
++        "-optc-fno-stack-protector",
++        "-optP-E",
++        "-optP-undef",
++        "-optP-traditional",
++    ])
+ 
+     compile_flags_file = hs.actions.declare_file("compile_flags_%s_%s" % (hs.name, mnemonic))
+     extra_args_file = hs.actions.declare_file("extra_args_%s_%s" % (hs.name, mnemonic))
+@@ -65,6 +63,9 @@ def _run_ghc(hs, cc, inputs, outputs, mnemonic, arguments, params_file = None, e
+         extra_args_file,
+     ] + cc.files
+ 
++    if hs.toolchain.locale_archive != None:
++        extra_inputs.append(hs.toolchain.locale_archive)
++
+     if params_file:
+         params_file_src = params_file.path
+         extra_inputs.append(params_file)
+@@ -173,6 +174,8 @@ fi
+         for lib in ctx.attr.libraries
+     }
+ 
++    (cc_wrapper_inputs, cc_wrapper_manifest) = ctx.resolve_tools(tools = [ctx.attr._cc_wrapper])
++
+     return [
+         platform_common.ToolchainInfo(
+             name = ctx.label.name,
+@@ -182,6 +185,11 @@ fi
+             haddock_flags = ctx.attr.haddock_flags,
+             locale = ctx.attr.locale,
+             locale_archive = locale_archive,
++            cc_wrapper = struct(
++                executable = ctx.executable._cc_wrapper,
++                inputs = cc_wrapper_inputs,
++                manifests = cc_wrapper_manifest,
++            ),
+             osx_cc_wrapper_tpl = ctx.file._osx_cc_wrapper_tpl,
+             mode = ctx.var["COMPILATION_MODE"],
+             actions = struct(
+@@ -247,6 +255,11 @@ _haskell_toolchain = rule(
+ Label pointing to the locale archive file to use. Mostly useful on NixOS.
+ """,
+         ),
++        "_cc_wrapper": attr.label(
++            cfg = "host",
++            default = Label("@io_tweag_rules_haskell//haskell:cc_wrapper"),
++            executable = True,
++        ),
+         "_osx_cc_wrapper_tpl": attr.label(
+             allow_single_file = True,
+             default = Label("@io_tweag_rules_haskell//haskell:private/osx_cc_wrapper.sh.tpl"),

deps.bzl

@@ -54,6 +54,7 @@ def daml_deps():
                 # XXX: Remove once upstream PR was merged and we've updated to
                 # Bazel 0.27. https://github.com/tweag/rules_haskell/pull/970
                 "@haskell_static_ghc_patch//file:downloaded",
+                "@com_github_digital_asset_daml//bazel_tools:haskell-windows-library-dirs.patch",
             ],
             patch_args = ["-p1"],
             sha256 = rules_haskell_sha256,