diff --git a/Bamse/Builder.hs b/Bamse/Builder.hs --- a/Bamse/Builder.hs +++ b/Bamse/Builder.hs @@ -38,9 +38,12 @@ import System.Cmd import System.IO -import Data.Maybe import Bamse.Options + +import Data.Maybe +import Control.Monad import System.Directory +import System.Exit -- ToDo: -- - ability to organise installed bits into features/sub parts. @@ -63,8 +66,8 @@ genBuilderOpts :: PackageData -> Options -> IO () genBuilderOpts pkg opts = do - ds <- (p_fileMap pkg) (opt_ienv opts) - (dsDist, _ienv) <- mkDistTree (opt_ienv opts) + ds <- (p_fileMap pkg) (opt_ienv opts) + (dsDist, ienvN) <- mkDistTree (opt_ienv opts) (normalise $ dropTrailingPathSeparator $ srcDir $ opt_ienv opts) (name $ p_pkgInfo pkg) (p_distFileMap pkg) @@ -81,7 +84,7 @@ os -> [customizeDialog os] , p_productGUID = fromJust (opt_productGUID opts) , p_revisionGUID = fromJust (opt_revisionGUID opts) - , p_ienv = opt_ienv opts + , p_ienv = ienvN , p_verbose = opt_verbose opts } let bamseDir = toolDir (p_ienv pkg') @@ -91,8 +94,11 @@ WriterEnv { w_toolDir = bamseDir , w_templateDir = lFile (lFile bamseDir "data") "msi" - , w_outFile = outFile (p_ienv pkg') - , w_srcDir = normalise (takeDirectory (srcDir $ p_ienv pkg')) + , w_outFile = outFile ienvN + -- Note: using the _adjusted_ source directory here + -- from the dist tree, not the original one (i.e., want + -- to chop out the 'out/..' prefix, of course.) + , w_srcDir = normalise (takeDirectory (srcDir ienvN)) , w_package = pkg' } outputMSI wenv tabs ts reps @@ -111,7 +117,7 @@ mkDistTree :: InstallEnv -> FilePath -> String - -> Maybe (FilePath -> Maybe FilePath) + -> Maybe (InstallEnv -> FilePath -> Maybe FilePath) -> DirTree -> IO (DirTree, InstallEnv) mkDistTree ienv _ _ Nothing ds = return (ds, ienv) @@ -127,17 +133,30 @@ where copyOver _ Empty = return () copyOver outDir (File f) = do - case fn f of + case fn ienv f of Nothing -> return () Just fnm -> do - let cmd = ("copy /b \"" ++ fnm ++ "\" \"" ++ + let cmd = ("copy /b \"" ++ f ++ "\" \"" ++ appendP outDir (dropDirPrefix topDir fnm) ++ "\" > nul") - system cmd +-- putStrLn ("Creating dir: " ++ fnm ++ ' ':(dropFileName $ appendP outDir (dropDirPrefix topDir fnm))) + createDirectoryIfMissing True (dropFileName $ appendP outDir (dropDirPrefix topDir fnm)) + system' cmd return () copyOver outDir (Directory fp subs) = do maybe (return ()) - (\ f -> system ("mkdir " ++ appendP outDir (dropDirPrefix topDir f)) >> return ()) - (fn fp) + (\ f -> do +-- putStrLn ("Creating dirs: " ++ fp ++ ' ':(appendP outDir (dropDirPrefix topDir f))) + createDirectoryIfMissing True (appendP outDir (dropDirPrefix topDir f)) + return ()) + (fn ienv fp) mapM_ (copyOver outDir) subs appendP a b = normalise (a b) + + system' cmd = do +-- when vb (hPutStrLn stderr ("Command exec: " ++ cmd)) + rc <- system cmd + case rc of + ExitSuccess{} -> return () + _ -> putStrLn $ "ERROR: failed exec'ing " ++ show cmd + diff --git a/Bamse/MSIExtra.hs b/Bamse/MSIExtra.hs --- a/Bamse/MSIExtra.hs +++ b/Bamse/MSIExtra.hs @@ -51,11 +51,13 @@ shortLong :: String -> String shortLong nm = short_form where - badChars = " +,;=[]" + badChars_short = badChars ++ " +,;=[]" + badChars = "\\?<>:/*\"" + restricted_short_nm = map (\ ch -> if ch `elem` badChars_short then '_' else ch) nm restricted_nm = map (\ ch -> if ch `elem` badChars then '_' else ch) nm ext = case System.FilePath.takeExtension nm of { '.':xs -> xs ; xs -> xs } short_form - | length restricted_nm > 8 || length ext > 3 = take 6 (map toUpper restricted_nm) ++ "~1|" ++ nm + | length nm > 8 || length ext > 3 = take 6 (map toUpper restricted_short_nm) ++ "~1|" ++ restricted_nm | otherwise = restricted_nm data MsidbFileAttributes diff --git a/Bamse/Options.hs b/Bamse/Options.hs --- a/Bamse/Options.hs +++ b/Bamse/Options.hs @@ -237,6 +237,7 @@ let ienv = InstallEnv { toolDir = maybe bdir id (opt_toolDir opts2) , srcDir = sourceDir + , srcBaseDir = sourceDir , distDir = error "distDir not filled in yet" , outFile = oFile , userOpts = os diff --git a/Bamse/Package.hs b/Bamse/Package.hs --- a/Bamse/Package.hs +++ b/Bamse/Package.hs @@ -41,6 +41,10 @@ , distDir :: FilePath -- user-supplied path to directory containing installer -- template specific files. , outFile :: FilePath -- file to output installer as. + , srcBaseDir :: FilePath -- path to toplevel directory source directory; differs from @srcDir@ + -- in that it is in the input source dir, @srcDir@ is updated to + -- point to the distribution directory during building. This is + -- a bug really (it being updated), but stuck with it for now. , userOpts :: [(String,String)] -- invocation-time (name,value) pairs } deriving Show @@ -65,7 +69,7 @@ data PackageData = PackageData { p_files :: DirTree , p_fileMap :: InstallEnv -> IO DirTree - , p_distFileMap :: Maybe (FilePath -> Maybe FilePath) + , p_distFileMap :: Maybe (InstallEnv -> FilePath -> Maybe FilePath) , p_defOutFile :: FilePath , p_pkgInfo :: Package , p_webSite :: String diff --git a/bamse.cabal b/bamse.cabal --- a/bamse.cabal +++ b/bamse.cabal @@ -1,5 +1,5 @@ name: bamse -version: 0.9.4 +version: 0.9.5 Synopsis: A Windows Installer (MSI) generator framework Description: Bamse is a framework for building Windows Installers for diff --git a/templates/Alex.hs b/templates/Alex.hs --- a/templates/Alex.hs +++ b/templates/Alex.hs @@ -107,7 +107,7 @@ ofInterest file = not (last file == '~') && not (takeFileName file == "CVS") -distFileMap :: Maybe (FilePath -> Maybe FilePath) +distFileMap :: Maybe (InstallEnv -> FilePath -> Maybe FilePath) distFileMap = Nothing featureMap :: Maybe (FilePath -> FeatureName) diff --git a/templates/Bamse.hs b/templates/Bamse.hs --- a/templates/Bamse.hs +++ b/templates/Bamse.hs @@ -142,7 +142,7 @@ "CVS" -> True _ -> not (null f) && last f == '~' -distFileMap :: Maybe (FilePath -> Maybe FilePath) +distFileMap :: Maybe (InstallEnv -> FilePath -> Maybe FilePath) distFileMap = Nothing -- if provided, a mapping from dist tree filename to the diff --git a/templates/Base.hs b/templates/Base.hs --- a/templates/Base.hs +++ b/templates/Base.hs @@ -105,7 +105,7 @@ dirTree :: InstallEnv -> IO DirTree dirTree _ienv = return Empty -distFileMap :: Maybe (FilePath -> Maybe FilePath) +distFileMap :: Maybe (InstallEnv -> FilePath -> Maybe FilePath) distFileMap = Nothing featureMap :: Maybe (FilePath -> FeatureName) diff --git a/templates/ComPkg.hs b/templates/ComPkg.hs --- a/templates/ComPkg.hs +++ b/templates/ComPkg.hs @@ -124,7 +124,7 @@ _ -> not (null f) && last f == '~' -distFileMap :: Maybe (FilePath -> Maybe FilePath) +distFileMap :: Maybe (InstallEnv -> FilePath -> Maybe FilePath) distFileMap = Nothing featureMap :: Maybe (FilePath -> FeatureName) diff --git a/templates/Cryptol.hs b/templates/Cryptol.hs --- a/templates/Cryptol.hs +++ b/templates/Cryptol.hs @@ -245,7 +245,7 @@ (null suf || suf `elem` iSuffixes) -} -distFileMap :: Maybe (FilePath -> Maybe FilePath) +distFileMap :: Maybe (InstallEnv -> FilePath -> Maybe FilePath) distFileMap = Nothing -- if provided, a mapping from dist tree filename to the diff --git a/templates/GHC.hs b/templates/GHC.hs --- a/templates/GHC.hs +++ b/templates/GHC.hs @@ -149,7 +149,7 @@ ofInterest file = not (not (null (tail file)) && last file == '~') && not (takeFileName file == "CVS") -distFileMap :: Maybe (FilePath -> Maybe FilePath) +distFileMap :: Maybe (InstallEnv -> FilePath -> Maybe FilePath) distFileMap = Nothing featureMap :: Maybe (FilePath -> FeatureName) diff --git a/templates/GaloisPkg.hs b/templates/GaloisPkg.hs --- a/templates/GaloisPkg.hs +++ b/templates/GaloisPkg.hs @@ -112,7 +112,7 @@ -} -distFileMap :: Maybe (FilePath -> Maybe FilePath) +distFileMap :: Maybe (InstallEnv -> FilePath -> Maybe FilePath) distFileMap = Nothing -- Just ( \ f -> Just (toDist f)) {- where diff --git a/templates/Greencard.hs b/templates/Greencard.hs --- a/templates/Greencard.hs +++ b/templates/Greencard.hs @@ -114,7 +114,7 @@ (not (takeExtension file == ".hi") || (takeFileName file == "StdDIS.hi")) -distFileMap :: Maybe (FilePath -> Maybe FilePath) +distFileMap :: Maybe (InstallEnv -> FilePath -> Maybe FilePath) distFileMap = Nothing featureMap :: Maybe (FilePath -> FeatureName) diff --git a/templates/HDirectLib.hs b/templates/HDirectLib.hs --- a/templates/HDirectLib.hs +++ b/templates/HDirectLib.hs @@ -86,7 +86,7 @@ ofInterest file = (takeExtension file `elem` [""{-directory-}, ".dll", ".hs", ".lhs", ".idl", ".h"]) -distFileMap :: Maybe (FilePath -> Maybe FilePath) +distFileMap :: Maybe (InstallEnv -> FilePath -> Maybe FilePath) distFileMap = Nothing featureMap :: Maybe (FilePath -> FeatureName) diff --git a/templates/Haddock.hs b/templates/Haddock.hs --- a/templates/Haddock.hs +++ b/templates/Haddock.hs @@ -108,7 +108,7 @@ ofInterest file = not (last file == '~') && not (takeFileName file == "CVS") -distFileMap :: Maybe (FilePath -> Maybe FilePath) +distFileMap :: Maybe (InstallEnv -> FilePath -> Maybe FilePath) distFileMap = Nothing featureMap :: Maybe (FilePath -> FeatureName) diff --git a/templates/Happy.hs b/templates/Happy.hs --- a/templates/Happy.hs +++ b/templates/Happy.hs @@ -109,7 +109,7 @@ ofInterest file = not (last file == '~') && not (takeFileName file == "CVS") -distFileMap :: Maybe (FilePath -> Maybe FilePath) +distFileMap :: Maybe (InstallEnv -> FilePath -> Maybe FilePath) distFileMap = Nothing featureMap :: Maybe (FilePath -> FeatureName) diff --git a/templates/HsDotnet.hs b/templates/HsDotnet.hs --- a/templates/HsDotnet.hs +++ b/templates/HsDotnet.hs @@ -99,7 +99,7 @@ where topDir = srcDir ienv -distFileMap :: Maybe (FilePath -> Maybe FilePath) +distFileMap :: Maybe (InstallEnv -> FilePath -> Maybe FilePath) distFileMap = Nothing featureMap :: Maybe (FilePath -> FeatureName) diff --git a/templates/Hugs98.hs b/templates/Hugs98.hs --- a/templates/Hugs98.hs +++ b/templates/Hugs98.hs @@ -207,7 +207,7 @@ , "docs\\users_guide_src" ] -distFileMap :: Maybe (FilePath -> Maybe FilePath) +distFileMap :: Maybe (InstallEnv -> FilePath -> Maybe FilePath) distFileMap = Nothing featureMap :: Maybe (FilePath -> FeatureName) diff --git a/templates/Hugs98Net.hs b/templates/Hugs98Net.hs --- a/templates/Hugs98Net.hs +++ b/templates/Hugs98Net.hs @@ -131,7 +131,7 @@ not (last file == '~') && not (takeFileName file == "CVS") -distFileMap :: Maybe (FilePath -> Maybe FilePath) +distFileMap :: Maybe (InstallEnv -> FilePath -> Maybe FilePath) distFileMap = Nothing featureMap :: Maybe (FilePath -> FeatureName) diff --git a/templates/PubCryptol.hs b/templates/PubCryptol.hs --- a/templates/PubCryptol.hs +++ b/templates/PubCryptol.hs @@ -238,7 +238,7 @@ (null suf || suf `elem` iSuffixes) -} -distFileMap :: Maybe (FilePath -> Maybe FilePath) +distFileMap :: Maybe (InstallEnv -> FilePath -> Maybe FilePath) distFileMap = Nothing -- if provided, a mapping from dist tree filename to the diff --git a/templates/SOE.hs b/templates/SOE.hs --- a/templates/SOE.hs +++ b/templates/SOE.hs @@ -103,7 +103,7 @@ defaultInstallFolder = Nothing -distFileMap :: Maybe (FilePath -> Maybe FilePath) +distFileMap :: Maybe (InstallEnv -> FilePath -> Maybe FilePath) distFileMap = Nothing -- if provided, a mapping from dist tree filename to the