{-
  Command line options.
  Copyright (C) 2005, 2008 Luis Francisco Araujo
-}

module Options
    where

import Data.List
import System.Console.GetOpt
import System.Environment
import System.Exit

----------------------------------------------------------------------------------
-- | Options data type.
data Flag = Help
          | Version
          | ConfigFile String
            deriving (Show, Eq, Ord)

----------------------------------------------------------------------------------
-- | Describe available command line options.
options :: [OptDescr Flag]
options = [ Option ['v'] ["version"] (NoArg Version) "version information" ,
            Option ['h'] ["help"] (NoArg Help) "this help" ,
            Option ['c'] ["configfile"] (ReqArg ConfigFile "cfgpath") "absolute path for hashell configuration file" ]

-- | Get the options from command line.
cOpts :: [String] -> IO [Flag]
cOpts argv =
    case getOpt Permute options argv of
             (opts, _, []) -> return . sort $ opts
             (_, _, errs) -> do putStr (concat errs)
                                ioError $ userError "Incorrect options"

-- | Specify what to do with each option.
parseOpts :: [Flag] -> IO [String]
parseOpts [] = return []
parseOpts (Version:_) = do putStrLn version
                           exitWith ExitSuccess
parseOpts (Help:_) = do putStrLn help
                        exitWith ExitSuccess
parseOpts (ConfigFile cfg:_) = return [cfg]

-- | Represent the command line options passed to the shell
-- in such a way that can be used by other functions.
programOptions :: IO [String]
programOptions = getArgs >>= cOpts >>= parseOpts

----------------------------------------------------------------------------------
-- | Version information.
version :: String
version = "hashell 0.014a - haskell shell\n" ++
          "http://www.haskell.org/hashell\n" ++
          "Copyright (c) Luis Araujo , luis@arjox.org.\n" ++
          "This software is released under the GPL.\n"

-- | Help menu generation.
help :: String
help = version ++ "\n" ++
       (usageInfo "use: hashell [OPTIONS]" options)