-------------------------------------------------------------------- -- | -- Module : Bamse.MSITable -- Description : Complete set of MSI table definitions (version 2.0) -- Copyright : (c) Sigbjorn Finne, 2004-2009 -- License : BSD3 -- -- Maintainer : Sigbjorn Finne -- Stability : provisional -- Portability : portable -- -- Complete set of MSI table definitions (version 2.0) -- -------------------------------------------------------------------- module Bamse.MSITable ( Table , TableName , TableColumn , ColumnValue(..) , ColumnName , ColType(..) , ReplaceRow , RowKey , Key -- type _ = String , Row , RowData , Value -- type _ = (ColumnName,Maybe ColumnValue) , mkRow -- :: TableName -> [Value] -> Row , col -- :: ColumnName -> Maybe ColumnValue -> Value , string -- :: String -> ColumnValue , int -- :: Int -> ColumnValue , long -- :: Int -> ColumnValue , file -- :: FilePath -> ColumnValue , (-=>) , defineTable -- :: TableName -> [TableColumn] -> Table , key -- :: ColumnName -> ColType -> TableColumn , notNullable -- :: ColumnName -> ColType -> TableColumn , nullable -- :: ColumnName -> ColType -> TableColumn -- standard tables. , msiTables -- :: [Table] , newActionText -- :: [Value] -> Row , newAdminExecuteSequence -- :: [Value] -> Row , newAdminUISequence -- :: [Value] -> Row , newAdvtExecuteSequence -- :: [Value] -> Row , newAppSearch -- :: [Value] -> Row , newAppId -- :: [Value] -> Row , newBBControl -- :: [Value] -> Row , newBillboard -- :: [Value] -> Row , newBinary -- :: [Value] -> Row , newBindImage -- :: [Value] -> Row , newCCPSearch -- :: [Value] -> Row , newCheckBox -- :: [Value] -> Row , newClass -- :: [Value] -> Row , newComboBox -- :: [Value] -> Row , newCompLocator -- :: [Value] -> Row , newComponent -- :: [Value] -> Row , newComplus -- :: [Value] -> Row , newControl -- :: [Value] -> Row , newControlCondition -- :: [Value] -> Row , newControlEvent -- :: [Value] -> Row , newCreateFolder -- :: [Value] -> Row , newCustomAction -- :: [Value] -> Row , newDialog -- :: [Value] -> Row , newDirectory -- :: [Value] -> Row , newDrLocator -- :: [Value] -> Row , newDuplicateFile -- :: [Value] -> Row , newEnvironment -- :: [Value] -> Row , newError -- :: [Value] -> Row , newEventMapping -- :: [Value] -> Row , newExtension -- :: [Value] -> Row , newFeature -- :: [Value] -> Row , newFeatureComponents -- :: [Value] -> Row , newFile -- :: [Value] -> Row , newFileSFPCatalog -- :: [Value] -> Row , newFont -- :: [Value] -> Row , newIcon -- :: [Value] -> Row , newIniFile -- :: [Value] -> Row , newIniLocator -- :: [Value] -> Row , newIsolatedComponent -- :: [Value] -> Row , newInstallExecuteSequence -- :: [Value] -> Row , newInstallUISequence -- :: [Value] -> Row , newLaunchCondition -- :: [Value] -> Row , newListBox -- :: [Value] -> Row , newListView -- :: [Value] -> Row , newLockPermissions -- :: [Value] -> Row , newMedia -- :: [Value] -> Row , newMIME -- :: [Value] -> Row , newMoveFile -- :: [Value] -> Row , newMsiAssembly -- :: [Value] -> Row , newMsiAssemblyName -- :: [Value] -> Row , newMsiDigitalCertificate -- :: [Value] -> Row , newMsiDigitalSignature -- :: [Value] -> Row , newMsiFileHash -- :: [Value] -> Row , newMsiPatchHeaders -- :: [Value] -> Row , newPatch -- :: [Value] -> Row , newPatchPackage -- :: [Value] -> Row , newProgId -- :: [Value] -> Row , newProperty -- :: [Value] -> Row , newPublishComponent -- :: [Value] -> Row , newRadioButton -- :: [Value] -> Row , newRegistry -- :: [Value] -> Row , newRegLocator -- :: [Value] -> Row , newRemoveFile -- :: [Value] -> Row , newRemoveIniFile -- :: [Value] -> Row , newRemoveRegistry -- :: [Value] -> Row , newReserveCost -- :: [Value] -> Row , newSelfReg -- :: [Value] -> Row , newServiceControl -- :: [Value] -> Row , newServiceInstall -- :: [Value] -> Row , newSFPCatalog -- :: [Value] -> Row , newShortcut -- :: [Value] -> Row , newSignature -- :: [Value] -> Row , newTextStyle -- :: [Value] -> Row , newTypeLib -- :: [Value] -> Row , newUIText -- :: [Value] -> Row , newUpgrade -- :: [Value] -> Row , newVerb -- :: [Value] -> Row , validateRow -- :: [Table] -> Row -> Maybe String , intTy , longTy , charTy , maxStringTy , stdStringTy , fileTy ) where import Bamse.Util.List import Data.Maybe import Bamse.PackageUtils ( expandString ) {- Encoding MSI tables in Haskell. Currently we opt for a loose encoding which simply states the name of the columns that an MSI defines, and whether that that column may have 'null' row entries. A type-safer encoding would be to use types to encode individual tables, but that _could_ be layered on top of this encoding. -} type Table = (TableName, [TableColumn]) type TableName = String type TableColumn = ( ColumnName , ColumnType -- what kind (key, nullable etc.) and type of column it is. ) type ColumnName = String -- | 'ColumnType' type ColumnType = ( Bool -- True => NOT NULL. , Bool -- True => is primary key. , ColType ) data ColType = CHAR (Maybe Int) -- Just x => size 'x'. Bool -- True => localisable | LONGCHAR Bool -- True => localisable | INT -- represents also INTEGER and SHORT (they're all 16-bit types, I believe). | LONG | OBJECT -- Table instances / rows: type Row = (TableName, [Value]) type Value = (ColumnName, Maybe ColumnValue) type RowData = [(Int, ColumnValue)] type ReplaceRow = (TableName, [RowKey], [Value]) type RowKey = (ColumnName, Key) type Key = String data ColumnValue = String String | Int Int | Long Int | File FilePath deriving Show 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 string s = String (expandString s) int :: Int -> ColumnValue int i = Int i long :: Int -> ColumnValue long i = Long i file :: FilePath -> ColumnValue file f = File f key :: ColumnName -> ColType -> TableColumn key nm ct = (nm, (True, True, ct)) keyNullable :: ColumnName -> ColType -> TableColumn keyNullable nm ct = (nm, (False, True, ct)) notNullable :: ColumnName -> ColType -> TableColumn notNullable nm ct = (nm, (True,False,ct)) 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 defineTable nm fs = (nm, fs) validateRow :: [Table] -> Row -> Maybe String -- Nothing => everything's ok -- (there's negative outlook for you, -- 'Nothing' to encode success). validateRow tabs (nm, values) = case lookupBy ((nm==).fst) tabs of Just (_,cols) -> Just $ unlines $ catMaybes $ (map (isValidColumn cols) values ++ map (hasValidColumn values) cols) Nothing -> Just ("Unknown table: " ++ nm) where hasValidColumn vals (colNm, cVal) = case cVal of -- if the column can contain null or has a default value, -- the presence or absense of a value for it in the row won't -- make a difference. (False,_,_) -> Nothing _ -> case lookupBy ((==colNm).fst) vals of Nothing -> Just ("Value not found for required column: " ++ colNm) Just{} -> Nothing isValidColumn cols (colNm, mbVal) = case lookupBy ((colNm==).fst) cols of Nothing -> Just ("Unknown column: " ++ colNm) Just (_, colVal) -> case colVal of (_,True,_) | not (isJust mbVal) -> Just ("Missing value for key column: " ++ colNm) | otherwise -> Nothing (True,_,_) | not (isJust mbVal) -> Just ("Missing value for non-nullable column: " ++ colNm) | otherwise -> Nothing (False,_,_) -> Nothing msiTables :: [Table] msiTables = [ actionTextTable , adminExecuteSequenceTable , adminUISequenceTable , advtExecuteSequenceTable , appIdTable , appSearchTable , bbControlTable , billboardTable , binaryTable , bindImageTable , ccpSearchTable , checkBoxTable , classTable , comboBoxTable , compLocatorTable , complusTable , componentTable , controlTable , controlConditionTable , controlEventTable , createFolderTable , customActionTable , dialogTable , directoryTable , drLocatorTable , duplicateFileTable , environmentTable , errorTable , eventMappingTable , extensionTable , featureTable , featureComponentsTable , fileTable , fileSFPCatalogTable , fontTable , iconTable , iniFileTable , iniLocatorTable , isolatedComponentTable , installExecuteSequenceTable , installUISequenceTable , launchConditionTable , listBoxTable , listViewTable , lockPermissionsTable , mediaTable , mimeTable , moveFileTable , msiAssemblyTable , msiAssemblyNameTable , msiDigitalCertificateTable , msiDigitalSignatureTable , msiFileHashTable , msiPatchHeadersTable , patchTable , patchPackageTable , propertyTable , progIdTable , publishComponentTable , radioButtonTable , registryTable , regLocatorTable , removeFileTable , removeIniFileTable , removeRegistryTable , reserveCostTable , selfRegTable , serviceControlTable , serviceInstallTable , sfpCatalogTable , shortcutTable , signatureTable , textStyleTable , typeLibTable , uiTextTable , upgradeTable , verbTable ] {- Purpose: The AdminExecuteSequence table lists actions that the installer calls in sequence when the top-level ADMIN action is executed. -} actionTextName :: TableName actionTextName = "ActionText" actionTextTable :: Table actionTextTable = defineTable actionTextName [ key "Action" stdStringTy , nullable "Condition" maxStringTy , nullable "Sequence" maxStringTy ] newActionText :: [Value] -> Row newActionText vals = mkRow actionTextName vals {- Purpose: The AdminExecuteSequence table lists actions that the installer calls in sequence when the top-level ADMIN action is executed. -} adminExecuteSequenceName :: TableName adminExecuteSequenceName = "AdminExecuteSequence" adminExecuteSequenceTable :: Table adminExecuteSequenceTable = defineTable adminExecuteSequenceName [ key "Action" stdStringTy , nullable "Condition" maxStringTy , notNullable "Sequence" intTy ] newAdminExecuteSequence :: [Value] -> Row newAdminExecuteSequence vals = mkRow adminExecuteSequenceName vals {- Purpose: The AdminUISequence table lists actions that the installer calls in sequence when the top-level ADMIN action is executed and the internal user interface level is set to full UI or reduced UI. -} adminUISequenceName :: TableName adminUISequenceName = "AdminUISequence" adminUISequenceTable :: Table adminUISequenceTable = defineTable adminUISequenceName [ key "Action" stdStringTy , nullable "Condition" maxStringTy , notNullable "Sequence" intTy ] newAdminUISequence :: [Value] -> Row newAdminUISequence vals = mkRow adminUISequenceName vals {- Purpose: The AdvtExecuteSequence table lists actions that the installer calls in sequence when the top-level ADVERTISE action is executed. -} advtExecuteSequenceName :: TableName advtExecuteSequenceName = "AdvtExecuteSequence" advtExecuteSequenceTable :: Table advtExecuteSequenceTable = defineTable advtExecuteSequenceName [ key "Action" stdStringTy , nullable "Condition" maxStringTy , notNullable "Sequence" intTy ] newAdvtExecuteSequence :: [Value] -> Row newAdvtExecuteSequence vals = mkRow advtExecuteSequenceName vals {- Purpose: The AppId table or the Registry table specifies that the installer configure and register DCOM servers to do one of the following during an installation: * Run the DCOM server under a different identity than the user activating the server. For example, to configure a DCOM server to always run as an interactive user or as a predefined user. * Run the DCOM server as a service. * Configure the default security access for the DCOM server. * Register the DCOM server such that it is activated on a different computer. This table is processed at the installation of the component associated with the DCOM server in the _Component column of the Class table. An AppId is not advertised. -} appIdName :: TableName appIdName = "AppId" appIdTable :: Table appIdTable = defineTable appIdName [ key "AppId" (charTy (Just 38)) , nullable "RemoteServerName" maxStringTy , nullable "LocalService" maxStringTy , nullable "ServiceParameters" maxStringTy , nullable "DllSurrogate" maxStringTy , nullable "ActivateAtStorage" intTy , nullable "RunAsInteractiveUser" intTy ] newAppId :: [Value] -> Row newAppId = mkRow appIdName {- Purpose: The AppSearch table contains properties needed to search for a file having a particular file signature. The AppSearch table can also be used to set a property to the existing value of a registry or .ini file entry. -} appSearchName :: TableName appSearchName = "AppSearch" appSearchTable :: Table appSearchTable = defineTable appSearchName [ key "Property" stdStringTy , key "Signature_" stdStringTy ] newAppSearch :: [Value] -> Row newAppSearch = mkRow appSearchName {- Purpose: The BBControl table lists the controls to be displayed on each billboard. -} bbControlName :: TableName bbControlName = "BBControl" bbControlTable :: Table bbControlTable = defineTable bbControlName [ key "Billboard_" stdStringTy , key "BBControl" stdStringTy , notNullable "Type" stdStringTy , notNullable "X" intTy , notNullable "Y" intTy , notNullable "Width" intTy , notNullable "Height" intTy , nullable "Attributes" longTy , nullable "Text" maxStringTy ] newBBControl :: [Value] -> Row newBBControl = mkRow bbControlName {- Purpose: The Billboard table lists the billboards displayed in the full user interface. A billboard is a part of a dialog that dynamically changes on progress or through action data messages. -} billboardName :: TableName billboardName = "Billboard" billboardTable :: Table billboardTable = defineTable billboardName [ key "Billboard" stdStringTy , notNullable "Feature_" stdStringTy , nullable "Action" stdStringTy , nullable "Ordering" intTy ] newBillboard :: [Value] -> Row newBillboard = mkRow billboardName {- Purpose: The Binary table holds the binary data for items such as bitmaps, animations, and icons. The binary table is also used to store data for custom actions. -} binaryTableName :: TableName binaryTableName = "Binary" binaryTable :: Table binaryTable = defineTable binaryTableName [ key "Name" stdStringTy , notNullable "Data" fileTy ] newBinary :: [Value] -> Row newBinary vals = mkRow binaryTableName vals {- Purpose: The BindImage table contains information about each executable or DLL that needs to be bound to the DLLs imported by it. -} bindImageName :: TableName bindImageName = "BindImage" bindImageTable :: Table bindImageTable = defineTable bindImageName [ key "File_" stdStringTy , nullable "Path" maxStringTy ] newBindImage :: [Value] -> Row newBindImage = mkRow bindImageName {- Purpose: The CCPSearch table contains the list of file signatures used for the Compliance Checking Program (CCP). At least one of these files needs to be present on a user's computer for the user to be in compliance with the program. -} ccpSearchName :: TableName ccpSearchName = "CCPSearch" ccpSearchTable :: Table ccpSearchTable = defineTable ccpSearchName [ key "Signature_" stdStringTy ] newCCPSearch :: [Value] -> Row newCCPSearch = mkRow ccpSearchName {- Purpose: The CheckBox table lists the values for the check boxes. -} checkBoxName :: TableName checkBoxName = "CheckBox" checkBoxTable :: Table checkBoxTable = defineTable checkBoxName [ key "Property" stdStringTy , nullable "Value" maxStringTy ] newCheckBox :: [Value] -> Row newCheckBox = mkRow checkBoxName {- Purpose: The Class table contains COM server-related information that must be generated as a part of the product advertisement. Each row may generate a set of registry keys and values. The associated ProgId information is included in this table. -} className :: TableName className = "ClassName" classTable :: Table classTable = defineTable className [ key "CLSID" guidTy , key "Context" stdStringTy , key "Component_" stdStringTy , nullable "ProgId_Default" maxStringTy , nullable "Description" maxStringTy , nullable "AppId_" guidTy , nullable "FileTypeMask" maxStringTy , nullable "Icon_" stdStringTy , nullable "IconIndex" intTy , nullable "DefInProcHandler" maxStringTy , nullable "Argument" maxStringTy , notNullable "Feature_" stdStringTy , nullable "Attributes" intTy ] newClass :: [Value] -> Row newClass = mkRow className {- Purpose: The lines of a combo box are not treated as individual controls; they are part of a single combo box that functions as a control. This table lists the values for each combo box. -} comboBoxName :: TableName comboBoxName = "ComboBox" comboBoxTable :: Table comboBoxTable = defineTable comboBoxName [ key "Property" stdStringTy , key "Order" intTy , notNullable "Value" maxStringTy , nullable "Text" maxStringTy ] newComboBox :: [Value] -> Row newComboBox = mkRow comboBoxName {- Purpose: The CompLocator table holds the information needed to find a file or a directory using the installer configuration data. -} compLocatorName :: TableName compLocatorName = "CompLocator" compLocatorTable :: Table compLocatorTable = defineTable compLocatorName [ key "Signature_" stdStringTy , notNullable "ComponentId" guidTy , nullable "Type" intTy ] newCompLocator :: [Value] -> Row newCompLocator = mkRow compLocatorName {- Purpose: The Complus table contains information needed to install COM+ applications. -} complusName :: TableName complusName = "Complus" complusTable :: Table complusTable = defineTable complusName [ key "Component_" stdStringTy , nullable "ExpType" intTy ] newComplus :: [Value] -> Row newComplus = mkRow complusName {- Purpose: The Component table lists components. -} componentName :: TableName componentName = "Component" componentTable :: Table componentTable = defineTable componentName [ key "Component" stdStringTy , nullable "ComponentId" (charTy (Just 38)) , notNullable "Directory_" stdStringTy , notNullable "Attributes" intTy , nullable "Condition" maxStringTy , nullable "KeyPath" stdStringTy ] newComponent :: [Value] -> Row newComponent vals = mkRow componentName vals -- -- Table: Control -- -- Purpose: The Control table defines the controls that appear -- on each dialog box. -- controlName :: TableName controlName = "Control" controlTable :: Table controlTable = defineTable controlName [ key "Dialog_" stdStringTy , key "Control" (charTy (Just 50)) , notNullable "Type" (charTy (Just 50)) , notNullable "X" intTy , notNullable "Y" intTy , notNullable "Width" intTy , notNullable "Height" intTy , nullable "Attributes" longTy , nullable "Property" (charTy (Just 50)) , nullable "Text" stdStringTy , nullable "Control_Next" (charTy (Just 50)) , nullable "Help" (charTy (Just 50)) ] newControl :: [Value] -> Row newControl vals = mkRow controlName vals -- -- Table: ControlCondition -- -- Purpose: The ControlCondition table enables an author to specify -- special actions to be applied to controls based on the -- result of a conditional statement. For example, using -- this table the author could choose to hide a control -- based on the VersionNT property. -- controlConditionName :: TableName controlConditionName = "ControlCondition" controlConditionTable :: Table controlConditionTable = defineTable controlConditionName [ key "Dialog_" stdStringTy , key "Control_" (charTy (Just 50)) , key "Action" (charTy (Just 50)) , key "Condition" maxStringTy ] newControlCondition :: [Value] -> Row newControlCondition vals = mkRow controlConditionName vals {- Purpose: The ControlEvent table allows the author to specify what happens when the user interacts with any control within a dialog box. For example, a click of a push button can be defined to trigger a transition to another dialog box, to exit a dialog box sequence, or to begin file installation. -} controlEventName :: TableName controlEventName = "ControlEvent" controlEventTable :: Table controlEventTable = defineTable controlEventName [ key "Dialog_" stdStringTy , key "Control_" (charTy (Just 50)) , key "Event" (charTy (Just 50)) , key "Argument" maxStringTy , notNullable "Condition" maxStringTy , nullable "Ordering" intTy ] newControlEvent :: [Value] -> Row newControlEvent vals = mkRow controlEventName vals {- Purpose: The CreateFolder table contains references to folders that need to be created explicitly for a particular component. -} createFolderName :: TableName createFolderName = "CreateFolder" createFolderTable :: Table createFolderTable = defineTable createFolderName [ key "Directory_" stdStringTy , key "Component_" stdStringTy ] newCreateFolder :: [Value] -> Row newCreateFolder vals = mkRow createFolderName vals {- Purpose: The CustomAction table provides the means of integrating custom code and data into the installation. -} customActionName :: TableName customActionName = "CustomAction" customActionTable :: Table customActionTable = defineTable customActionName [ key "Action" stdStringTy , notNullable "Type" intTy , nullable "Source" (charTy (Just 64)) , nullable "Target" maxStringTy ] newCustomAction :: [Value] -> Row newCustomAction = mkRow customActionName -- -- Table: Dialog -- -- Purpose: The Dialog table contains all the dialogs that appear -- in the user interface in both the full and reduced modes. -- dialogName :: TableName dialogName = "Dialog" dialogTable :: Table dialogTable = defineTable dialogName [ key "Dialog" stdStringTy , notNullable "HCentering" intTy , notNullable "VCentering" intTy , notNullable "Width" intTy , notNullable "Height" intTy , nullable "Attributes" longTy , nullable "Title" (charTy (Just 128)) , notNullable "Control_First" (charTy (Just 50)) , nullable "Control_Default" (charTy (Just 50)) , nullable "Control_Cancel" (charTy (Just 50)) ] newDialog :: [Value] -> Row newDialog vals = mkRow dialogName vals {- Purpose: The Directory table specifies the directory layout for the product. Each row of the table indicates a directory both at the source and the target. -} directoryName :: TableName directoryName = "Directory" directoryTable :: Table directoryTable = defineTable directoryName [ key "Directory" stdStringTy , nullable "Directory_Parent" stdStringTy , notNullable "DefaultDir" (localisable stdStringTy) ] newDirectory :: [Value] -> Row newDirectory vals = mkRow directoryName vals {- Purpose: The DrLocator table holds the information needed to find a file or directory by searching the directory tree. -} drLocatorName :: TableName drLocatorName = "DrLocator" drLocatorTable :: Table drLocatorTable = defineTable drLocatorName [ key "Signature_" stdStringTy , keyNullable "Parent" stdStringTy , key "Path" maxStringTy , nullable "Depth" intTy ] newDrLocator :: [Value] -> Row newDrLocator = mkRow drLocatorName {- Purpose: The DuplicateFile table contains a list of files that are to be duplicated, either to a different directory than the original file or to the same directory but with a different name. The original file must be a file installed by the InstallFiles action. -} duplicateFileName :: TableName duplicateFileName = "DuplicateFile" duplicateFileTable :: Table duplicateFileTable = defineTable duplicateFileName [ key "FileKey" stdStringTy , notNullable "Component_" stdStringTy , notNullable "File_" stdStringTy , nullable "DestName" maxStringTy , nullable "DestFolder" stdStringTy ] newDuplicateFile :: [Value] -> Row newDuplicateFile = mkRow duplicateFileName {- Purpose: The Environment table is used to set the value of environment variables. -} environmentName :: TableName environmentName = "Environment" environmentTable :: Table environmentTable = defineTable environmentName [ key "Environment" stdStringTy , notNullable "Name" (localisable stdStringTy) , nullable "Value" (localisable maxStringTy) , notNullable "Component_" stdStringTy ] newEnvironment :: [Value] -> Row newEnvironment vals = mkRow environmentName vals {- Purpose: The Error table is used to look up error message formatting templates when processing errors with an error code set but without a formatting template set (this is the normal situation). -} errorName :: TableName errorName = "Error" errorTable :: Table errorTable = defineTable errorName [ key "Error" intTy , nullable "Message" maxStringTy ] newError :: [Value] -> Row newError = mkRow errorName {- Purpose: The EventMapping table lists the controls that subscribe to some control event and lists the attribute to be changed when the event is published by another control or the installer. -} eventMappingName :: TableName eventMappingName = "EventMapping" eventMappingTable :: Table eventMappingTable = defineTable eventMappingName [ key "Dialog_" stdStringTy , key "Control_" stdStringTy , key "Event" stdStringTy , nullable "Attribute" stdStringTy ] newEventMapping :: [Value] -> Row newEventMapping = mkRow eventMappingName {- Purpose: The Extension table contains information about file name extension servers that must be generated as part of product advertisement. Each row generates a set of registry keys and values. -} extensionName :: TableName extensionName = "Extension" extensionTable :: Table extensionTable = defineTable extensionName [ notNullable "Extension" maxStringTy , notNullable "Component_" stdStringTy , nullable "ProgId_" maxStringTy , nullable "MIME_" (charTy (Just 64)) , notNullable "Feature_" (charTy (Just 38)) ] newExtension :: [Value] -> Row newExtension = mkRow extensionName {- Purpose: The Feature table defines the logical tree structure of features. -} featureName :: TableName featureName = "Feature" featureTable :: Table featureTable = defineTable featureName [ key "Feature" (charTy (Just 38)) , nullable "Feature_Parent" (charTy (Just 38)) , nullable "Title" (localisable (charTy (Just 64))) , nullable "Description" (localisable maxStringTy) , nullable "Display" intTy , notNullable "Level" intTy , nullable "Directory_" stdStringTy , notNullable "Attributes" intTy ] newFeature :: [Value] -> Row newFeature = mkRow featureName {- Purpose: The FeatureComponents table defines the relationship between features and components. For each feature, this table lists all the components that make up that feature. -} featureComponentsName :: TableName featureComponentsName = "FeatureComponents" featureComponentsTable :: Table featureComponentsTable = defineTable featureComponentsName [ notNullable "Feature_" (charTy (Just 38)) , notNullable "Component_" stdStringTy ] newFeatureComponents :: [Value] -> Row newFeatureComponents = mkRow featureComponentsName {- Purpose: The File table contains a complete list of source files with their various attributes, ordered by a unique, non-localized, identifier. -} fileName :: TableName fileName = "File" fileTable :: Table fileTable = defineTable fileName [ key "File" stdStringTy , notNullable "Component_" stdStringTy , notNullable "FileName" (localisable maxStringTy) , notNullable "FileSize" longTy , nullable "Version" stdStringTy , nullable "Language" (charTy (Just 20)) , nullable "Attributes" intTy , notNullable "Sequence" intTy ] newFile :: [Value] -> Row newFile = mkRow fileName {- Purpose: The FileSFPCatalog table associates specified files with the catalog files used by Windows Millennium Edition for Windows File Protection. -} fileSFPCatalogName :: TableName fileSFPCatalogName = "FileSFPCatalog" fileSFPCatalogTable :: Table fileSFPCatalogTable = defineTable fileSFPCatalogName [ key "File_" stdStringTy , key "SFPCatalog_" stdStringTy ] newFileSFPCatalog :: [Value] -> Row newFileSFPCatalog = mkRow fileSFPCatalogName {- Purpose: The Font table contains the information for registering font files with the system -} fontName :: TableName fontName = "Font" fontTable :: Table fontTable = defineTable fontName [ key "File_" stdStringTy , nullable "FontTitle" maxStringTy ] newFont :: [Value] -> Row newFont = mkRow fontName {- Purpose: The Icon table contains the icon files. Each icon from the table is copied to a file as a part of product advertisement to be used for advertised shortcuts and OLE servers. -} iconName :: TableName iconName = "Icon" iconTable :: Table iconTable = defineTable iconName [ key "Name" stdStringTy , notNullable "Data" fileTy ] newIcon :: [Value] -> Row newIcon = mkRow iconName {- Purpose: The IniFile table contains the .ini information that the application needs to set in an .ini file. -} iniFileName :: TableName iniFileName = "IniFile" iniFileTable :: Table iniFileTable = defineTable iniFileName [ key "IniFile" stdStringTy , notNullable "FileName" maxStringTy , nullable "DirProperty" stdStringTy , notNullable "Section" maxStringTy , notNullable "Key" maxStringTy , notNullable "Value" maxStringTy , notNullable "Action" intTy , nullable "Component_" stdStringTy ] newIniFile :: [Value] -> Row newIniFile = mkRow iniFileName {- Purpose: The IniLocator table holds the information needed to search for a file or directory using an .ini file or to search for a particular .ini entry itself. The .ini file must be present in the default Microsoft Windows directory. -} iniLocatorName :: TableName iniLocatorName = "IniLocator" iniLocatorTable :: Table iniLocatorTable = defineTable iniLocatorName [ key "Signature_" stdStringTy , notNullable "FileName" maxStringTy , notNullable "Section" maxStringTy , notNullable "Key" maxStringTy , nullable "Field" intTy , nullable "Type" intTy ] newIniLocator :: [Value] -> Row newIniLocator = mkRow iniLocatorName {- Purpose: The InstallExecuteSequence table lists actions that are executed when the top-level INSTALL action is executed. -} installExecuteSequenceName :: TableName installExecuteSequenceName = "InstallExecuteSequence" installExecuteSequenceTable :: Table installExecuteSequenceTable = defineTable installExecuteSequenceName [ key "Action" stdStringTy , nullable "Condition" maxStringTy , notNullable "Sequence" intTy ] newInstallExecuteSequence :: [Value] -> Row newInstallExecuteSequence vals = mkRow installExecuteSequenceName vals {- Purpose: The InstallUISequence table lists actions that are executed when the top-level INSTALL action is executed and the internal user interface level is set to full UI or reduced UI. -} installUISequenceName :: TableName installUISequenceName = "InstallUISequence" installUISequenceTable :: Table installUISequenceTable = defineTable installUISequenceName [ key "Action" stdStringTy , nullable "Condition" maxStringTy , notNullable "Sequence" intTy ] newInstallUISequence :: [Value] -> Row newInstallUISequence vals = mkRow installUISequenceName vals {- Purpose: Each record of the IsolatedComponent table associates the component specified in the Component_Application column (commonly an .exe) with the component specified in the Component_Shared column (commonly a shared DLL). The IsolateComponents action installs a copy of Component_Shared into a private location for use by Component_Application. This isolates the Component_Application from other copies of Component_Shared that may be installed to a shared location on the computer. See Isolated Components. To link one Component_Shared to multiple Component_Application, include a separate record for each pair in the IsolatedComponents table. The installer copies the files of Component_Shared into the directory of each Component_Application that is installed. -} isolatedComponentName :: TableName isolatedComponentName = "IsolatedComponent" isolatedComponentTable :: Table isolatedComponentTable = defineTable isolatedComponentName [ key "Component_Shared" stdStringTy , key "Component_Application" stdStringTy ] newIsolatedComponent :: [Value] -> Row newIsolatedComponent = mkRow isolatedComponentName {- Purpose: The LaunchCondition table is used by the LaunchConditions action. It contains a list of conditions that all must be satisfied for the installation to begin. -} launchConditionName :: TableName launchConditionName = "LaunchCondition" launchConditionTable :: Table launchConditionTable = defineTable launchConditionName [ key "Condition" maxStringTy , notNullable "Description" (localisable maxStringTy) ] newLaunchCondition :: [Value] -> Row newLaunchCondition = mkRow launchConditionName {- Purpose: The lines of a list box are not treated as individual controls, but they are part of a list box that functions as a control. The ListBox table defines the values for all list boxes. -} listBoxName :: TableName listBoxName = "ListBox" listBoxTable :: Table listBoxTable = defineTable listBoxName [ key "Property" stdStringTy , key "Order" intTy , notNullable "Value" maxStringTy , nullable "Text" maxStringTy ] newListBox :: [Value] -> Row newListBox = mkRow listBoxName {- Purpose: The lines of a ListView are not treated as individual controls, but they are part of a listview that functions as a control. The ListView table defines the values for all listviews. -} listViewName :: TableName listViewName = "ListView" listViewTable :: Table listViewTable = defineTable listViewName [ key "Property" stdStringTy , key "Order" intTy , notNullable "Value" maxStringTy , nullable "Text" maxStringTy , nullable "Binary_" stdStringTy ] newListView :: [Value] -> Row newListView = mkRow listViewName {- Purpose: The LockPermissions table is used to secure individual portions of your application in a locked-down environment. It can be used with the installation of files, registry keys, and created folders. -} lockPermissionsName :: TableName lockPermissionsName = "LockPermissions" lockPermissionsTable :: Table lockPermissionsTable = defineTable lockPermissionsName [ key "LockObject" stdStringTy , key "Table" maxStringTy , keyNullable "Domain" maxStringTy , key "User" maxStringTy , nullable "Permission" longTy ] newLockPermissions :: [Value] -> Row newLockPermissions = mkRow lockPermissionsName {- Purpose: The Media table describes the set of disks that make up the source media for the installation. -} mediaName :: TableName mediaName = "Media" mediaTable :: Table mediaTable = defineTable mediaName [ notNullable "DiskId" intTy , notNullable "LastSequence" intTy , nullable "DiskPrompt" (localisable (charTy (Just 64))) , nullable "Cabinet" (charTy (Just 32)) , nullable "VolumeLabel" (charTy (Just 32)) , nullable "Source" (charTy (Just 32)) ] newMedia :: [Value] -> Row newMedia = mkRow mediaName {- Purpose: The MIME table associates a MIME content type with a file extension or a CLSID to generate the extension or COM server information required for advertisement of the MIME (Multipurpose Internet Mail Extensions) content. -} mimeName :: TableName mimeName = "MIME" mimeTable :: Table mimeTable = defineTable mimeName [ key "ContentType" maxStringTy , notNullable "Extension_" maxStringTy , nullable "CLSID" guidTy ] newMIME :: [Value] -> Row newMIME = mkRow mimeName {- Purpose: This table contains a list of files to be moved or copied from a specified source directory to a specified destination directory. -} moveFileName :: TableName moveFileName = "MoveFile" moveFileTable :: Table moveFileTable = defineTable moveFileName [ key "FileKey" stdStringTy , notNullable "Component_" stdStringTy , nullable "SourceName" (localisable maxStringTy) , nullable "DestName" (localisable maxStringTy) , nullable "SourceFolder" maxStringTy , notNullable "DestFolder" stdStringTy , nullable "Options" intTy ] newMoveFile :: [Value] -> Row newMoveFile = mkRow moveFileName {- Purpose: The MsiAssembly table specifies Windows Installer settings for Microsoft® .NET Framework assemblies and Win32® assemblies. -} msiAssemblyName :: TableName msiAssemblyName = "MsiAssembly" msiAssemblyTable :: Table msiAssemblyTable = defineTable msiAssemblyName [ key "Component_" stdStringTy , notNullable "Feature_" stdStringTy , nullable "File_Manifest" stdStringTy , nullable "File_Application" stdStringTy , notNullable "Attributes" intTy ] newMsiAssembly :: [Value] -> Row newMsiAssembly = mkRow msiAssemblyName {- Purpose: The MsiAssembly table and MsiAssemblyName table specify Windows Installer settings for common language runtime assemblies and Win32® assemblies. -} msiAssemblyNameName :: TableName msiAssemblyNameName = "MsiAssemblyName" msiAssemblyNameTable :: Table msiAssemblyNameTable = defineTable msiAssemblyNameName [ key "Component_" stdStringTy , key "Name" maxStringTy , nullable "Value" maxStringTy ] newMsiAssemblyName :: [Value] -> Row newMsiAssemblyName = mkRow msiAssemblyNameName {- Purpose: The MsiDigitalCertificate table stores certificates in binary stream format and associates each certificate with a primary key. The primary key is used to share certificates among multiple digitally signed objects. A digital certificate is a credential that provides a means to verify identity. -} msiDigitalCertificateName :: TableName msiDigitalCertificateName = "MsiDigitalCertificate" msiDigitalCertificateTable :: Table msiDigitalCertificateTable = defineTable msiDigitalCertificateName [ key "DigitalCertificate" stdStringTy , notNullable "CertData" fileTy ] newMsiDigitalCertificate :: [Value] -> Row newMsiDigitalCertificate = mkRow msiDigitalCertificateName {- Purpose: The MsiDigitalSignature table contains the signature information for every digitally signed object in the installation database. -} msiDigitalSignatureName :: TableName msiDigitalSignatureName = "MsiDigitalSignature" msiDigitalSignatureTable :: Table msiDigitalSignatureTable = defineTable msiDigitalSignatureName [ key "Table" stdStringTy , key "SignObject" maxStringTy , notNullable "DigitalCertificate_" stdStringTy , nullable "Hash" fileTy ] newMsiDigitalSignature :: [Value] -> Row newMsiDigitalSignature = mkRow msiDigitalSignatureName {- Purpose: The MsiFileHash table is used to store a 128-bit hash of a source file provided by the Windows Installer package. The hash is split into four 32-bit values and stored in separate columns of the table. -} msiFileHashName :: TableName msiFileHashName = "MsiFileHash" msiFileHashTable :: Table msiFileHashTable = defineTable msiFileHashName [ key "File_" stdStringTy , notNullable "Options" intTy , notNullable "HashPart1" longTy , notNullable "HashPart2" longTy , notNullable "HashPart3" longTy , notNullable "HashPart4" longTy ] newMsiFileHash :: [Value] -> Row newMsiFileHash = mkRow msiFileHashName {- Purpose: The MsiPatchHeaders table holds the binary patch header streams used for patch validation. A patch containing a populated MsiPatchHeaders table can only be applied using Windows Installer version 2.0 or later. -} msiPatchHeadersName :: TableName msiPatchHeadersName = "MsiPatchHeaders" msiPatchHeadersTable :: Table msiPatchHeadersTable = defineTable msiPatchHeadersName [ key "StreamRef" stdStringTy , notNullable "Header" fileTy ] newMsiPatchHeaders :: [Value] -> Row newMsiPatchHeaders = mkRow msiPatchHeadersName {- Purpose: The Patch table specifies the file that is to receive a particular patch and the physical location of the patch files on the media images. -} patchName :: TableName patchName = "Patch" patchTable :: Table patchTable = defineTable patchName [ key "File_" stdStringTy , key "Sequence" intTy , notNullable "PatchSize" longTy , notNullable "Attributes" intTy , nullable "Header" fileTy , nullable "StreamRef_" stdStringTy ] newPatch :: [Value] -> Row newPatch = mkRow patchName {- Purpose: The PatchPackage table describes all patch packages that have been applied to this product. For each patch package, the unique identifier for the patch is provided along with information about the media image the on which the patch is located. -} patchPackageName :: TableName patchPackageName = "PatchPackage" patchPackageTable :: Table patchPackageTable = defineTable patchPackageName [ key "PatchId" guidTy , notNullable "Media_" intTy ] newPatchPackage :: [Value] -> Row newPatchPackage = mkRow patchPackageName {- Purpose: The ProgId table contains information for program IDs and version independent program IDs that must be generated as a part of the product advertisement. -} progIdName :: TableName progIdName = "ProgId" progIdTable :: Table progIdTable = defineTable progIdName [ key "ProgId" maxStringTy , nullable "ProgId_Parent" maxStringTy , nullable "Class_" (charTy (Just 38)) , nullable "Description" (localisable $ charTy (Just 38)) , nullable "Icon_" stdStringTy , nullable "IconIndex" intTy ] newProgId :: [Value] -> Row newProgId = mkRow progIdName {- Purpose: The Property table contains the property names and values for all defined properties in the installation. Properties with Null values are not present in the table. -} propertyName :: TableName propertyName = "Property" propertyTable :: Table propertyTable = defineTable propertyName [ notNullable "Property" stdStringTy , notNullable "Value" (localisable (charTy Nothing)) ] newProperty :: [Value] -> Row newProperty = mkRow propertyName {- Purpose: The PublishComponent table associates components listed in the Component table with a qualifier text-string and a category ID GUID. Components with parallel functionality that have been grouped together in this way are referred to as qualified components. -} publishComponentName :: TableName publishComponentName = "PublishComponent" publishComponentTable :: Table publishComponentTable = defineTable publishComponentName [ key "ComponentId" guidTy , key "Qualifier" maxStringTy , key "Component_" stdStringTy , nullable "AppData" maxStringTy , notNullable "Feature_" stdStringTy ] newPublishComponent :: [Value] -> Row newPublishComponent = mkRow publishComponentName {- Purpose: Radio buttons are not treated as individual controls, but they are part of a radio button group that functions as a RadioButtonGroup control. The RadioButton table lists the buttons for all the groups. -} radioButtonName :: TableName radioButtonName = "RadioButton" radioButtonTable :: Table radioButtonTable = defineTable radioButtonName [ key "Property" stdStringTy , key "Order" intTy , notNullable "Value" maxStringTy , notNullable "X" intTy , notNullable "Y" intTy , notNullable "Width" intTy , notNullable "Height" intTy , nullable "Text" maxStringTy , nullable "Help" maxStringTy ] newRadioButton :: [Value] -> Row newRadioButton = mkRow radioButtonName {- Purpose: The Registry table holds the registry information that the application needs to set in the system registry. -} registryName :: TableName registryName = "Registry" registryTable :: Table registryTable = defineTable registryName [ key "Registry" stdStringTy , notNullable "Root" intTy , notNullable "Key" (localisable $ maxStringTy) , nullable "Name" (localisable $ maxStringTy) , nullable "Value" (localisable $ charTy Nothing) , notNullable "Component_" stdStringTy ] newRegistry :: [Value] -> Row newRegistry = mkRow registryName {- Purpose: The RegLocator table holds the information needed to search for a file or directory using the registry, or to search for a particular registry entry itself. -} regLocatorName :: TableName regLocatorName = "RegLocator" regLocatorTable :: Table regLocatorTable = defineTable regLocatorName [ key "Signature_" stdStringTy , notNullable "Root" intTy , notNullable "Key" (maxStringTy) , nullable "Name" (maxStringTy) , nullable "Type" intTy ] newRegLocator :: [Value] -> Row newRegLocator = mkRow regLocatorName {- Purpose: The RemoveFile table contains a list of files to be removed by the RemoveFiles action. Setting the FileName column of this table to Null supports the removal of empty folders. -} removeFileName :: TableName removeFileName = "RemoveFile" removeFileTable :: Table removeFileTable = defineTable removeFileName [ key "FileKey" stdStringTy , notNullable "Component_" stdStringTy , nullable "FileName" (localisable maxStringTy) , notNullable "DirProperty" stdStringTy , notNullable "InstallMode" intTy ] newRemoveFile :: [Value] -> Row newRemoveFile = mkRow removeFileName {- Purpose: The RemoveIniFile table contains the information an application needs to delete from a .ini file. -} removeIniFileName :: TableName removeIniFileName = "RemoveIniFile" removeIniFileTable :: Table removeIniFileTable = defineTable removeIniFileName [ key "RemoveIniFile" stdStringTy , notNullable "FileName" maxStringTy , nullable "DirProperty" stdStringTy , notNullable "Section" maxStringTy , notNullable "Key" maxStringTy , nullable "Value" maxStringTy , notNullable "Action" intTy , notNullable "Component_" stdStringTy ] newRemoveIniFile :: [Value] -> Row newRemoveIniFile = mkRow removeIniFileName {- Purpose: The RemoveRegistry table contains the registry information the application needs to delete from the system registry. -} removeRegistryName :: TableName removeRegistryName = "RemoveRegistry" removeRegistryTable :: Table removeRegistryTable = defineTable removeRegistryName [ key "RemoveRegistry" stdStringTy , notNullable "Root" intTy , notNullable "Key" maxStringTy , nullable "Name" maxStringTy , notNullable "Component_" stdStringTy ] newRemoveRegistry :: [Value] -> Row newRemoveRegistry = mkRow removeRegistryName {- Purpose: The ReserveCost table is an optional table that allows the author to reserve an amount of disk space in any directory that depends on the installation state of a component. -} reserveCostName :: TableName reserveCostName = "ReserveCost" reserveCostTable :: Table reserveCostTable = defineTable reserveCostName [ key "ReserveKey" stdStringTy , notNullable "Component_" stdStringTy , nullable "ReserveFolder" stdStringTy , notNullable "ReserveLocal" longTy , notNullable "ReserveSource" longTy ] newReserveCost :: [Value] -> Row newReserveCost = mkRow reserveCostName {- Purpose: The SelfReg table contains information about modules that need to be self registered. The installer calls the DllRegisterServer function during installation of the module; it calls DllUnregisterServer during uninstallation of the module. The installer does not self register EXE files. -} selfRegName :: TableName selfRegName = "SelfReg" selfRegTable :: Table selfRegTable = defineTable selfRegName [ key "File_" stdStringTy , nullable "Cost" intTy ] newSelfReg :: [Value] -> Row newSelfReg = mkRow selfRegName {- Purpose: The ServiceControl table is used to control installed or uninstalled services. -} serviceControlName :: TableName serviceControlName = "ServiceControl" serviceControlTable :: Table serviceControlTable = defineTable serviceControlName [ key "ServiceControl" stdStringTy , notNullable "Name" maxStringTy , notNullable "Event" intTy , nullable "Arguments" maxStringTy , nullable "Wait" intTy , notNullable "Component_" stdStringTy ] newServiceControl :: [Value] -> Row newServiceControl = mkRow serviceControlName {- Purpose: The ServiceInstall table is used to install a service and has the following columns. -} serviceInstallName :: TableName serviceInstallName = "ServiceInstall" serviceInstallTable :: Table serviceInstallTable = defineTable serviceInstallName [ key "ServiceInstall" stdStringTy , notNullable "Name" (localisable maxStringTy) , nullable "DisplayName" (localisable maxStringTy) , notNullable "ServiceType" intTy , notNullable "StartType" intTy , notNullable "ErrorControl" intTy , nullable "LoadOrderGroup" (localisable maxStringTy) , nullable "Dependencies" (localisable maxStringTy) , nullable "StartName" (localisable maxStringTy) , nullable "Password" (localisable maxStringTy) , nullable "Arguments" (localisable maxStringTy) , notNullable "Component_" stdStringTy , nullable "Description" (localisable maxStringTy) ] newServiceInstall :: [Value] -> Row newServiceInstall = mkRow serviceInstallName {- Purpose: The SFPCatalog table contains the catalogs used by Windows Millennium Edition for Windows File Protection. -} sfpCatalogName :: TableName sfpCatalogName = "SFPCatalog" sfpCatalogTable :: Table sfpCatalogTable = defineTable sfpCatalogName [ key "SFPCatalog" (localisable maxStringTy) , notNullable "Catalog" fileTy , nullable "Dependency" maxStringTy ] newSFPCatalog :: [Value] -> Row newSFPCatalog = mkRow sfpCatalogName {- Purpose: The Shortcut table holds the information the application needs to create shortcuts on the user's computer. -} shortcutName :: TableName shortcutName = "Shortcut" shortcutTable :: Table shortcutTable = defineTable shortcutName [ key "Shortcut" stdStringTy , notNullable "Directory_" stdStringTy , notNullable "Name" (localisable $ charTy (Just 128)) , notNullable "Component_" stdStringTy , notNullable "Target" stdStringTy , nullable "Arguments" maxStringTy , nullable "Description" (localisable maxStringTy) , nullable "Hotkey" intTy , nullable "Icon_" stdStringTy , nullable "IconIndex" intTy , nullable "ShowCmd" intTy , nullable "WkDir" stdStringTy ] newShortcut :: [Value] -> Row newShortcut = mkRow shortcutName {- Purpose: The Signature table holds the information that uniquely identifies a file signature -} signatureName :: TableName signatureName = "Signature" signatureTable :: Table signatureTable = defineTable signatureName [ key "Signature" stdStringTy , notNullable "FileName" (localisable maxStringTy) , nullable "MinVersion" (charTy (Just 20)) , nullable "MaxVersion" (charTy (Just 20)) , nullable "MinSize" longTy , nullable "MaxSize" longTy , nullable "MinDate" longTy , nullable "MaxDate" longTy , nullable "Languages" (localisable maxStringTy) ] newSignature :: [Value] -> Row newSignature = mkRow signatureName {- Purpose: The TextStyle table lists different font styles used in controls having text. -} textStyleName :: TableName textStyleName = "TextStyle" textStyleTable :: Table textStyleTable = defineTable textStyleName [ key "TextStyle" stdStringTy , notNullable "FaceName" maxStringTy , notNullable "Size" intTy , nullable "Color" longTy , nullable "StyleBits" intTy ] newTextStyle :: [Value] -> Row newTextStyle = mkRow textStyleName {- Purpose: The TypeLib table contains the information that needs to be placed in the registry registration of type libraries. -} typeLibName :: TableName typeLibName = "TypeLib" typeLibTable :: Table typeLibTable = defineTable typeLibName [ key "LibID" guidTy , key "Language" intTy , key "Component_" stdStringTy , nullable "Version" intTy , nullable "Description" (localisable maxStringTy) , nullable "Directory_" stdStringTy , notNullable "Feature_" stdStringTy , nullable "Cost" longTy ] newTypeLib :: [Value] -> Row newTypeLib = mkRow typeLibName {- Purpose: The UIText table contains the localized versions of some of the strings used in the user interface. These strings are not part of any other table. The UIText table is for strings that have no logical place in any other table. -} uiTextName :: TableName uiTextName = "UIText" uiTextTable :: Table uiTextTable = defineTable uiTextName [ key "Key" stdStringTy , nullable "Text" (localisable maxStringTy) ] newUIText :: [Value] -> Row newUIText = mkRow uiTextName {- Purpose: The Upgrade table contains information required during major upgrades. To fully enable the installer's upgrade capabilities, every package should have an UpgradeCode property and an Upgrade table. -} upgradeName :: TableName upgradeName = "Upgrade" upgradeTable :: Table upgradeTable = defineTable upgradeName [ key "UpgradeCode" guidTy , key "VersionMin" versionTy , key "VersionMax" versionTy , key "Language" (localisable maxStringTy) , key "Attributes" intTy , nullable "Remove" maxStringTy , notNullable "ActionProperty" stdStringTy ] newUpgrade :: [Value] -> Row newUpgrade = mkRow upgradeName {- Purpose: The Verb table contains command-verb information associated with file extensions that must be generated as a part of product advertisement. Each row generates a set of registry keys and values. -} verbName :: TableName verbName = "Verb" verbTable :: Table verbTable = defineTable verbName [ notNullable "Extension_" maxStringTy , key "Verb" (charTy (Just 32)) , nullable "Sequence" intTy , nullable "Command" (localisable maxStringTy) , nullable "Argument" (localisable maxStringTy) ] newVerb :: [Value] -> Row newVerb = mkRow verbName