Rewrite command-line parsing to use cmdargs.

[hath.git] / src / Main.hs

diff --git a/src/Main.hs b/src/Main.hs
index f567400c1ac4080905b9a31700051bf91cb81d82..45705be673f087d76d8e64ea61f16c086ac98632 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,15 +1,13 @@
 module Main
 where
 
 module Main
 where
 

-import Control.Concurrent.ParallelIO.Global (
-  parallel,
-  stopGlobalPool )
-import Control.Monad (unless, when)
+import Control.Concurrent.ParallelIO.Global ( stopGlobalPool )
+import Control.Monad (when)

 import qualified Data.ByteString.Char8 as BS (intercalate, pack, unpack)
 import Data.List ((\\), intercalate)
 import Data.Maybe (catMaybes, isNothing)
 import Data.String.Utils (splitWs)
 import qualified Data.ByteString.Char8 as BS (intercalate, pack, unpack)
 import Data.List ((\\), intercalate)
 import Data.Maybe (catMaybes, isNothing)
 import Data.String.Utils (splitWs)

-import System.Exit (ExitCode(..), exitSuccess, exitWith)
+import System.Exit (ExitCode(..), exitWith)

 import System.IO (stderr, hPutStrLn)
 import Text.Read (readMaybe)
 
 import System.IO (stderr, hPutStrLn)
 import Text.Read (readMaybe)
 


@@ -25,15 +23,9 @@ import Cidr (
   min_octet2,
   min_octet3,
   min_octet4 )
   min_octet2,
   min_octet3,
   min_octet4 )

-import CommandLine (
-  help_set,
-  help_text,
-  input_function,
-  Mode(..),
-  parse_errors,
-  parse_mode )
-import DNS (Domain, lookup_ptrs)
-import ExitCodes ( exit_args_parse_failed, exit_invalid_cidr )
+import CommandLine (Args(..), get_args)
+import DNS (Domain, PTRResult, lookup_ptrs)
+import ExitCodes ( exit_invalid_cidr )

 import Octet ()
 
 
 import Octet ()
 
 


@@ -45,8 +37,8 @@ non_addr_char = "[^\\.0-9]"
 -- | Add non_addr_chars on either side of the given String. This
 --   prevents (for example) the regex '127.0.0.1' from matching
 --   '127.0.0.100'.
 -- | Add non_addr_chars on either side of the given String. This
 --   prevents (for example) the regex '127.0.0.1' from matching
 --   '127.0.0.100'.

-addr_barrier :: String -> String
-addr_barrier x = non_addr_char ++ x ++ non_addr_char
+add_barriers :: String -> String
+add_barriers x = non_addr_char ++ x ++ non_addr_char

 
 
 -- | The magic happens here. We take a CIDR String as an argument, and
 
 
 -- | The magic happens here. We take a CIDR String as an argument, and


@@ -58,9 +50,11 @@ addr_barrier x = non_addr_char ++ x ++ non_addr_char
 --      max values.
 --   4. Join the regexes from step 3 with regexes matching periods.
 --   5. Stick an address boundary on either side of the result.
 --      max values.
 --   4. Join the regexes from step 3 with regexes matching periods.
 --   5. Stick an address boundary on either side of the result.

-cidr_to_regex :: Cidr.Cidr -> String
-cidr_to_regex cidr =
-    addr_barrier (intercalate "\\." [range1, range2, range3, range4])
+--
+cidr_to_regex :: Bool -> Cidr.Cidr -> String
+cidr_to_regex use_barriers cidr =
+    let f = if use_barriers then add_barriers else id in
+      f (intercalate "\\." [range1, range2, range3, range4])

     where
       range1 = numeric_range min1 max1
       range2 = numeric_range min2 max2
     where
       range1 = numeric_range min1 max1
       range2 = numeric_range min2 max2


@@ -95,49 +89,40 @@ numeric_range x y =
 
 main :: IO ()
 main = do
 
 main :: IO ()
 main = do

-  -- First, check for any errors that occurred while parsing
-  -- the command line options.
-  errors <- CommandLine.parse_errors
-  unless (null errors) $ do
-    hPutStrLn stderr (concat errors)
-    putStrLn CommandLine.help_text
-    exitWith (ExitFailure exit_args_parse_failed)
-
-  -- Next, check to see if the 'help' option was passed to the
-  -- program. If it was, display the help, and exit successfully.
-  help_opt_set <- CommandLine.help_set
-  when help_opt_set $ do
-    putStrLn CommandLine.help_text
-    exitSuccess
-
-  -- The input function we receive here should know what to read.
-  inputfunc <- (CommandLine.input_function)
-  input <- inputfunc
+  args <- get_args
+
+  -- This reads stdin.
+  input <- getContents

 
   let cidr_strings = splitWs input
   let cidrs = map readMaybe cidr_strings
 
   when (any isNothing cidrs) $ do
 
   let cidr_strings = splitWs input
   let cidrs = map readMaybe cidr_strings
 
   when (any isNothing cidrs) $ do

