makefile: disable three new spurious GHC warnings.
[haeredes.git] / src / CommandLine.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2
3 module CommandLine (
4 Args(..),
5 get_args )
6 where
7
8 import System.Console.CmdArgs (
9 Ann,
10 Annotate( (:=) ),
11 Data,
12 (+=),
13 args,
14 auto,
15 cmdArgs_,
16 def,
17 details,
18 explicit,
19 groupname,
20 help,
21 helpArg,
22 modes_,
23 name,
24 program,
25 record,
26 summary,
27 typ,
28 versionArg )
29
30 -- Get the version from Cabal.
31 import Paths_haeredes (version)
32 import Data.Version (showVersion)
33
34 import Timeout (Timeout(seconds))
35
36
37 -- | Description of the 'NS' mode.
38 --
39 ns_description :: String
40 ns_description =
41 "Confirm delegation of NS records. " ++
42 "This is the default mode."
43
44
45 -- | Description of the 'MX' mode.
46 --
47 mx_description :: String
48 mx_description = "Confirm delegation of MX records."
49
50
51 -- | The name of the program, appears in the \"help\" output.
52 --
53 program_name :: String
54 program_name = "haeredes"
55
56
57 -- | A short summary (program name and version) that are output
58 -- as part of the help.
59 --
60 my_summary :: String
61 my_summary = program_name ++ "-" ++ (showVersion version)
62
63
64 -- | Description of the --no-append-root flag.
65 --
66 no_append_root_help :: String
67 no_append_root_help =
68 "Don't append a trailing dot to DNS names"
69
70
71 -- | Description of the --server flag.
72 --
73 server_help :: String
74 server_help =
75 "IP address or hostname of server to query " ++
76 "(will use resolv.conf if not specified)"
77
78
79 -- | Description of the --timeout flag.
80 --
81 timeout_help :: String
82 timeout_help =
83 "Query timeout, in seconds (default: " ++ defstr ++ ")"
84 where
85 defstr = show $ seconds (def :: Timeout)
86
87
88 -- | The 'Args' type represents the possible command-line options. The
89 -- duplication here seems necessary; CmdArgs's magic requires us to
90 -- define some things explicitly.
91 --
92 data Args =
93 NS { no_append_root :: Bool,
94 server :: Maybe String,
95 timeout :: Timeout,
96 delegates :: [String] } |
97 MX { no_append_root :: Bool,
98 server :: Maybe String,
99 timeout :: Timeout,
100 delegates :: [String] }
101 deriving (Data, Show)
102
103
104
105 -- | The big argument specification. We use explicit annotation here
106 -- because otherwise there's come CmdArgs magic going on that
107 -- requires us to specify /all/ of the arguments for /each/ mode;
108 -- i.e. we have to duplicate all of them for both 'NS' and 'MX.
109 --
110 -- This is slightly arcane but at least it doesn't repeat yoself.
111 --
112 arg_spec :: Annotate Ann
113 arg_spec =
114 modes_ [ns += auto, mx]
115 += program program_name
116 += summary my_summary
117 += helpArg [explicit,
118 name "help",
119 name "h",
120 groupname "Common flags"]
121 += versionArg [explicit,
122 name "version",
123 name "v",
124 groupname "Common flags"]
125 where
126 -- | Create a mode, adding all of the common flags to it
127 -- automatically. The big ugly type of the first argument is
128 -- simply the type of our NS/MX constructors.
129 --
130 make_mode :: (Bool -> Maybe String -> Timeout -> [String] -> Args)
131 -> String
132 -> (Annotate Ann)
133 make_mode ctor desc =
134 record (ctor def def def def) [
135 no_append_root := def
136 += groupname "Common flags"
137 += help no_append_root_help,
138
139 server := def
140 += groupname "Common flags"
141 += typ "IP"
142 += help server_help,
143
144 timeout := def
145 += groupname "Common flags"
146 += typ "SECONDS"
147 += help timeout_help,
148
149 delegates := def
150 += args
151 += typ "DELEGATES" ]
152 += details [" " ++ desc]
153
154
155 -- Here we just create the NS/MX modes using our make_mode from above.
156 ns = make_mode NS ns_description
157 mx = make_mode MX mx_description
158
159
160
161 -- | This is the public interface; i.e. what 'main' should use to get
162 -- the command-line arguments.
163 --
164 get_args :: IO Args
165 get_args = cmdArgs_ arg_spec