--
-- (c) 2007, Galois, Inc.
--
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