X-Git-Url: http://gitweb.michael.orlitzky.com/?p=haeredes.git;a=blobdiff_plain;f=src%2FCommandLine.hs;fp=src%2FCommandLine.hs;h=699ea97aceea436ce6abecbace894d43542984eb;hp=0000000000000000000000000000000000000000;hb=825753e2731b8491d93d9f2d66b457fe31b1c763;hpb=e5168c9d5f32912d4e77713935e8c09a468bfd01

diff --git a/src/CommandLine.hs b/src/CommandLine.hs
new file mode 100644
index 0000000..699ea97
--- /dev/null
+++ b/src/CommandLine.hs
@@ -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