hinstaller 2007.4.23 → 2007.4.24
raw patch · 3 files changed
+103/−32 lines, 3 filesdep +Cabal
Dependencies added: Cabal
Files
- hinstaller.cabal +5/−8
- src/System/Installer.hs +35/−15
- src/System/Installer/Foreign.hs +63/−9
hinstaller.cabal view
@@ -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
src/System/Installer.hs view
@@ -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
src/System/Installer/Foreign.hs view
@@ -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