diff -r c13ebed437cb -r 7a474fcc343d tools/pas2c/Main.hs --- a/tools/pas2c/Main.hs Tue Apr 02 21:00:57 2013 +0200 +++ b/tools/pas2c/Main.hs Tue Apr 02 23:43:39 2013 +0400 @@ -4,7 +4,9 @@ import System.Environment import System.Exit import System.IO -import Data.Maybe( fromMaybe ) +import Data.Maybe( fromMaybe, isJust, fromJust ) +import Data.List (find) +import Control.Monad import Pas2C main = do @@ -16,35 +18,48 @@ exitFailure else do case getOpt RequireOrder options args of - (flags, [], []) -> - if length args == 8 then do + (flags, [], []) | enoughFlags flags -> do + let m = flag flags isName + let i = flag flags isInput + let o = flag flags isOutput + let a = fromMaybe o $ liftM extractString $ find isAlt flags hPutStrLn stdout $ "--------Pas2C Config--------" - hPutStrLn stdout $ "Main module: " ++ (args !! 1) - hPutStrLn stdout $ "Input path : " ++ (args !! 3) - hPutStrLn stdout $ "Output path: " ++ (args !! 5) - hPutStrLn stdout $ "Altern path: " ++ (args !! 7) - hPutStrLn stdout $ "----------------------------" - pas2C (args !! 1) ((args !! 3)++"/") ((args !! 5)++"/") ((args !! 7)++"/") + hPutStrLn stdout $ "Main module: " ++ m + hPutStrLn stdout $ "Input path : " ++ i + hPutStrLn stdout $ "Output path: " ++ o + hPutStrLn stdout $ "Altern path: " ++ a hPutStrLn stdout $ "----------------------------" - else do - if length args == 6 then do - hPutStrLn stdout $ "--------Pas2C Config--------" - hPutStrLn stdout $ "Main module: " ++ (args !! 1) - hPutStrLn stdout $ "Input path : " ++ (args !! 3) - hPutStrLn stdout $ "Output path: " ++ (args !! 5) - hPutStrLn stdout $ "Altern path: " ++ "./" - hPutStrLn stdout $ "----------------------------" - pas2C (args !! 1) ((args !! 3)++"/") ((args !! 5)++"/") "./" - hPutStrLn stdout $ "----------------------------" - else do - error $ usageInfo header options + pas2C m (i++"/") (o++"/") (a++"/") + hPutStrLn stdout $ "----------------------------" + | otherwise -> error $ usageInfo header options (_, nonOpts, []) -> error $ "unrecognized arguments: " ++ unwords nonOpts (_, _, msgs) -> error $ usageInfo header options - where header = "Freepascal to C conversion! Please use -n -i -o -a options in this order.\n" + where + header = "Freepascal to C conversion! Please specify -n -i -o options.\n" + enoughFlags f = and $ map (isJust . flip find f) [isName, isInput, isOutput] + flag f = extractString . fromJust . flip find f data Flag = HelpMessage | Name String | Input String | Output String | Alternate String + +extractString :: Flag -> String +extractString (Name s) = s +extractString (Input s) = s +extractString (Output s) = s +extractString (Alternate s) = s +extractString _ = undefined + +isName, isInput, isOutput, isAlt :: Flag -> Bool +isName (Name _) = True +isName _ = False +isInput (Input _) = True +isInput _ = False +isOutput (Output _) = True +isOutput _ = False +isAlt (Alternate _) = True +isAlt _ = False + options :: [OptDescr Flag] options = [ Option ['h'] ["help"] (NoArg HelpMessage) "print this help message",