-    putStrLn "Error: not valid CIDR notation."
+    hPutStrLn stderr "ERROR: not valid CIDR notation:"
+
+    -- Output the bad lines, safely.
+    let pairs = zip cidr_strings cidrs
+    let print_pair (x, Nothing) = hPutStrLn stderr ("  * " ++ x)
+        print_pair (_, _) = return ()
+
+    mapM_ print_pair pairs

     exitWith (ExitFailure exit_invalid_cidr)
 
   -- Filter out only the valid ones.
   let valid_cidrs = catMaybes cidrs
 
     exitWith (ExitFailure exit_invalid_cidr)
 
   -- Filter out only the valid ones.
   let valid_cidrs = catMaybes cidrs
 

-  -- Get the mode of operation.
-  mode <- CommandLine.parse_mode
-
-  case mode of
-    Regex -> do
-      let regexes = map cidr_to_regex valid_cidrs
+  case args of
+    Regexed{} -> do
+      let cidrs' = combine_all valid_cidrs
+      let regexes = map (cidr_to_regex (barriers args)) cidrs'

       putStrLn $ alternate regexes
       putStrLn $ alternate regexes

-    Reduce ->
+    Reduced{} ->

       mapM_ print (combine_all valid_cidrs)
       mapM_ print (combine_all valid_cidrs)

-    Dupe ->
+    Duped{} ->

        mapM_ print dupes
        where
          dupes = valid_cidrs \\ (combine_all valid_cidrs)
        mapM_ print dupes
        where
          dupes = valid_cidrs \\ (combine_all valid_cidrs)

-    Diff -> do
+    Diffed{} -> do

        mapM_ putStrLn deletions
        mapM_ putStrLn additions
        where
        mapM_ putStrLn deletions
        mapM_ putStrLn additions
        where


@@ -145,28 +130,27 @@ main = do
          deletions = map (\s -> '-' : (show s)) dupes
          newcidrs = (combine_all valid_cidrs) \\ valid_cidrs
          additions = map (\s -> '+' : (show s)) newcidrs
          deletions = map (\s -> '-' : (show s)) dupes
          newcidrs = (combine_all valid_cidrs) \\ valid_cidrs
          additions = map (\s -> '+' : (show s)) newcidrs

-    List -> do
+    Listed{} -> do

       let combined_cidrs = combine_all valid_cidrs
       let addrs = concatMap enumerate combined_cidrs
       mapM_ print addrs
       let combined_cidrs = combine_all valid_cidrs
       let addrs = concatMap enumerate combined_cidrs
       mapM_ print addrs

-    Reverse -> do
+    Reversed{} -> do

       let combined_cidrs = combine_all valid_cidrs
       let addrs = concatMap enumerate combined_cidrs
       let addr_bytestrings = map (BS.pack . show) addrs
       ptrs <- lookup_ptrs addr_bytestrings
       let pairs = zip addr_bytestrings ptrs
       let combined_cidrs = combine_all valid_cidrs
       let addrs = concatMap enumerate combined_cidrs
       let addr_bytestrings = map (BS.pack . show) addrs
       ptrs <- lookup_ptrs addr_bytestrings
       let pairs = zip addr_bytestrings ptrs

-      _ <- parallel (map (putStrLn . show_pair) pairs)
-      return ()
+      mapM_ (putStrLn . show_pair) pairs

 
   stopGlobalPool
 
   where
 
   stopGlobalPool
 
   where

-    show_pair :: (Domain, Maybe [Domain]) -> String
-    show_pair (s, mds) =
+    show_pair :: (Domain, PTRResult) -> String
+    show_pair (s, eds) =

       (BS.unpack s) ++ ": " ++ results
       where
         space = BS.pack " "
         results =
       (BS.unpack s) ++ ": " ++ results
       where
         space = BS.pack " "
         results =

-          case mds of
-            Nothing -> ""
-            Just ds -> BS.unpack $ BS.intercalate space ds
+          case eds of
+            Left err -> "ERROR (" ++ (show err) ++ ")"
+            Right ds -> BS.unpack $ BS.intercalate space ds