14 name <- getProgName |
16 name <- getProgName |
15 hPutStrLn stderr $ usageInfo header options |
17 hPutStrLn stderr $ usageInfo header options |
16 exitFailure |
18 exitFailure |
17 else do |
19 else do |
18 case getOpt RequireOrder options args of |
20 case getOpt RequireOrder options args of |
19 (flags, [], []) -> |
21 (flags, [], []) | enoughFlags flags -> do |
20 if length args == 8 then do |
22 let m = flag flags isName |
|
23 let i = flag flags isInput |
|
24 let o = flag flags isOutput |
|
25 let a = fromMaybe o $ liftM extractString $ find isAlt flags |
21 hPutStrLn stdout $ "--------Pas2C Config--------" |
26 hPutStrLn stdout $ "--------Pas2C Config--------" |
22 hPutStrLn stdout $ "Main module: " ++ (args !! 1) |
27 hPutStrLn stdout $ "Main module: " ++ m |
23 hPutStrLn stdout $ "Input path : " ++ (args !! 3) |
28 hPutStrLn stdout $ "Input path : " ++ i |
24 hPutStrLn stdout $ "Output path: " ++ (args !! 5) |
29 hPutStrLn stdout $ "Output path: " ++ o |
25 hPutStrLn stdout $ "Altern path: " ++ (args !! 7) |
30 hPutStrLn stdout $ "Altern path: " ++ a |
26 hPutStrLn stdout $ "----------------------------" |
31 hPutStrLn stdout $ "----------------------------" |
27 pas2C (args !! 1) ((args !! 3)++"/") ((args !! 5)++"/") ((args !! 7)++"/") |
32 pas2C m (i++"/") (o++"/") (a++"/") |
28 hPutStrLn stdout $ "----------------------------" |
33 hPutStrLn stdout $ "----------------------------" |
29 else do |
34 | otherwise -> error $ usageInfo header options |
30 if length args == 6 then do |
|
31 hPutStrLn stdout $ "--------Pas2C Config--------" |
|
32 hPutStrLn stdout $ "Main module: " ++ (args !! 1) |
|
33 hPutStrLn stdout $ "Input path : " ++ (args !! 3) |
|
34 hPutStrLn stdout $ "Output path: " ++ (args !! 5) |
|
35 hPutStrLn stdout $ "Altern path: " ++ "./" |
|
36 hPutStrLn stdout $ "----------------------------" |
|
37 pas2C (args !! 1) ((args !! 3)++"/") ((args !! 5)++"/") "./" |
|
38 hPutStrLn stdout $ "----------------------------" |
|
39 else do |
|
40 error $ usageInfo header options |
|
41 (_, nonOpts, []) -> error $ "unrecognized arguments: " ++ unwords nonOpts |
35 (_, nonOpts, []) -> error $ "unrecognized arguments: " ++ unwords nonOpts |
42 (_, _, msgs) -> error $ usageInfo header options |
36 (_, _, msgs) -> error $ usageInfo header options |
43 where header = "Freepascal to C conversion! Please use -n -i -o -a options in this order.\n" |
37 where |
|
38 header = "Freepascal to C conversion! Please specify -n -i -o options.\n" |
|
39 enoughFlags f = and $ map (isJust . flip find f) [isName, isInput, isOutput] |
|
40 flag f = extractString . fromJust . flip find f |
44 |
41 |
45 |
42 |
46 data Flag = HelpMessage | Name String | Input String | Output String | Alternate String |
43 data Flag = HelpMessage | Name String | Input String | Output String | Alternate String |
|
44 |
|
45 |
|
46 extractString :: Flag -> String |
|
47 extractString (Name s) = s |
|
48 extractString (Input s) = s |
|
49 extractString (Output s) = s |
|
50 extractString (Alternate s) = s |
|
51 extractString _ = undefined |
|
52 |
|
53 isName, isInput, isOutput, isAlt :: Flag -> Bool |
|
54 isName (Name _) = True |
|
55 isName _ = False |
|
56 isInput (Input _) = True |
|
57 isInput _ = False |
|
58 isOutput (Output _) = True |
|
59 isOutput _ = False |
|
60 isAlt (Alternate _) = True |
|
61 isAlt _ = False |
47 |
62 |
48 options :: [OptDescr Flag] |
63 options :: [OptDescr Flag] |
49 options = [ |
64 options = [ |
50 Option ['h'] ["help"] (NoArg HelpMessage) "print this help message", |
65 Option ['h'] ["help"] (NoArg HelpMessage) "print this help message", |
51 Option ['n'] ["name"] (ReqArg Name "MAIN") "name of the main Pascal module", |
66 Option ['n'] ["name"] (ReqArg Name "MAIN") "name of the main Pascal module", |