Feature/wrapper

src/GHC.hs

@@ -7,7 +7,7 @@ module GHC (
     integerSimple, iservBin, mkUserGuidePart, parallel, pretty, primitive, process,
     runGhc, stm, templateHaskell, terminfo, time, transformers, unix, win32, xhtml,
 
-    defaultKnownPackages, defaultTargetDirectory, defaultProgramPath
+    defaultKnownPackages, defaultTargetDirectory, defaultProgramPath, defaultWrapperPath
     ) where
 
 import Base
@@ -52,7 +52,7 @@ dllSplit        = utility  "dll-split"
 filepath        = library  "filepath"
 genapply        = utility  "genapply"
 genprimopcode   = utility  "genprimopcode"
-ghc             = topLevel "ghc-bin"        `setPath` "ghc"   `setType` Program
+ghc             = topLevel "ghc-bin"        `setPath` "ghc"   `setType` Program `setWrapper` "dummy"
 ghcBoot         = library  "ghc-boot"
 ghcCabal        = utility  "ghc-cabal"
 ghci            = library  "ghci"
@@ -99,10 +99,20 @@ xhtml           = library  "xhtml"
 defaultTargetDirectory :: Stage -> Package -> FilePath
 defaultTargetDirectory stage _ = stageString stage
 
+type ProgramNameModifier = String -> String
 -- TODO: simplify
 -- | Returns a relative path to the program executable
 defaultProgramPath :: Stage -> Package -> Maybe FilePath
 defaultProgramPath stage pkg
+   | isWrapped pkg = defaultProgramPath' (\n -> "lib" -/- "bin" -/- n) stage pkg
+   | otherwise = defaultProgramPath' id stage pkg
+
+defaultWrapperPath :: Stage -> Package -> Maybe FilePath
+defaultWrapperPath _ (Package {pkgWrapper=Nothing}) = Nothing
+defaultWrapperPath stage pkg = defaultProgramPath' id stage pkg
+
+defaultProgramPath' :: ProgramNameModifier -> Stage -> Package -> Maybe FilePath
+defaultProgramPath' modifier stage pkg
     | pkg == ghc = Just . inplaceProgram $ "ghc-stage" ++ show (fromEnum stage + 1)
     | pkg == haddock || pkg == ghcTags = case stage of
         Stage2 -> Just . inplaceProgram $ pkgNameString pkg
@@ -112,6 +122,6 @@ defaultProgramPath stage pkg
         _      -> Just . installProgram $ pkgNameString pkg
     | otherwise = Nothing
   where
-    inplaceProgram name = programInplacePath -/- name <.> exe
+    inplaceProgram name = programInplacePath -/- (modifier name) <.> exe
     installProgram name = pkgPath pkg -/- defaultTargetDirectory stage pkg
-                                      -/- "build/tmp" -/- name <.> exe
+                                      -/- "build/tmp" -/- (modifier name) <.> exe

src/Package.hs

@@ -7,7 +7,8 @@ module Package (
     pkgCabalFile,
     matchPackageNames,
     -- * Helpers for constructing and using 'Package's
-    setPath, topLevel, library, utility, setType, isLibrary, isProgram
+    setPath, topLevel, library, utility, setType, setWrapper, isLibrary,
+    isProgram, isWrapped
     ) where
 
 import Base
@@ -26,12 +27,15 @@ instance Show PackageName where
 -- for now.
 data PackageType = Program | Library deriving Generic
 
+type PackageWrapper = String
+
 data Package = Package
      {
          pkgName :: PackageName, -- ^ Examples: "ghc", "Cabal"
          pkgPath :: FilePath,    -- ^ pkgPath is the path to the source code relative to the root.
                                  -- e.g. "compiler", "libraries/Cabal/Cabal"
-         pkgType :: PackageType
+         pkgType :: PackageType,
+         pkgWrapper :: Maybe PackageWrapper
      }
      deriving Generic
 
@@ -43,20 +47,23 @@ pkgCabalFile :: Package -> FilePath
 pkgCabalFile pkg = pkgPath pkg -/- getPackageName (pkgName pkg) <.> "cabal"
 
 topLevel :: PackageName -> Package
-topLevel name = Package name (getPackageName name) Library
+topLevel name = Package name (getPackageName name) Library Nothing
 
 library :: PackageName -> Package
-library name = Package name ("libraries" -/- getPackageName name) Library
+library name = Package name ("libraries" -/- getPackageName name) Library Nothing
 
 utility :: PackageName -> Package
-utility name = Package name ("utils" -/- getPackageName name) Program
+utility name = Package name ("utils" -/- getPackageName name) Program Nothing
 
 setPath :: Package -> FilePath -> Package
 setPath pkg path = pkg { pkgPath = path }
 
 setType :: Package -> PackageType -> Package
 setType pkg ty = pkg { pkgType = ty }
 
+setWrapper :: Package -> PackageWrapper -> Package
+setWrapper pkg wrapper = pkg { pkgWrapper = Just wrapper }
+
 isLibrary :: Package -> Bool
 isLibrary (Package {pkgType=Library}) = True
 isLibrary _ = False
@@ -65,6 +72,10 @@ isProgram :: Package -> Bool
 isProgram (Package {pkgType=Program}) = True
 isProgram _ = False
 
+isWrapped :: Package -> Bool
+isWrapped (Package {pkgWrapper=Nothing}) = False
+isWrapped _ = True
+
 instance Show Package where
     show = show . pkgName
 

src/Rules/Program.hs

@@ -12,6 +12,13 @@ import Rules.Resources
 import Settings
 import Settings.Builders.GhcCabal
 
+wrapperGenerator :: String -> Expr String
+wrapperGenerator program = do
+    top <- getSetting GhcSourcePath
+    return $ unlines [ "#!/bin/bash"
+                     , "exec " ++ (top -/- program) ++ " -B" ++ (top -/- "inplace" -/- "lib") ++ " ${1+\"$@\"}"
+                     ]
+
 -- TODO: Get rid of the Paths_hsc2hs.o hack.
 -- TODO: Do we need to consider other ways when building programs?
 buildProgram :: Resources -> PartialTarget -> Rules ()
@@ -21,6 +28,17 @@ buildProgram _ target @ (PartialTarget stage pkg) = do
         match file = case programPath stage pkg of
             Nothing      -> False
             Just prgPath -> ("//" ++ prgPath) ?== file
+        matchWrapper file = case defaultWrapperPath stage pkg of
+            Nothing      -> False
+            Just wrpPath -> ("//" ++ wrpPath) ?== file
+    matchWrapper ?> \bin -> do
+        let Just wrappedProgram = programPath stage pkg
+        need $ [wrappedProgram]
+
+        wrapper <- interpretPartial target $ wrapperGenerator wrappedProgram
+        writeFileChanged bin wrapper
+        () <- cmd "chmod +x " [bin]
+        putSuccess $ "| Successfully created wrapper '" ++ pkgNameString pkg ++ "' (" ++ show stage ++ ")."
 
     match ?> \bin -> do
         cSrcs <- cSources target -- TODO: remove code duplication (Library.hs)