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