bamse-0.9.4: 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.Environment
import System.Exit
import Bamse.Util.GetOpts
-- for validateOptions / getOptions:
import System.Win32.Com ( newGUID, guidToString )
import System.IO ( hPutStrLn, stderr, stdout )
import System.Directory ( getCurrentDirectory )
import Data.Maybe ( isNothing, fromJust, isJust )
import Control.Monad ( when, foldM )
import System.FilePath
--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 :: String
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 :: IO a
helpError = do
showHelp
exitWith (ExitFailure 1)
showHelp :: IO ()
showHelp = do
p <- getProgName
hPutStrLn stderr (help p)
validateOptions :: FilePath -> Options -> [FilePath] -> IO Options
validateOptions defOut opts0 inps = do
foldM (\ o f -> f o)
opts0
[ topInstallTree
, outputReqd
, productGUIDReqd
, revisionGUIDReqd
, dataDirReqd
]
where
-- the top of the install tree must be given.
topInstallTree opts
| not (opt_showInfo opts) && isNothing (opt_srcDir opts) && length inps /= 1 = helpError
| isNothing (opt_srcDir opts) = return opts{opt_srcDir=Just (head inps)}
| otherwise = return opts
-- if in update mode, an output file is reqd.
outputReqd opts
| not (opt_update opts) || isJust (opt_outFile opts) = return opts
| otherwise = do
let opts' = opts{opt_outFile=Just defOut}
hPutStrLn stderr ("WARNING: no output file given, using: " ++ fromJust (opt_outFile opts'))
return opts'
-- if not in update mode, better give the GUIDs
productGUIDReqd opts
| opt_update opts || opt_showInfo opts = return opts
| opt_genGUIDs opts = do
g <- newGUID
let n = guidToString g
n `seq` return opts{opt_productGUID=Just n}
| isNothing (opt_productGUID opts) = do
hPutStrLn stderr ("ERROR: missing product GUID option")
helpError
| otherwise = return opts
revisionGUIDReqd opts
| (opt_update opts) || (opt_showInfo opts) = return opts
| opt_genGUIDs opts = do
g <- newGUID
let n = guidToString g
n `seq` return opts{opt_revisionGUID=Just n}
| isNothing (opt_revisionGUID opts) = do
hPutStrLn stderr ("ERROR: missing revision GUID option")
helpError
| otherwise = return opts
dataDirReqd opts
| isJust (opt_dataDir opts) = return opts
| otherwise = do
let opts' = opts{opt_dataDir=opt_toolDir opts}
hPutStrLn stderr ("WARNING: no data-dir given, setting it equal to tool-dir")
return opts'
getOptions :: FilePath -> IO Options
getOptions defOut = do
ls <- getArgs
getOptionsFrom ls defOut
getOptionsFrom :: [String] -> FilePath -> IO Options
getOptionsFrom args defOut = do
(opts0, inps) <- parseArgs args
opts1 <- validateOptions defOut opts0 inps
opts2 <-
if not (opt_update opts1) && not (opt_showInfo opts1)
then return opts1
else do
(a,b) <- getProductCodes (fromJust (opt_outFile opts1)) ;
return opts1{ opt_productGUID = Just a
, opt_revisionGUID = Just b
}
when (opt_help opts2) (showHelp >> exitWith ExitSuccess)
when (opt_version opts2) (hPutStrLn stderr versionStr >> exitWith ExitSuccess)
when (opt_showInfo opts2) $ do
hPutStrLn stdout $ "Product code: " ++ fromJust (opt_productGUID opts2)
hPutStrLn stdout $ "Revision code: " ++ fromJust (opt_revisionGUID opts2)
exitWith ExitSuccess
os <- mapM processDefine (opt_defines opts2)
cwd <- getCurrentDirectory
let
sourceDir =
case opt_srcDir opts2 of
Nothing -> error "no srcDir"
Just x
| isAbsolute x -> normalise (dropTrailingPathSeparator x)
| otherwise -> normalise $
case normalise (dropTrailingPathSeparator x) of
"." -> cwd
"" -> cwd
y -> cwd </> y
oFile =
case opt_outFile opts2 of
Nothing -> normalise defOut
Just x -> normalise x
bfile <- getModuleFileName nullPtr
let bdir = normalise (addTrailingPathSeparator (takeDirectory bfile))
let ienv = InstallEnv
{ toolDir = maybe bdir id (opt_toolDir opts2)
, srcDir = sourceDir
, distDir = error "distDir not filled in yet"
, outFile = oFile
, userOpts = os
}
return opts2{opt_ienv=ienv}
processDefine :: String -> IO (String,String)
processDefine str =
case break (=='=') str of
(as,[]) -> addEnvVar as "" >> return (as,"")
(as,_:bs) -> addEnvVar as bs >> return (as,bs)