]> gitweb.michael.orlitzky.com - haeredes.git/blobdiff - src/CommandLine.hs
First iteration that does anything.
[haeredes.git] / src / CommandLine.hs
diff --git a/src/CommandLine.hs b/src/CommandLine.hs
new file mode 100644 (file)
index 0000000..699ea97
--- /dev/null
@@ -0,0 +1,90 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module CommandLine (
+  Args(..),
+  Delegates(..),
+  get_args
+  )
+where
+
+import System.Console.CmdArgs
+
+-- Get the version from Cabal.
+import Paths_haeres (version)
+import Data.Version (showVersion)
+
+ns_description :: String
+ns_description =
+  "Confirm delegation of NS records. " ++
+  "This is the default mode."
+
+mx_description :: String
+mx_description = "Confirm delegation of MX records."
+
+program_name :: String
+program_name = "haeres"
+
+my_summary :: String
+my_summary = program_name ++ "-" ++ (showVersion version)
+
+server_help :: String
+server_help =
+  "IP address of server to query " ++
+  "(will use resolv.conf if not specified)"
+
+newtype Delegates =
+  Delegates { get_delegates :: [String] }
+  deriving (Data, Show, Typeable)
+
+instance Default Delegates where
+  def = Delegates []
+
+data Args =
+  NS { server :: Maybe String, delegates :: Delegates } |
+  MX { server :: Maybe String, delegates :: Delegates }
+  deriving (Data, Show, Typeable)
+
+arg_spec :: Args
+arg_spec =
+  modes [ns &= auto, mx]
+    &= program program_name
+    &= summary my_summary
+    &= helpArg [explicit,
+                name "help",
+                name "h",
+                groupname "Common flags"]
+    &= versionArg [explicit,
+                   name "version",
+                   name "v",
+                   groupname "Common flags"]
+  where
+    -- The repetition here is necessary, some Template Haskell magic
+    -- going on.
+    ns :: Args
+    ns = NS {
+           server = def
+                  &= groupname "Common flags"
+                  &= typ "IP"
+                  &= help server_help,
+
+           delegates = def
+                     &= args
+                     &= typ "DELEGATES" }
+
+            &= details [ns_description]
+
+    mx :: Args
+    mx = MX {
+           server = def
+                 &= groupname "Common flags"
+                 &= typ "IP"
+                 &= help server_help,
+
+           delegates = def
+                    &= args
+                    &= typ "DELEGATES" }
+
+            &= details [mx_description]
+
+get_args :: IO Args
+get_args = cmdArgs arg_spec