--------------------------------------------------------------------
-- |
-- 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
		, srcBaseDir = 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)