Fix hsc2hs finding its template file on Windows

[ghc-hetmet.git] / utils / hsc2hs / Main.hs

diff --git a/utils/hsc2hs/Main.hs b/utils/hsc2hs/Main.hs
index 77b948f..b422986 100644 (file)
--- a/utils/hsc2hs/Main.hs
+++ b/utils/hsc2hs/Main.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS -fffi -cpp #-}
+{-# LANGUAGE CPP, ForeignFunctionInterface #-}
 
 ------------------------------------------------------------------------
 -- Program for converting .hsc files to .hs files, by converting the
@@ -42,11 +42,7 @@ import System.IO                ( openFile, IOMode(..), hClose )
 #endif
 
 #if defined(__GLASGOW_HASKELL__) && !defined(BUILD_NHC)
-#ifdef USING_COMPAT
-import Compat.RawSystem ( rawSystem )
-#else
 import System.Cmd       ( rawSystem )
-#endif
 #define HAVE_rawSystem
 #elif __NHC__ >= 117
 import System.Cmd              ( rawSystem )
@@ -62,6 +58,9 @@ import System                   ( system )
 #endif
 #endif
 
+import Distribution.Text
+import qualified Paths_hsc2hs
+
 version :: String
 version = "hsc2hs version 0.66\n"
 
@@ -133,7 +132,7 @@ main = do
        -- to find one by looking near the executable.  This only
        -- works on Win32 or Hugs (getExecDir). On Unix, there's a wrapper
        -- script which specifies an explicit template flag.
-    flags_w_tpl <- if any template_flag flags then
+    flags_w_tpl0 <- if any template_flag flags then
                        return flags
                   else
                        do mb_path <- getExecDir "/bin/hsc2hs.exe"
@@ -141,12 +140,21 @@ main = do
                            case mb_path of
                              Nothing   -> return id
                              Just path -> do
-                               let templ = path ++ "/template-hsc.h"
+                              -- Euch, this is horrible. Unfortunately
+                              -- Paths_hsc2hs isn't too useful for a
+                              -- relocatable binary, though.
+                               let templ = path ++ "/hsc2hs-" ++ display Paths_hsc2hs.version ++ "/template-hsc.h"
                                flg <- doesFileExist templ
                                if flg
                                 then return ((Template templ):)
                                 else return id
                           return (add_opt flags)
+
+    -- take only the last --template flag on the cmd line
+    let
+      (before,tpl:after) = break template_flag (reverse flags_w_tpl0)
+      flags_w_tpl = reverse (before ++ tpl : filter (not.template_flag) after)
+
     case (files, errs) of
         (_, _)
             | any isHelp    flags_w_tpl -> bye (usageInfo header options)
@@ -573,13 +581,11 @@ output flags name toks = do
        -- (called hsc2hs-inplace, generated from hsc2hs.sh)
     compiler <- case [c | Compiler c <- flags] of
         []  -> locateGhc "ghc"
-        [c] -> return c
-        _   -> onlyOne "compiler"
+        cs  -> return (last cs)
 
     linker <- case [l | Linker l <- flags] of
         []  -> locateGhc compiler
-        [l] -> return l
-        _   -> onlyOne "linker"
+        ls  -> return (last ls)
 
     writeFile cProgName $
         concatMap outFlagHeaderCProg flags++