module Options where import qualified System.Environment as Env import System.Console.GetOpt (ArgOrder(RequireOrder), OptDescr(Option), ArgDescr(NoArg, ReqArg), getOpt, usageInfo, ) import System.Exit (exitSuccess, ) import qualified Control.Monad.Exception.Synchronous as Exc import qualified Control.Monad.Trans.Class as MT import Control.Monad (when, ) import Text.Printf (printf, ) data T = Cons { help :: Bool, llvmConfigPath :: FilePath, installPath :: FilePath, install :: Bool } deflt :: T deflt = Cons { help = False, llvmConfigPath = "llvm-config", installPath = "/usr/local/lib/pkgconfig/llvm.pc", install = False } options :: [OptDescr (T -> Exc.Exceptional String T)] options = Option ['h'] ["help"] (NoArg (\flags -> return $ flags{help = True})) "show options" : Option [] ["llvm-config"] (ReqArg (\str flags -> return $ flags{llvmConfigPath = str}) "PATH") (printf "path of llvm-config executable (default %s)" $ llvmConfigPath deflt) : Option [] ["install"] (NoArg (\flags -> return $ flags{install = True})) (printf "install config file at standard location (default %s)" $ installPath deflt) : [] get :: Exc.ExceptionalT String IO T get = do argv <- MT.lift Env.getArgs let (opts, args, errors) = getOpt RequireOrder options argv when (not (null errors)) $ Exc.throwT $ concat $ errors when (not (null args)) $ Exc.throwT $ "I have no usage for the arguments " ++ show args flags <- Exc.ExceptionalT $ return $ foldl (>>=) (return deflt) opts when (help flags) (MT.lift $ Env.getProgName >>= \programName -> putStrLn (usageInfo ("Usage: " ++ programName ++ " [OPTIONS]") options) >> exitSuccess) return flags