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