Start refactoring the flag parsing
[hsc2hs.git] / Flags.hs
1
2 module Flags where
3
4 import System.Console.GetOpt
5
6 data Mode
7 = Help
8 | Version
9 | UseConfig Config
10
11 data Config = Config {
12 cTemplate :: Maybe FilePath,
13 cCompiler :: Maybe FilePath,
14 cLinker :: Maybe FilePath,
15 cKeepFiles :: Bool,
16 cCrossCompile :: Bool,
17 cVerbose :: Bool,
18 cFlags :: [Flag]
19 }
20
21 emptyMode :: Mode
22 emptyMode = UseConfig $ Config {
23 cTemplate = Nothing,
24 cCompiler = Nothing,
25 cLinker = Nothing,
26 cKeepFiles = False,
27 cCrossCompile = False,
28 cVerbose = False,
29 cFlags = []
30 }
31
32 data Flag
33 = CompFlag String
34 | LinkFlag String
35 | NoCompile
36 | CrossSafe
37 | Include String
38 | Define String (Maybe String)
39 | Output String
40 deriving Show
41
42 options :: [OptDescr (Mode -> Mode)]
43 options = [
44 Option ['o'] ["output"] (ReqArg (addFlag . Output) "FILE")
45 "name of main output file",
46 Option ['t'] ["template"] (ReqArg (withConfig . setTemplate) "FILE")
47 "template file",
48 Option ['c'] ["cc"] (ReqArg (withConfig . setCompiler) "PROG")
49 "C compiler to use",
50 Option ['l'] ["ld"] (ReqArg (withConfig . setLinker) "PROG")
51 "linker to use",
52 Option ['C'] ["cflag"] (ReqArg (addFlag . CompFlag) "FLAG")
53 "flag to pass to the C compiler",
54 Option ['I'] [] (ReqArg (addFlag . CompFlag . ("-I"++)) "DIR")
55 "passed to the C compiler",
56 Option ['L'] ["lflag"] (ReqArg (addFlag . LinkFlag) "FLAG")
57 "flag to pass to the linker",
58 Option ['i'] ["include"] (ReqArg (addFlag . include) "FILE")
59 "as if placed in the source",
60 Option ['D'] ["define"] (ReqArg (addFlag . define) "NAME[=VALUE]")
61 "as if placed in the source",
62 Option [] ["no-compile"] (NoArg (addFlag NoCompile))
63 "stop after writing *_hsc_make.c",
64 Option ['x'] ["cross-compile"] (NoArg (withConfig $ setCrossCompile True))
65 "activate cross-compilation mode",
66 Option [] ["cross-safe"] (NoArg (addFlag CrossSafe))
67 "restrict .hsc directives to those supported by --cross-compile",
68 Option ['k'] ["keep-files"] (NoArg (withConfig $ setKeepFiles True))
69 "do not remove temporary files",
70 Option ['v'] ["verbose"] (NoArg (withConfig $ setVerbose True))
71 "dump commands to stderr",
72 Option ['?'] ["help"] (NoArg (setMode Help))
73 "display this help and exit",
74 Option ['V'] ["version"] (NoArg (setMode Version))
75 "output version information and exit" ]
76
77 addFlag :: Flag -> Mode -> Mode
78 addFlag f (UseConfig c) = UseConfig $ c { cFlags = f : cFlags c }
79 addFlag _ mode = mode
80
81 setMode :: Mode -> Mode -> Mode
82 setMode Help _ = Help
83 setMode _ Help = Help
84 setMode Version _ = Version
85 setMode (UseConfig {}) _ = error "setMode: UseConfig: Can't happen"
86
87 withConfig :: (Config -> Config) -> Mode -> Mode
88 withConfig f (UseConfig c) = UseConfig $ f c
89 withConfig _ m = m
90
91 setTemplate :: FilePath -> Config -> Config
92 setTemplate fp c = c { cTemplate = Just fp }
93
94 setCompiler :: FilePath -> Config -> Config
95 setCompiler fp c = c { cCompiler = Just fp }
96
97 setLinker :: FilePath -> Config -> Config
98 setLinker fp c = c { cLinker = Just fp }
99
100 setKeepFiles :: Bool -> Config -> Config
101 setKeepFiles b c = c { cKeepFiles = b }
102
103 setCrossCompile :: Bool -> Config -> Config
104 setCrossCompile b c = c { cCrossCompile = b }
105
106 setVerbose :: Bool -> Config -> Config
107 setVerbose v c = c { cVerbose = v }
108
109 include :: String -> Flag
110 include s@('\"':_) = Include s
111 include s@('<' :_) = Include s
112 include s = Include ("\""++s++"\"")
113
114 define :: String -> Flag
115 define s = case break (== '=') s of
116 (name, []) -> Define name Nothing
117 (name, _:value) -> Define name (Just value)
118