module Main where import CmdDB import Control.Applicative import Control.Exception import Control.Monad import Data.List import Data.Maybe import System.Cmd import System.Environment (getArgs) import System.Exit import Types import Utils ---------------------------------------------------------------- main :: IO () main = flip catches handlers $ do (args,opts) <- argsOpts <$> getArgs when (args == []) helpAndExit checkHelp args opts helpCommandAndExit let act = head args mcmdspec = commandSpecByName act commandDB when (isNothing mcmdspec) (illegalCommandAndExit act) let Just cmdspec = mcmdspec params = tail args eoptspecs = parseOptions cmdspec opts checkOptions eoptspecs illegalOptionsAndExit let Right flags = eoptspecs run cmdspec params flags where handlers = [Handler handleExit] handleExit :: ExitCode -> IO () handleExit _ = return () ---------------------------------------------------------------- argsOpts :: [String] -> ([String],[String]) argsOpts args = (args', opts) where args' = filter (not . isPrefixOf "-") args opts = filter (isPrefixOf "-") args parseOptions :: CommandSpec -> [String] -> Either [String] Flags parseOptions cmdspc opts = check opts [] defaultFlags where optMvals = options cmdspc check [] [] fg = Right fg check [] es _ = Left es check (o:os) es fg = case optionSpecByName o optionDB of Nothing -> check os (o:es) fg Just x -> case lookup (option x) optMvals of Nothing -> check os (o:es) fg Just mval -> check os es (updateFlags (option x) mval fg) checkHelp :: [String] -> [String] -> FunctionCommand -> IO () checkHelp args opts func | "-h" `elem` opts || "--help" `elem` opts = func undefined args undefined | otherwise = return () checkOptions :: Either [String] Flags -> ([String] -> IO ()) -> IO () checkOptions (Left xs) func = func xs checkOptions _ _ = return () ---------------------------------------------------------------- run :: CommandSpec -> [String] -> Flags -> IO () run cmdspec params flags = case routing cmdspec of RouteFunc func -> func cmdspec params flags RouteProc subcmd subargs -> callProcess subcmd subargs params flags callProcess :: String ->[String] -> [String] -> Flags -> IO () callProcess pro args0 args1 flags = system script >> return () where opts = flagsToOptions flags script = joinBy " " $ pro : opts ++ args0 ++ cat args1 cat [pkg,ver] = [pkg ++ "-" ++ ver] cat x = x