diff --git a/Bamse/Builder.hs b/Bamse/Builder.hs --- a/Bamse/Builder.hs +++ b/Bamse/Builder.hs @@ -1,13 +1,20 @@ +-------------------------------------------------------------------- +-- | +-- Module : Bamse.Builder +-- Description : Toplevel module for a bamse library/app. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- (c) 2007, Galois, Inc. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- -- Toplevel module for bamse library/app. -- --- Bamse - a batch MSI installer creator. --- -- ToDo: -- - ability to organise installed bits into features/sub parts. -- +-------------------------------------------------------------------- module Bamse.Builder ( genBuilder ) where import Bamse.Package @@ -107,9 +114,9 @@ system cmd return () copyOver outDir (Directory fp subs) = do - case fn fp of - Nothing -> return () - Just fp -> system ("mkdir " ++ appendP outDir (dropDirPrefix topDir fp)) >> return () + maybe (return ()) + (\ f -> system ("mkdir " ++ appendP outDir (dropDirPrefix topDir f)) >> return ()) + (fn fp) mapM_ (copyOver outDir) subs appendP a b = toPlatformPath $ appendPath a b diff --git a/Bamse/DiaWriter.hs b/Bamse/DiaWriter.hs --- a/Bamse/DiaWriter.hs +++ b/Bamse/DiaWriter.hs @@ -1,8 +1,17 @@ --- --- (c) 2007, Galois, Inc. +-------------------------------------------------------------------- +-- | +-- Module : Bamse.DiaWriter +-- Description : Converting a Dialog type into an MSI dialog. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- Converting an MSI dialog from a Dialog type. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- +-- Converting a Dialog type into an MSI dialog. +-- +-------------------------------------------------------------------- module Bamse.DiaWriter where import Bamse.Dialog @@ -266,24 +275,24 @@ toEventString :: ControlEvent -> String toEventString x = case x of - SetProperty p v -> '[':p ++ "]" + SetProperty p _ -> '[':p ++ "]" ActionData -> "ActionData" ActionText -> "ActionText" - AddLocal f -> "AddLocal" - AddSource f -> "AddSource" - CheckExistingTargetPath p -> "CheckExistingTargetPath" - CheckTargetPath p -> "CheckTargetPath" + AddLocal{} -> "AddLocal" + AddSource{} -> "AddSource" + CheckExistingTargetPath{} -> "CheckExistingTargetPath" + CheckTargetPath{} -> "CheckTargetPath" DirectoryListNew -> "DirectoryListNew" DirectoryListOpen -> "DirectoryListOpen" DirectoryListUp -> "DirectoryListUp" - DoAction a -> "DoAction" - EnableRollback v -> "EnableRollback" - EndDialog d -> "EndDialog" + DoAction{} -> "DoAction" + EnableRollback{} -> "EnableRollback" + EndDialog{} -> "EndDialog" IgnoreChange -> "IgnoreChange" - NewDialog d -> "NewDialog" - Reinstall f -> "Reinstall" - ReinstallMode f -> "ReinstallMode" - Remove f -> "Remove" + NewDialog{} -> "NewDialog" + Reinstall{} -> "Reinstall" + ReinstallMode{} -> "ReinstallMode" + Remove{} -> "Remove" Reset -> "Reset" ScriptInProgress -> "ScriptInProgress" SelectionAction -> "SelectionAction" @@ -294,11 +303,11 @@ SelectionPath -> "SelectionPath" SelectionPathOn -> "SelectionPathOn" SelectionSize -> "SelectionSize" - SetInstallLevel i -> "SetInstallLevel" + SetInstallLevel{} -> "SetInstallLevel" SetProgress -> "SetProgress" - SetTargetPath p -> "SetTargetPath" - SpawnDialog d -> "SpawnDialog" - SpawnWaitDialog d -> "SpawnWaitDialog" + SetTargetPath{} -> "SetTargetPath" + SpawnDialog{} -> "SpawnDialog" + SpawnWaitDialog{} -> "SpawnWaitDialog" TimeRemaining -> "TimeRemaining" ValidateProductID -> "ValidateProductID" diff --git a/Bamse/Dialog.hs b/Bamse/Dialog.hs --- a/Bamse/Dialog.hs +++ b/Bamse/Dialog.hs @@ -1,10 +1,19 @@ +-------------------------------------------------------------------- +-- | +-- Module : Bamse.Dialog +-- Description : Representing MSI dialogs +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- (c) 2007, Galois, Inc. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- -- Low-level representation of MSI dialogs; combines together -- the information stored in the Control, ControlCondition, -- ControlEvent, and Dialog tables. --- +-- +-------------------------------------------------------------------- module Bamse.Dialog where data Dialog diff --git a/Bamse/DialogUtils.hs b/Bamse/DialogUtils.hs --- a/Bamse/DialogUtils.hs +++ b/Bamse/DialogUtils.hs @@ -1,15 +1,24 @@ --- --- (c) 2007, Galois, Inc. +-------------------------------------------------------------------- +-- | +-- Module : Bamse.DialogUtils +-- Description : MSI dialogs + utilities for creating your own. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- MSI dialogs + utilities for creating your own. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- +-- MSI dialogs + utilities for creating your own. +-- +-------------------------------------------------------------------- module Bamse.DialogUtils ( ghcPkgDialog -- :: Dialog , setupTypeDialog -- :: Dialog , customizeDialog -- :: Dialog ) where -import Bamse.Package +--import Bamse.Package import Bamse.Dialog ghcPkgDialog :: Dialog @@ -184,8 +193,13 @@ events = [ ("cancelButton", EndDialog "Exit", "1", "1") ] +addEvent :: CEvent -> Dialog -> Dialog addEvent ev d = d{dia_events=ev:dia_events d} + +addControl :: Control -> Dialog -> Dialog addControl ctrl d = d{dia_ctrls=ctrl:dia_ctrls d} + +addCond :: CCondition -> Dialog -> Dialog addCond cond d = d{dia_conds=cond:dia_conds d} withButtons :: String -> [Control] -> [Control] diff --git a/Bamse/GhcPackage.hs b/Bamse/GhcPackage.hs --- a/Bamse/GhcPackage.hs +++ b/Bamse/GhcPackage.hs @@ -1,8 +1,17 @@ +-------------------------------------------------------------------- +-- | +-- Module : Bamse.GhcPackage +-- Description : Specifying the contents of a GHC package. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- (c) 2007, Galois, Inc. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- -- Specifying the contents of a GHC package. --- +-- +-------------------------------------------------------------------- module Bamse.GhcPackage where data GhcPackage diff --git a/Bamse/IMonad.hs b/Bamse/IMonad.hs --- a/Bamse/IMonad.hs +++ b/Bamse/IMonad.hs @@ -1,8 +1,17 @@ +-------------------------------------------------------------------- +-- | +-- Module : Bamse.IMonad +-- Description : The 'installer monad' +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- (c) 2007, Galois, Inc. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- -- The 'installer monad' --- +-- +-------------------------------------------------------------------- module Bamse.IMonad ( IM -- abstract. Instance of: Monad, Functor , doInstall -- :: [Table] -- custom table definitions @@ -59,6 +68,7 @@ let (IM b) = cont x b st1 +returnIM :: a -> IM a returnIM x = IM $ \ st -> return (x,st) doInstall :: [Table] -> IM a -> IO (a, [(TableName, [Row])], [Table], [ReplaceRow]) @@ -75,7 +85,7 @@ , istate_files = [] } (v, is) <- ia initial_state - let sorted = map (\ ls@((x,_):_) -> (x,ls)) $ + let sorted = map (\ ss@((x,_):_) -> (x,ss)) $ groupBy (\ (x,_) (y,_) -> x==y) $ istate_rows is return (v, sorted, istate_tables is, istate_replaces is) diff --git a/Bamse/MSIExtra.hs b/Bamse/MSIExtra.hs --- a/Bamse/MSIExtra.hs +++ b/Bamse/MSIExtra.hs @@ -1,10 +1,19 @@ +-------------------------------------------------------------------- +-- | +-- Module : Bamse.MSIExtra +-- Description : Extensions to the MSI COM object model. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- (c) 2007, Galois, Inc. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- -- The MSI TLB doesn't provide everything we need to -- use the object model. This module provides these -- extra bits. --- +-- +-------------------------------------------------------------------- module Bamse.MSIExtra where import Data.Char ( toUpper ) diff --git a/Bamse/MSITable.hs b/Bamse/MSITable.hs --- a/Bamse/MSITable.hs +++ b/Bamse/MSITable.hs @@ -1,8 +1,17 @@ +-------------------------------------------------------------------- +-- | +-- Module : Bamse.MSITable +-- Description : Complete set of MSI table definitions (version 2.0) +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- (c) 2007, Galois, Inc. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- -- Complete set of MSI table definitions (version 2.0) -- +-------------------------------------------------------------------- module Bamse.MSITable ( Table , TableName @@ -40,6 +49,7 @@ , newAdminUISequence -- :: [Value] -> Row , newAdvtExecuteSequence -- :: [Value] -> Row , newAppSearch -- :: [Value] -> Row + , newAppId -- :: [Value] -> Row , newBBControl -- :: [Value] -> Row , newBillboard -- :: [Value] -> Row , newBinary -- :: [Value] -> Row @@ -92,6 +102,7 @@ , newPatchPackage -- :: [Value] -> Row , newProgId -- :: [Value] -> Row , newProperty -- :: [Value] -> Row + , newPublishComponent -- :: [Value] -> Row , newRadioButton -- :: [Value] -> Row , newRegistry -- :: [Value] -> Row , newRegLocator -- :: [Value] -> Row @@ -178,8 +189,10 @@ mkRow :: TableName -> [Value] -> Row mkRow nm vals = (nm,vals) +col :: a -> b -> (a,b) col nm v = (nm,v) +(-=>) :: a -> b -> (a,b) (-=>) = col string :: String -> ColumnValue @@ -206,18 +219,33 @@ nullable :: ColumnName -> ColType -> TableColumn nullable nm ct = (nm, (False, False, ct)) +charTy :: Maybe Int -> ColType charTy sz = CHAR sz False + +fileTy :: ColType fileTy = OBJECT + +intTy :: ColType intTy = INT + +longTy :: ColType longTy = LONG +localisable :: ColType -> ColType localisable (CHAR sz _) = CHAR sz True localisable t = t -- some common string/text types: +stdStringTy :: ColType stdStringTy = charTy (Just 72) + +maxStringTy :: ColType maxStringTy = charTy (Just 255) + +guidTy :: ColType guidTy = charTy (Just 38) + +versionTy :: ColType versionTy = charTy (Just 20) defineTable :: TableName -> [TableColumn] -> Table @@ -228,11 +256,11 @@ -> Maybe String -- Nothing => everything's ok -- (there's negative outlook for you, -- 'Nothing' to encode success). -validateRow tabs row@(nm, vals) = +validateRow tabs (nm, values) = case lookupBy ((nm==).fst) tabs of Just (_,cols) -> Just $ unlines $ catMaybes $ - (map (isValidColumn cols) vals ++ - map (hasValidColumn vals) cols) + (map (isValidColumn cols) values ++ + map (hasValidColumn values) cols) Nothing -> Just ("Unknown table: " ++ nm) where hasValidColumn vals (colNm, cVal) = @@ -323,6 +351,7 @@ , patchPackageTable , propertyTable , progIdTable + , publishComponentTable , radioButtonTable , registryTable , regLocatorTable @@ -709,6 +738,7 @@ controlName :: TableName controlName = "Control" +controlTable :: Table controlTable = defineTable controlName [ key "Dialog_" stdStringTy @@ -740,6 +770,7 @@ controlConditionName :: TableName controlConditionName = "ControlCondition" +controlConditionTable :: Table controlConditionTable = defineTable controlConditionName [ key "Dialog_" stdStringTy @@ -761,6 +792,7 @@ controlEventName :: TableName controlEventName = "ControlEvent" +controlEventTable :: Table controlEventTable = defineTable controlEventName [ key "Dialog_" stdStringTy diff --git a/Bamse/Options.hs b/Bamse/Options.hs --- a/Bamse/Options.hs +++ b/Bamse/Options.hs @@ -1,6 +1,17 @@ +-------------------------------------------------------------------- +-- | +-- Module : Bamse.Options +-- Description : Option handling for generated Bamse installers. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- (c) 2007, Galois, Inc. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- +-- Types and code for processing command-line arguments for an installer. +-- +-------------------------------------------------------------------- module Bamse.Options where import Bamse.Package diff --git a/Bamse/Package.hs b/Bamse/Package.hs --- a/Bamse/Package.hs +++ b/Bamse/Package.hs @@ -1,10 +1,19 @@ +-------------------------------------------------------------------- +-- | +-- Module : Bamse.Package +-- Description : Description of an MSI package/product. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- (c) 2007, Galois, Inc. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- -- Meta information describing an MSI package/product. -- Whatever the front-end, this is what a package spec -- boils down to. --- +-- +-------------------------------------------------------------------- module Bamse.Package ( module Bamse.Package , module Bamse.GhcPackage diff --git a/Bamse/PackageGen.hs b/Bamse/PackageGen.hs --- a/Bamse/PackageGen.hs +++ b/Bamse/PackageGen.hs @@ -1,9 +1,17 @@ --- --- (c) 2007, Galois, Inc. +-------------------------------------------------------------------- +-- | +-- Module : Bamse.PackageGen +-- Description : Given a package specification, generate the MSI tables. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- Given a package specification, generate the MSI --- tables. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- +-- Given a package specification, generate the MSI tables. +-- +-------------------------------------------------------------------- module Bamse.PackageGen where import Bamse.Package diff --git a/Bamse/PackageUtils.hs b/Bamse/PackageUtils.hs --- a/Bamse/PackageUtils.hs +++ b/Bamse/PackageUtils.hs @@ -1,9 +1,17 @@ --- --- (c) 2007, Galois, Inc. +-------------------------------------------------------------------- +-- | +-- Module : Bamse.PackageUtils +-- Description : Helper functions for installer template modules. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- Misc helper functions that come in handy when --- defining installer modules. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- +-- Misc helper functions that come in handy when defining installer modules. +-- +-------------------------------------------------------------------- module Bamse.PackageUtils where import Bamse.Package @@ -16,8 +24,9 @@ import System.Environment import Debug.Trace ( trace ) --- | convert (base) filename to MSI output filename, appending --- the .msi suffix + doing away with troublesome characters. +-- | @toMsiFileName fp@ converts a (base) filename to an MSI output +-- filename, appending the .msi suffix + doing away with +-- troublesome characters. toMsiFileName :: FilePath -> FilePath toMsiFileName f = map dotToDash f ++ ".msi" @@ -72,7 +81,7 @@ expandString [] = [] expandString ('$':'<':xs) = case break isTerm xs of - (as,[]) -> '$' : '<' : expandString xs + (_as,[]) -> '$' : '<' : expandString xs (var,y:ys) -> case mbEnv var of Nothing -> @@ -93,9 +102,9 @@ isTerm _ = False getDefault [] = ([],[]) - getDefault ('\\':'>':xs) = let (as,bs) = getDefault xs in ('>':as,bs) - getDefault ('>':xs) = ([],xs) - getDefault (x:xs) = let (as,bs) = getDefault xs in (x:as,bs) + getDefault ('\\':'>':cs) = let (as,bs) = getDefault cs in ('>':as,bs) + getDefault ('>':ds) = ([],ds) + getDefault (x:cs) = let (as,bs) = getDefault cs in (x:as,bs) expandString (x:xs) = x : expandString xs mbEnv :: String -> Maybe String @@ -105,33 +114,35 @@ ls <- readIORef env_list return (lookup s ls)) +haskellProject :: String -> [(String,String)] -> [RegEntry] haskellProject nm values = RegEntry "OnInstall" "Software" (CreateKey False) : RegEntry "OnInstall" "Software\\Haskell" (CreateKey False) : RegEntry "OnInstall" "Software\\Haskell\\Projects" (CreateKey False) : RegEntry "OnInstall" proj_path (CreateKey True) : - map (\ (nm,val) -> RegEntry "OnInstall" proj_path - (CreateName (Just nm) val)) + map (\ (k,val) -> RegEntry "OnInstall" proj_path (CreateName (Just k) val)) values where proj_path = "Software\\Haskell\\Projects\\"++nm +haskellImpl :: String -> String -> [(String,String)] -> [RegEntry] haskellImpl nm version values = RegEntry "OnInstall" "Software" (CreateKey False) : RegEntry "OnInstall" "Software\\Haskell" (CreateKey False) : RegEntry "OnInstall" impl_path (CreateKey False) : RegEntry "OnInstall" impl_path (CreateName (Just "InstallDir") "[TARGETDIR]") : RegEntry "OnInstall" ver_path (CreateKey True) : - map (\ (nm,val) -> RegEntry "OnInstall" ver_path (CreateName (Just nm) val)) + map (\ (k,val) -> RegEntry "OnInstall" ver_path (CreateName (Just k) val)) values where impl_path = "Software\\Haskell\\"++nm ver_path = "Software\\Haskell\\"++nm ++ '\\':version +hugsPath :: String -> (String, String) hugsPath val = ("hugsPath", val) haskellExtension :: FilePath -> FilePath -> FilePath -> String -> Extension -haskellExtension binary topDir bamseDir ext +haskellExtension binary _topDir bamseDir ext = ( "HaskellFile" , binary , lFile iconDir "hs2.exe" diff --git a/Bamse/WindowsInstaller.hs b/Bamse/WindowsInstaller.hs --- a/Bamse/WindowsInstaller.hs +++ b/Bamse/WindowsInstaller.hs @@ -1,8 +1,22 @@ +-------------------------------------------------------------------- +-- | +-- Module : Bamse.WindowsInstaller +-- Description : Haskell binding to the MSI COM object model +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 +-- +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable +-- +-- Haskell binding to the MSI COM object model +-------------------------------------------------------------------- +module Bamse.WindowsInstaller where +-- -- Automatically generated by HaskellDirect (ihc.exe), version 0.18 -- Created: 11:52 Pacific Standard Time, Friday 16 November, 2001 -- Command line: --tlb -odir . d:/winnt/system32/msi.dll -v -dshow-passes -fno-export-list - -module Bamse.WindowsInstaller where +-- import qualified Prelude import qualified System.Win32.Com.Automation as Automation diff --git a/Bamse/Writer.hs b/Bamse/Writer.hs --- a/Bamse/Writer.hs +++ b/Bamse/Writer.hs @@ -1,8 +1,35 @@ +-------------------------------------------------------------------- +-- | +-- Module : Bamse.Writer +-- Description : Outputting an MSI database +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- (c) 2007, Galois, Inc. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- -- Outputting an MSI database. -- +-- This module serialises an MS Installer package. An installer is +-- a database containing a number of tables describing what's supposed +-- to happen when the installer is run (to install / un-install the +-- package). We construct the database from the table data specified +-- in Haskell together with meta-data describing the package itself. +-- +-- Comments: +-- The only export from this module is 'outputMSI' which coordinates +-- the steps involved in creating an MSI installer: +-- +-- * creates base package (from external files). +-- * adds meta data describing package/installer. +-- * fills in the database tables making up the installer. +-- * (optionally) compress the MSI by running 'makecab'. +-- +-- ToDo: +-- let you create a web-based installer. +-- +-------------------------------------------------------------------- module Bamse.Writer ( outputMSI -- :: WriterEnv {- env (file to output to, etc.) -} -- -> Package {- specification of package -} @@ -45,29 +72,6 @@ import Bamse.WindowsInstaller hiding ( sequence ) import Debug.Trace ( trace ) -{- - Module: Writer - - Purpose: - this module serialises an MS Installer package. An installer is - a database containing a number of tables describing what's supposed - to happen when the installer is run (to install / un-install the - package). We construct the database from the table data specified - in Haskell together with meta-data describing the package itself. - - Comments: - The only export from this module is 'outputMSI' which coordinates - the steps involved in creating an MSI installer: - - * creates base package (from external files). - * adds meta data describing package/installer. - * fills in the database tables making up the installer. - * (optionally) compress the MSI by running 'makecab'. - - ToDo: - let you create a web-based installer. --} - -- -- Function: outputMSI -- @@ -131,7 +135,7 @@ return (prodC, revC) topHandler ip err - | isCoError err = flip catch (\ e -> ioError e) $ do + | isCoError err = flip catchComException throwIOComException $ do let v = coGetErrorString err rec <- ip # lastErrorRecord len <- rec # getFieldCount @@ -231,8 +235,9 @@ writeRow view idx_vals = do rec <- ip # createRecord (fromIntegral sz) mapM_ (writeValue rec) idx_vals - catch (view # execute rec) - (\ err -> print (nm, insertRowSql tables nm, idx_vals) >> ioError err) + catchComException + (view # execute rec) + (\ err -> print (nm, insertRowSql tables nm, idx_vals) >> throwIOComException err) return () writeValue rec (idx_i, v) = @@ -240,11 +245,11 @@ String s -> rec # setStringData idx s Int i -> rec # setIntegerData idx (fromIntegral i) Long l -> rec # setIntegerData idx (fromIntegral l) - File f -> catch + File f -> catchComException (rec # setStream idx f) - (\ ioe -> do + (\ exn -> do hPutStrLn stderr ("Unable to store file: " ++ show f) - ioError ioe) + throwIOComException exn) where idx :: Int32 idx = fromIntegral idx_i @@ -324,8 +329,9 @@ rec <- inst # createRecord 2 rec # setStringData 1 name rec # setStringData 2 val - catch (view # execute rec) - (\ e -> putStrLn ("setPair failed: " ++ name) >> ioError e) + catchComException + (view # execute rec) + (\ e -> putStrLn ("setPair failed: " ++ name) >> throwIOComException e) return () setSummaryInformation :: [(ProductIDTag, String)] @@ -373,11 +379,10 @@ -> IO () createTables tabs db = do notTheres <- filterM isPresent tabs - mapM_ (\ t -> catch (db # newTable t) - (const (return ()))) + mapM_ (\ t -> catchComException (db # newTable t) (const (return ()))) notTheres where - isPresent (tNm, _) = catch + isPresent (tNm, _) = catchComException (do rc <- db # getTablePersistent tNm case rc of @@ -493,7 +498,7 @@ -> Database a -> IO () replaceColumns tabName keyVals newVals db = - catch + catchComException (do (rec, view) <- db # fetchRow tabName keyVals newVals zipWithM_ (setField rec) [1..] newVals @@ -574,8 +579,9 @@ (hPutStrLn stderr "makeCab: CostInitialize failed") -- sequence the File table view <- db # openView "SELECT Sequence,Attributes FROM File" - catch (view # execute ()) - (\ e -> putStrLn "File selection failed" >> ioError e) + catchComException + (view # execute ()) + (\ e -> putStrLn "File selection failed" >> throwIOComException e) let findSeq lSeq = do rec <- view # fetch @@ -587,8 +593,9 @@ findSeq (if ((att .&. 0x00004000) == 0) && (seq > lSeq) then seq else lSeq) lSeq <- findSeq 0 view <- db # openView "SELECT File,FileName,Directory_,Sequence,File.Attributes FROM File,Component WHERE Component_=Component ORDER BY Directory_" - catch (view # execute ()) - (\ e -> putStrLn "Directory selection failed" >> ioError e) + catchComException + (view # execute ()) + (\ e -> putStrLn "Directory selection failed" >> throwIOComException e) let ddfFile = bName ++ ".ddf" hFile <- openFile ddfFile WriteMode let ct = (0::Int) @@ -638,8 +645,9 @@ | not (null long') = tail long' | otherwise = fName - sPath <- catch (session # getSourcePath folder) - (\ e -> hPutStrLn stderr ("error: " ++ show (fKey,fName,folder)) >> ioError e) + sPath <- catchComException + (session # getSourcePath folder) + (\ e -> hPutStrLn stderr ("error: " ++ show (fKey,fName,folder)) >> throwIOComException e) let sourcePath = sPath ++ fName' hPutStrLn hFile ("\"" ++ sourcePath ++ "\" " ++ fKey) st <- ip # fileAttributes sourcePath diff --git a/bamse.cabal b/bamse.cabal --- a/bamse.cabal +++ b/bamse.cabal @@ -1,5 +1,5 @@ name: bamse -version: 0.9.2 +version: 0.9.3 Synopsis: A Windows Installer (MSI) generator framework Description: Bamse is a framework for building Windows Installers for @@ -97,7 +97,7 @@ Ghc-Options: -Wall - build-depends: com >= 1.2 , haskell98, directory, pretty + build-depends: com >= 1.2.2 , haskell98, directory, pretty if flag(old-base) Build-Depends: base < 3 else diff --git a/templates/Alex.hs b/templates/Alex.hs --- a/templates/Alex.hs +++ b/templates/Alex.hs @@ -1,12 +1,20 @@ +-------------------------------------------------------------------- +-- | +-- Module : Alex +-- Description : Specification/template for the Alex installer builder. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- (c) 2007, Galois, Inc. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- --- To create a package, you need to define a module --- which exports information and functions that together --- define the functionality (and contents) of your package. +-- To create your own installer, you need to supply a Haskell module +-- which exports functions and values that together define the +-- functionality (and contents) of your package; +-- see this module (Base.hs) just what those exports are. -- --- [Having Haskell as the only 'specification language' for packages --- is not a goal. ] +-------------------------------------------------------------------- module Alex where import Data.List diff --git a/templates/Bamse.hs b/templates/Bamse.hs --- a/templates/Bamse.hs +++ b/templates/Bamse.hs @@ -1,8 +1,20 @@ +-------------------------------------------------------------------- +-- | +-- Module : Bamse +-- Description : Specification/template for the Bamse installer builder. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- Specification/template for the Bamse tool itself. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- --- (c) 2007, Galois, Inc. +-- To create your own installer, you need to supply a Haskell module +-- which exports functions and values that together define the +-- functionality (and contents) of your package; +-- see this module (Base.hs) just what those exports are. -- +-------------------------------------------------------------------- module Bamse where import Bamse.Package @@ -29,7 +41,7 @@ } webSite :: String -webSite = "http://www.galois.com/" +webSite = "http://haskell.forkIO.com/" bannerBitmap :: InstallEnv -> Maybe FilePath bannerBitmap ienv = Just (lFile (toolDir ienv) "art/banner3.bmp") diff --git a/templates/Base.hs b/templates/Base.hs --- a/templates/Base.hs +++ b/templates/Base.hs @@ -1,11 +1,20 @@ --- --- (c) 2007, Galois, Inc. +-------------------------------------------------------------------- +-- | +-- Module : Base +-- Description : Specification/template for the Base installer builder. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- Installer builder template; please copy and modify. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- -- To create your own installer, you need to supply a Haskell module --- which exports the functions and values below. +-- which exports functions and values that together define the +-- functionality (and contents) of your package; +-- see this module (Base.hs) just what those exports are. -- +-------------------------------------------------------------------- module Base -- for informational purposes, here's the exports -- the Bamse infrastructure expects: diff --git a/templates/ComPkg.hs b/templates/ComPkg.hs --- a/templates/ComPkg.hs +++ b/templates/ComPkg.hs @@ -1,12 +1,20 @@ +-------------------------------------------------------------------- +-- | +-- Module : ComPkg +-- Description : Specification/template for the ComPkg installer builder. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- (c) 2007, Galois, Inc. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- --- To create a package, you need to define a module --- which exports information and functions that together --- define the functionality (and contents) of your package. +-- To create your own installer, you need to supply a Haskell module +-- which exports functions and values that together define the +-- functionality (and contents) of your package; +-- see Base.hs just what those exports are. -- --- [Having Haskell as the only 'specification language' for packages --- is not a goal. ] +-------------------------------------------------------------------- module ComPkg where import Util.Dir diff --git a/templates/Cryptol.hs b/templates/Cryptol.hs --- a/templates/Cryptol.hs +++ b/templates/Cryptol.hs @@ -1,19 +1,25 @@ --- --- (c) 2007, Galois, Inc. +-------------------------------------------------------------------- +-- | +-- Module : Cryptol +-- Description : Specification/template for the Cryptol installer builder. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- Specification/template for the Cryptol installer builder. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- -- To create your own installer, you need to supply a Haskell module -- which exports functions and values that together define the -- functionality (and contents) of your package; -- see Base.hs just what those exports are. -- +-------------------------------------------------------------------- module Cryptol where import Bamse.Package import Bamse.PackageUtils -import Data.List ( intersperse ) import Util.Dir ( DirTree(..), findFiles ) import Util.Path ( baseName ) import Util.List ( concatWith ) diff --git a/templates/GHC.hs b/templates/GHC.hs --- a/templates/GHC.hs +++ b/templates/GHC.hs @@ -1,5 +1,13 @@ +-------------------------------------------------------------------- +-- | +-- Module : GHC +-- Description : Specification/template for the GHC installer builder. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- (c) 2007, Galois, Inc. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- -- Template file for (big) GHC installers. -- @@ -10,6 +18,7 @@ -- - make profiling a separate feature. -- - bundle up less-used packages into separate installers. -- +-------------------------------------------------------------------- module GHC where import Util.Dir diff --git a/templates/GaloisPkg.hs b/templates/GaloisPkg.hs --- a/templates/GaloisPkg.hs +++ b/templates/GaloisPkg.hs @@ -1,12 +1,20 @@ +-------------------------------------------------------------------- +-- | +-- Module : GaloisPkg +-- Description : Specification/template for the GaloisPkg installer builder. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- (c) 2007, Galois, Inc. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- --- To create a package, you need to define a module --- which exports information and functions that together --- define the functionality (and contents) of your package. +-- To create your own installer, you need to supply a Haskell module +-- which exports functions and values that together define the +-- functionality (and contents) of your package; +-- see Base.hs just what those exports are. -- --- [Having Haskell as the only 'specification language' for packages --- is not a goal. ] +-------------------------------------------------------------------- module GaloisPkg where import Util.Dir diff --git a/templates/Greencard.hs b/templates/Greencard.hs --- a/templates/Greencard.hs +++ b/templates/Greencard.hs @@ -1,12 +1,20 @@ +-------------------------------------------------------------------- +-- | +-- Module : Greencard +-- Description : Specification/template for the Greencard installer builder. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- (c) 2007, Galois, Inc. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- --- To create a package, you need to define a module --- which exports information and functions that together --- define the functionality (and contents) of your package. +-- To create your own installer, you need to supply a Haskell module +-- which exports functions and values that together define the +-- functionality (and contents) of your package; +-- see Base.hs just what those exports are. -- --- [Having Haskell as the only 'specification language' for packages --- is not a goal. ] +-------------------------------------------------------------------- module Greencard where import Util.Dir diff --git a/templates/HDirectLib.hs b/templates/HDirectLib.hs --- a/templates/HDirectLib.hs +++ b/templates/HDirectLib.hs @@ -1,15 +1,20 @@ --- --- (c) 2007, Galois, Inc. +-------------------------------------------------------------------- +-- | +-- Module : HDirectLib +-- Description : Specification/template for the HDirectLib installer builder. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- To create a package, you need to define a module --- which exports information and functions that together --- define the functionality (and contents) of your package. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- --- [Having Haskell as the only 'specification language' for packages --- is not a goal. ] +-- To create your own installer, you need to supply a Haskell module +-- which exports functions and values that together define the +-- functionality (and contents) of your package; +-- see Base.hs just what those exports are. -- --- Installer definition for the HaskellDirect Hugs libraries. --- +-------------------------------------------------------------------- module HDirectLib where import Util.Dir diff --git a/templates/Haddock.hs b/templates/Haddock.hs --- a/templates/Haddock.hs +++ b/templates/Haddock.hs @@ -1,12 +1,20 @@ +-------------------------------------------------------------------- +-- | +-- Module : Haddock +-- Description : Specification/template for the Haddock installer builder. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- (c) 2007, Galois, Inc. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- --- To create a package, you need to define a module --- which exports information and functions that together --- define the functionality (and contents) of your package. +-- To create your own installer, you need to supply a Haskell module +-- which exports functions and values that together define the +-- functionality (and contents) of your package; +-- see Base.hs just what those exports are. -- --- [Having Haskell as the only 'specification language' for packages --- is not a goal. ] +-------------------------------------------------------------------- module Haddock where import Data.List diff --git a/templates/Happy.hs b/templates/Happy.hs --- a/templates/Happy.hs +++ b/templates/Happy.hs @@ -1,12 +1,20 @@ +-------------------------------------------------------------------- +-- | +-- Module : Happy +-- Description : Specification/template for the Happy installer builder. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- (c) 2007, Galois, Inc. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- --- To create a package, you need to define a module --- which exports information and functions that together --- define the functionality (and contents) of your package. +-- To create your own installer, you need to supply a Haskell module +-- which exports functions and values that together define the +-- functionality (and contents) of your package; +-- see Base.hs just what those exports are. -- --- [Having Haskell as the only 'specification language' for packages --- is not a goal. ] +-------------------------------------------------------------------- module Happy where import Data.List diff --git a/templates/Hugs98.hs b/templates/Hugs98.hs --- a/templates/Hugs98.hs +++ b/templates/Hugs98.hs @@ -1,12 +1,20 @@ +-------------------------------------------------------------------- +-- | +-- Module : Hugs98 +-- Description : Specification/template for the Hugs98 installer builder. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- (c) 2007, Galois, Inc. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- --- To create a package, you need to define a module --- which exports information and functions that together --- define the functionality (and contents) of your package. +-- To create your own installer, you need to supply a Haskell module +-- which exports functions and values that together define the +-- functionality (and contents) of your package; +-- see Base.hs just what those exports are. -- --- [Having Haskell as the only 'specification language' for packages --- is not a goal. ] +-------------------------------------------------------------------- module Hugs98 where import Bamse.Package diff --git a/templates/Hugs98Net.hs b/templates/Hugs98Net.hs --- a/templates/Hugs98Net.hs +++ b/templates/Hugs98Net.hs @@ -1,12 +1,22 @@ +-------------------------------------------------------------------- +-- | +-- Module : Hugs98Net +-- Description : Specification/template for the public Hugs98.NET installer builder. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- (c) 2007, Galois, Inc. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- --- To create a package, you need to define a module --- which exports information and functions that together --- define the functionality (and contents) of your package. +-- To create your own installer, you need to supply a Haskell module +-- which exports functions and values that together define the +-- functionality (and contents) of your package; +-- see Base.hs just what those exports are. -- -- [Having Haskell as the only 'specification language' for packages -- is not a goal. ] +-------------------------------------------------------------------- module Hugs98Net where import Bamse.Package diff --git a/templates/PubCryptol.hs b/templates/PubCryptol.hs --- a/templates/PubCryptol.hs +++ b/templates/PubCryptol.hs @@ -1,13 +1,22 @@ --- --- (c) 2007, Galois, Inc. +-------------------------------------------------------------------- +-- | +-- Module : PubCryptol +-- Description : Specification/template for the public Cryptol installer builder. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- Specification/template for the (public) Cryptol installer builder. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- -- To create your own installer, you need to supply a Haskell module -- which exports functions and values that together define the -- functionality (and contents) of your package; -- see Base.hs just what those exports are. -- +-- [Having Haskell as the only 'specification language' for packages +-- is not a goal. ] +-------------------------------------------------------------------- module PubCryptol where import Bamse.Package diff --git a/templates/SOE.hs b/templates/SOE.hs --- a/templates/SOE.hs +++ b/templates/SOE.hs @@ -1,12 +1,22 @@ +-------------------------------------------------------------------- +-- | +-- Module : SOE +-- Description : Specification/template for the SOE installer builder. +-- Copyright : (c) Sigbjorn Finne, 2004-2009 +-- License : BSD3 -- --- (c) 2007, Galois, Inc. +-- Maintainer : Sigbjorn Finne +-- Stability : provisional +-- Portability : portable -- --- To create a package, you need to define a module --- which exports information and functions that together --- define the functionality (and contents) of your package. +-- To create your own installer, you need to supply a Haskell module +-- which exports functions and values that together define the +-- functionality (and contents) of your package; +-- see Base.hs just what those exports are. -- -- [Having Haskell as the only 'specification language' for packages -- is not a goal. ] +-------------------------------------------------------------------- module SOE where import MSIExtra