diff --git a/hinstaller.cabal b/hinstaller.cabal --- a/hinstaller.cabal +++ b/hinstaller.cabal @@ -1,5 +1,5 @@ name: hinstaller -version: 2007.4.23 +version: 2007.4.24 stability: Alpha copyright: Matthew Sackman category: System @@ -8,7 +8,7 @@ homepage: http://www.wellquite.org/hinstaller/ license: LGPL license-file: LICENSE -build-depends: base, template-haskell, filepath +build-depends: base, template-haskell, filepath, Cabal synopsis: Installer wrapper for Haskell applications description: This module allows you to incorporate arbitrary files into a haskell module @@ -17,12 +17,9 @@ files when run. Thus this can be considered in the same model as Java .jar files or executable zip or other file archives. . - Note that the current implementation is now reasonably efficient. However, - either use -fvia-C which will take care of all compilation for you (but - will be slow) or use -fasm which will probably fail at the linking stage. - Compile the generated .c files and manually link together to complete the - installation. On any non-trivial sized file, you may need to increase GHC's - stack with +RTS -K32M -RTS to avoid stack overflows. + The current implementation is now reasonably efficient. However, it does + require that you have a C compiler installed which can be invoked through + @cc@. exposed-modules: System.Installer other-modules: System.Installer.TH, System.Installer.Foreign ghc-options: -O2 -Wall -fno-warn-name-shadowing diff --git a/src/System/Installer.hs b/src/System/Installer.hs --- a/src/System/Installer.hs +++ b/src/System/Installer.hs @@ -53,16 +53,36 @@ -- -- Note that the files written out are not set executable so you -- must correct file permissions yourself. - --- Note that the current implementation is now reasonably --- efficient. However, either use -fvia-C which will take care of all --- compilation for you (but will be slow) or use -fasm which will --- probably fail at the linking stage. Compile the generated .c files --- and manually link together to complete the installation. On any --- non-trivial sized file, you may need to increase GHC's stack with --- @+RTS -K32M -RTS@ to avoid stack overflows. +-- +-- The module works by, at compile time, reading in the files +-- specified and converting them to C files with a header. These +-- files will be stored in a directory called @hinstaller-tmp@ under +-- the same leaf name as the original. Then, the module calls a C +-- compiler by invoking the process @cc@ which must exist. Finally, +-- the names of the files must be passed to the linker. With GHC, use +-- @-optl hinstaller-tmp\//file/.o@ where /file/ is the name of the +-- file you're including. Repeat for each file. +-- +-- In order to clean up this @hinstaller-tmp@ directory, the module +-- exports a function 'cabalCleanHInstallerDir'. To use this, modify +-- your @Setup.hs@ along the lines of the following: +-- +-- > #!\/usr\/bin\/env runghc +-- > +-- > import Distribution.Simple +-- > import System.Installer +-- > +-- > main = defaultMainWithHooks myHooks +-- > +-- > myHooks :: UserHooks +-- > myHooks = defaultUserHooks { postBuild = cabalCleanHInstallerDir } +-- +-- Then, once the build is complete, the directory will be cleaned up. +-- With Cabal, use the @ld-options@ field to pass in the names of +-- compiled C files: @ld-options: hinstaller-tmp\//file/.o@ module System.Installer - (installBinariesFunc + (installBinariesFunc, + cabalCleanHInstallerDir ) where @@ -74,7 +94,7 @@ installBinariesFunc :: String -> [(String, FilePath)] -> Q [Dec] installBinariesFunc funcName binaries = do { binariesWithTmp <- runIO - (convertFilesToCHeaders funcName binaries) + (convertFilesToC funcName binaries) ; importDecls <- mapM (TH.makeImportDecl funcName) binariesWithTmp ; func <- TH.makeInstallFunc funcName clauses @@ -84,12 +104,12 @@ where clauses = map (TH.makeInstallFuncCase funcName) binaries -convertFilesToCHeaders :: String -> [(String, FilePath)] -> +convertFilesToC :: String -> [(String, FilePath)] -> IO [(String, FilePath, FilePath)] -convertFilesToCHeaders _ [] = return [] -convertFilesToCHeaders funcName ((clauseName, filePath):rest) - = do { result <- convertFilesToCHeaders funcName rest - ; tmpFileName <- convertFileToCHeader filePath clauseName' +convertFilesToC _ [] = return [] +convertFilesToC funcName ((clauseName, filePath):rest) + = do { result <- convertFilesToC funcName rest + ; tmpFileName <- convertFileToC filePath clauseName' ; return $ (clauseName, filePath, tmpFileName):result } where diff --git a/src/System/Installer/Foreign.hs b/src/System/Installer/Foreign.hs --- a/src/System/Installer/Foreign.hs +++ b/src/System/Installer/Foreign.hs @@ -1,13 +1,25 @@ module System.Installer.Foreign + (convertFileToC, + writeFileData, + cabalCleanHInstallerDir + ) where +import Control.Concurrent import Foreign import Foreign.C import System.Directory import System.FilePath import System.IO +import System.Process +import System.Exit import Data.Word +import Data.Maybe import qualified Data.ByteString as B +import Distribution.Simple +import Distribution.Setup +import Distribution.PackageDescription +import Distribution.Simple.LocalBuildInfo writeCHeaderFile :: Handle -> String -> IO () writeCHeaderFile outH name @@ -44,22 +56,26 @@ where numTxt = (show wrd) ++ "," -convertFileToCHeader :: FilePath -> String -> IO (FilePath) -convertFileToCHeader file clauseName - = do { (tmpFileHPath, tmpFileHHdl) <- openBinaryTempFile "" leafNameH - ; writeCHeaderFile tmpFileHHdl clauseName - ; hClose tmpFileHHdl +convertFileToC :: FilePath -> String -> IO (FilePath) +convertFileToC file clauseName + = do { createDirectoryIfMissing False hInstallerTmpDir + ; hHdl <- openBinaryFile pathH WriteMode + ; writeCHeaderFile hHdl clauseName + ; hClose hHdl ; contentsB <- B.readFile file - ; (tmpFileCPath, tmpFileCHdl) <- openBinaryTempFile "" leafNameC - ; writeCFile tmpFileCHdl clauseName contentsB tmpFileHPath - ; hClose tmpFileCHdl - ; return tmpFileCPath + ; cHdl <- openBinaryFile pathC WriteMode + ; writeCFile cHdl clauseName contentsB leafNameH + ; hClose cHdl + ; runCCRelayingOut hInstallerTmpDir leafNameC + ; return leafNameH } where leafName = takeFileName file leafNameNoExts = dropExtensions leafName leafNameH = addExtension leafNameNoExts "h" leafNameC = addExtension leafNameNoExts "c" + pathH = combine hInstallerTmpDir leafNameH + pathC = combine hInstallerTmpDir leafNameC writeFromPtrToFile :: Ptr CUChar -> Int -> FilePath -> IO () writeFromPtrToFile ptr len filePath @@ -74,3 +90,41 @@ ; let path' = if isDir then combine path origName else path ; writeFromPtrToFile ptr (fromIntegral len) path' } + +runCCRelayingOut :: FilePath -> FilePath -> IO ExitCode +runCCRelayingOut wd cPath + = do { (_,outH,errH,procH) <- runInteractiveProcess + "cc" ["-c", cPath] (Just wd) Nothing + ; forkRelayHandles outH stdout + ; forkRelayHandles errH stderr + ; waitForProcess procH + } + +forkRelayHandles :: Handle -> Handle -> IO ThreadId +forkRelayHandles inH outH = forkIO func + where + func = hGetContents inH >>= hPutStr outH + +hInstallerTmpDir :: FilePath +hInstallerTmpDir = "hinstaller-tmp" + +cabalCleanHInstallerDir :: Args -> BuildFlags -> PackageDescription -> + LocalBuildInfo -> IO ExitCode +cabalCleanHInstallerDir _ buildflags _ _ + = do { if verbosity > 0 + then print "Cleaning hinstaller-tmp directory..." + else return () + ; dirExists <- doesDirectoryExist hInstallerTmpDir + ; if dirExists + then do { removeDirectoryRecursive hInstallerTmpDir + ; if verbosity > 0 + then print "Successfully cleaned hinstaller-tmp directory." + else return () + } + else if verbosity > 0 + then print "hinstaller-tmp directory not found, nothing to clean." + else return () + ; return ExitSuccess + } + where + verbosity = buildVerbose buildflags