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