bamse-0.9.3: Bamse/Options.hs
--------------------------------------------------------------------
-- |
-- Module : Bamse.Options
-- Description : Option handling for generated Bamse installers.
-- Copyright : (c) Sigbjorn Finne, 2004-2009
-- License : BSD3
--
-- Maintainer : Sigbjorn Finne <sof@forkIO.com>
-- Stability : provisional
-- Portability : portable
--
-- Types and code for processing command-line arguments for an installer.
--
--------------------------------------------------------------------
module Bamse.Options where
import Bamse.Package
import Bamse.Writer ( getProductCodes )
import System
import Util.GetOpts
-- for validateOptions / getOptions:
import System.Win32.Com ( newGUID, guidToString )
import System.IO ( hPutStrLn, stderr, stdout )
import Data.Maybe ( isNothing, fromJust )
import Control.Monad ( when )
import Util.Path
import System.Win32.Com.Base ( getModuleFileName )
import Foreign.Ptr ( nullPtr )
import Bamse.PackageUtils ( addEnvVar )
parseArgs :: [String] -> IO (Options, [FilePath])
parseArgs argv =
case getOpt2 Permute options argv initOpts of
(o,n,[] ) -> return (o,n)
(_,_,errs) -> do
prog <- getProgName
fail $ concat errs ++ help prog
data Options
= Options { opt_verbose :: Bool
, opt_version :: Bool
, opt_help :: Bool
, opt_update :: Bool
, opt_showInfo :: Bool
, opt_genGUIDs :: Bool
, opt_outFile :: Maybe FilePath
, opt_productGUID :: Maybe String
, opt_revisionGUID :: Maybe String
, opt_srcDir :: Maybe FilePath
, opt_dataDir :: Maybe FilePath
, opt_toolDir :: Maybe FilePath
, opt_ienv :: InstallEnv
, opt_defines :: [String]
}
deriving Show
initOpts :: Options
initOpts
= Options { opt_verbose = False
, opt_version = False
, opt_update = False
, opt_help = False
, opt_showInfo= False
, opt_genGUIDs= False
, opt_outFile = Nothing
, opt_productGUID = Nothing
, opt_revisionGUID = Nothing
, opt_srcDir = Nothing
, opt_dataDir = Nothing
, opt_toolDir = Nothing
, opt_ienv = error "initOpts.opt_ienv: not filled in"
, opt_defines = []
}
versionStr = "<installer>"
help :: String -> String
help prog = usageInfo2 header options
where header = versionStr ++ "\nUsage: " ++ prog ++ " [OPTION...]"
options :: [OptDescr (Options -> Options)]
options =
[ Option ['v'] ["verbose"] (NoArg (\ op -> op{opt_verbose=True}))
"Display processing details"
, Option ['V'] ["version"] (NoArg (\ op -> op{opt_version=True}))
"Display version number"
, Option ['h','?'] ["help"] (NoArg (\ op -> op{opt_help=True}))
"Display this information"
, Option ['u'] ["update"] (NoArg (\ op -> op{opt_update=True}))
"Update existing installer (requires -o)"
, Option [] ["info"] (NoArg (\ op -> op{opt_showInfo=True}))
"Show info on installer (requires -o)"
, Option ['o'] ["output"]
(ReqArg (\ s op -> op{opt_outFile=Just s}) "<file>")
"Output installer to <file>"
, Option [] ["product-guid"]
(ReqArg (\ s op -> op{opt_productGUID=Just (toGUID s)}) "<guid>")
"Use <guid> as ProductCode. Required arg without -u"
, Option [] ["revision-guid"]
(ReqArg (\ s op -> op{opt_revisionGUID=Just (toGUID s)}) "<guid>")
"Use <guid> as RevisionCode. Required arg without -u"
, Option [] ["src-dir"]
(ReqArg (\ s op -> op{opt_srcDir=Just s}) "<dir>")
"Use <dir> as the path to the directory tree containing the files you want to build an installer for."
, Option [] ["tool-dir"]
(ReqArg (\ s op -> op{opt_toolDir=Just s}) "<dir>")
"Use <dir> as the top of the installer tool's own directory tree."
, Option [] ["data-dir"]
(ReqArg (\ s op -> op{opt_dataDir=Just s}) "<dir>")
"Use <dir> as your installer's data directory."
, Option [] ["generate-guids"]
(NoArg (\ op -> op{opt_genGUIDs=True}))
"Generate new GUIDs for ProductCode and RevisionCode"
, Option ['D'] []
(ReqArg (\ s op -> op{opt_defines=s:opt_defines op}) "VAR=VAL")
"Expand occurrences of $<VAR> in strings to VAL at MSI build-time"
]
where
toGUID xs@('{':_) = xs -- '}'
toGUID ls = '{':ls ++ "}"
helpError = do
showHelp
exitWith (ExitFailure 1)
showHelp = do
p <- getProgName
hPutStrLn stderr (help p)
validateOptions :: FilePath -> Options -> [FilePath] -> IO Options
validateOptions defOut opts inps = do
-- the top of the install tree must be given.
opts <-
if not (opt_showInfo opts) && isNothing (opt_srcDir opts) && length inps /= 1
then helpError
else if isNothing (opt_srcDir opts)
then return opts{opt_srcDir=Just (head inps)}
else return opts
-- if in update mode, an output file is reqd.
opts <-
if opt_update opts
then if isNothing (opt_outFile opts)
then do
let opts' = opts{opt_outFile=Just defOut}
hPutStrLn stderr ("WARNING: no output file given, using: " ++ fromJust (opt_outFile opts'))
return opts'
else
return opts
else return opts
-- if not in update mode, better give the GUIDs
opts <-
if not (opt_update opts) && not (opt_showInfo opts)
then if isNothing (opt_productGUID opts) && not (opt_genGUIDs opts)
then do
hPutStrLn stderr ("ERROR: missing product GUID option")
helpError
else if opt_genGUIDs opts
then do
g <- newGUID
let n = guidToString g
n `seq` return opts{opt_productGUID=Just n}
else
return opts
else return opts
opts <-
if not (opt_update opts) && not (opt_showInfo opts)
then if isNothing (opt_revisionGUID opts) && not (opt_genGUIDs opts)
then do
hPutStrLn stderr ("ERROR: missing revision GUID option")
helpError
else if opt_genGUIDs opts
then do
g <- newGUID
let n = guidToString g
n `seq` return opts{opt_revisionGUID=Just n}
else
return opts
else return opts
opts <-
if isNothing (opt_dataDir opts)
then do
let opts' = opts{opt_dataDir=opt_toolDir opts}
hPutStrLn stderr ("WARNING: no data-dir given, setting it equal to tool-dir")
return opts'
else return opts
return opts
getOptions :: FilePath -> IO Options
getOptions defOut = do
ls <- getArgs
(opts, inps) <- parseArgs ls
opts <- validateOptions defOut opts inps
opts <-
if opt_update opts || opt_showInfo opts
then do { (a,b) <- getProductCodes (fromJust (opt_outFile opts)) ;
return opts{ opt_productGUID = Just a
, opt_revisionGUID = Just b
} }
else return opts
when (opt_help opts) (showHelp >> exitWith ExitSuccess)
when (opt_version opts) (hPutStrLn stderr versionStr >> exitWith ExitSuccess)
when (opt_showInfo opts) $ do
hPutStrLn stdout $ "Product code: " ++ fromJust (opt_productGUID opts)
hPutStrLn stdout $ "Revision code: " ++ fromJust (opt_revisionGUID opts)
exitWith ExitSuccess
mapM_ processDefine (opt_defines opts)
let
srcDir =
case opt_srcDir opts of
Nothing -> error "no srcDir"
Just x -> toPlatformPath (joinPath $ splitPath x)
oFile =
case opt_outFile opts of
Nothing -> toPlatformPath defOut
Just x -> toPlatformPath x
bfile <- getModuleFileName nullPtr
let bdir = toPlatformPath $ appendSep (dirname bfile)
let ienv = InstallEnv
{ toolDir = bdir
, srcDir = srcDir
, distDir = error "distDir not filled in yet"
, outFile = oFile
}
return opts{opt_ienv=ienv}
processDefine :: String -> IO ()
processDefine str =
case break (=='=') str of
(as,[]) -> addEnvVar as ""
(as,_:bs) -> addEnvVar as bs