module GetOpt
    (OptionList,OptionSpecs,noArg,reqArg,optArg,makeOptions,parseOptions,
    isOption,getOption,getOptionOr)
where

import System.Console.GetOpt
    (getOpt,usageInfo,ArgOrder(Permute),OptDescr(..),ArgDescr(..))

import System.IO (stdout,stderr,hPutStr,hPutStrLn)

import System.Exit (ExitCode(..),exitWith)

type OptVal a = (a,String)
type ArgType a = a -> String -> ArgDescr (OptVal a)
type OptionList a = [OptVal a]
type OptionSpecs a = [OptDescr (OptVal a)]

noArg, reqArg, optArg :: ArgType a

noArg x _ = NoArg (x,"")

reqArg x s = ReqArg f s
    where f y = (x,y)

optArg x s = OptArg f s
    where f (Just y) = (x,y)
          f Nothing  = (x,"")

makeOptions :: [(a,Char,String,ArgType a,String,String)] -> OptionSpecs a
makeOptions xs = map f xs
    where f (g,c,s,h,t,m) = Option [c] [s] (h g t) m

parseOptions ::
    Eq a => [String] -> OptionList a -> String -> OptionSpecs a
    -> a -> String -> a
    -> IO (OptionList a,[String])
parseOptions argv defaults usage flags version versionStr help =
    case getOpt Permute flags argv of
        (args,files,[]) -> do
            if isOption version args
                then do hPutStr stdout versionStr
                 else return ()
            if isOption help args
                then do hPutStr stdout (usageInfo usage flags)
                else return ()
            return (args ++ defaults, files)
        (_,_,errs) -> do
            hPutStrLn stderr (concat errs ++ usageInfo usage flags)
            exitWith (ExitFailure 1)


isOption :: Eq a => a -> OptionList a -> Bool
isOption options assoc =  case lookup options assoc of
    Nothing -> False
    Just _  -> True

getOption :: Eq a => a -> OptionList a -> String
getOption options assoc = case lookup options assoc of
    Nothing -> ""
    Just s  -> s

getOptionOr :: Eq a => a -> OptionList a -> String -> String
getOptionOr options assoc def = case lookup options assoc of
    Nothing -> def
    Just "" -> def
    Just s  -> s