Add support for relative lookup of template-hsc.h (#2)
authorMoritz Angermann <moritz.angermann@gmail.com>
Sun, 19 Nov 2017 11:15:05 +0000 (19:15 +0800)
committerHerbert Valerio Riedel <hvr@gnu.org>
Sun, 19 Nov 2017 11:15:05 +0000 (12:15 +0100)
If the `IN_GHC_TREE` CPP macro is defined (controlled by the `in-ghc-tree` cabal flag),
as a last resort, we also try to locate the template relative to the location of the currently
executed `hsc2hs`. Note that this is a hack to work around
only partial relocatable support in cabal, and is here to allow the `hsc2hs`
built and shipped with ghc to be relocatable with the ghc
binary distribution it ships with.

Note that on Windows, `getExecutablePath` doesn't yet operate correctly
in the presence of symlinks; but this should note have any detrimental
effects. This will be fixed/improved in future `base` version.

Main.hs
hsc2hs.cabal

diff --git a/Main.hs b/Main.hs
index 08dab3f..fad7aac 100644 (file)
--- a/Main.hs
+++ b/Main.hs
@@ -13,6 +13,17 @@ import Control.Monad            ( liftM, forM_ )
 import Data.List                ( isSuffixOf )
 import System.Console.GetOpt
 
+-- If we ware building the hsc2hs
+-- binary for binary distribution
+-- in the GHC tree.  Obtain
+-- the path to the @$topdir/lib@
+-- folder, and try to locate the
+-- @template-hsc.h@ there.
+--
+-- XXX: Note this does not work
+--      on windows due to for
+--      symlinks. See Trac #14483.
+
 #if defined(mingw32_HOST_OS)
 import Foreign
 import Foreign.C.String
@@ -26,8 +37,11 @@ import System.IO
 #ifdef BUILD_NHC
 import System.Directory         ( getCurrentDirectory )
 #else
-import Data.Version             ( showVersion )
-import Paths_hsc2hs as Main     ( getDataFileName, version )
+import Paths_hsc2hs as Main     ( getDataFileName )
+#endif
+#if defined(IN_GHC_TREE)
+import System.Environment       ( getExecutablePath )
+import System.FilePath          ( takeDirectory, (</>) )
 #endif
 
 import Common
@@ -49,12 +63,10 @@ import HSCParser
 #ifdef BUILD_NHC
 getDataFileName s = do here <- getCurrentDirectory
                        return (here++"/"++s)
-version = "0.67" -- TODO!!!
-showVersion = id
 #endif
 
 versionString :: String
-versionString = "hsc2hs version " ++ showVersion version ++ "\n"
+versionString = "hsc2hs version " ++ CURRENT_PACKAGE_VERSION ++ "\n"
 
 main :: IO ()
 main = do
@@ -141,6 +153,13 @@ findTemplate usage mb_libdir config
      --
      -- Next we try the location we told Cabal about.
      --
+     -- If IN_GHC_TREE is defined (-fin-ghc-tree), we also try to locate
+     -- the template in the `baseDir`, as provided by the `ghc-boot`
+     -- library. Note that this is a hack to work around only partial
+     -- relocatable support in cabal, and is here to allow the hsc2hs
+     -- built and shipped with ghc to be relocatable with the ghc
+     -- binary distribution it ships with.
+     --
      -- If neither of the above work, then hopefully we're on Unix and
      -- there's a wrapper script which specifies an explicit template flag.
      mb_templ1 <-
@@ -157,14 +176,31 @@ findTemplate usage mb_libdir config
          if exists1
             then return $ Just (templ1, CompFlag ("-I" ++ incl))
             else return Nothing
-     case mb_templ1 of
+     mb_templ2 <- case mb_templ1 of
          Just (templ1, incl) ->
-             return (templ1, [incl])
+             return $ Just (templ1, [incl])
          Nothing -> do
              templ2 <- getDataFileName "template-hsc.h"
              exists2 <- doesFileExist templ2
-             if exists2 then return (templ2, [])
-                        else die ("No template specified, and template-hsc.h not located.\n\n" ++ usage)
+             if exists2
+                then return $ Just (templ2, [])
+                else return Nothing
+     case mb_templ2 of
+         Just x -> return x
+#if defined(IN_GHC_TREE)
+         Nothing -> do
+             -- XXX: this will *not* work on windows for symlinks, until `getExecutablePath` in `base` is
+             --      fixed. The alternative would be to bring the whole logic from the SysTools module in here
+             --      which is rather excessive. See Trac #14483.
+             let getBaseDir = Just . (\p -> p </> "lib") . takeDirectory . takeDirectory <$> getExecutablePath
+             mb_templ3 <- fmap (</> "template-hsc.h") <$> getBaseDir
+             mb_exists3 <- mapM doesFileExist mb_templ3
+             case (mb_templ3, mb_exists3) of
+                 (Just templ3, Just True) -> return (templ3, [])
+                 _ -> die ("No template specified, and template-hsc.h not located.\n\n" ++ usage)
+#else
+         Nothing -> die ("No template specified, and template-hsc.h not located.\n\n" ++ usage)
+#endif
 
 findCompiler :: Maybe FilePath -> ConfigM Maybe -> IO FilePath
 findCompiler mb_libdir config
index c6ca492..99d5072 100644 (file)
@@ -1,5 +1,5 @@
 Name: hsc2hs
-Version: 0.68.2
+Version: 0.68.3
 Copyright: 2000, Marcin Kowalczyk
 License: BSD3
 License-File: LICENSE
@@ -26,6 +26,11 @@ cabal-version: >=1.10
 extra-source-files: changelog.md
 tested-with: GHC==8.2.1, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2, GHC==7.0.4
 
+flag in-ghc-tree
+  description: Are we in a GHC tree?
+  default: False
+  manual: True
+
 source-repository head
     Type: git
     Location: http://git.haskell.org/hsc2hs.git
@@ -50,4 +55,6 @@ Executable hsc2hs
                    directory  >= 1   && < 1.4,
                    filepath   >= 1   && < 1.5,
                    process    >= 1.1 && < 1.7
+    if flag(in-ghc-tree)
+       cpp-options: -DIN_GHC_TREE