Bump dns dependency to 1.*, and update DNS module.

[hath.git] / src / Main.hs

diff --git a/src/Main.hs b/src/Main.hs
index e57959e460e964d9beec7f09995dd40d5f84aae0..5afadcdfbc80e80fb1b4a2213afacce6fc836809 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,6 +1,7 @@
-import Control.Concurrent.ParallelIO.Global (
-  parallel,
-  stopGlobalPool )
+module Main
+where
+
+import Control.Concurrent.ParallelIO.Global ( stopGlobalPool )

 import Control.Monad (unless, when)
 import qualified Data.ByteString.Char8 as BS (intercalate, pack, unpack)
 import Data.List ((\\), intercalate)
 import Control.Monad (unless, when)
 import qualified Data.ByteString.Char8 as BS (intercalate, pack, unpack)
 import Data.List ((\\), intercalate)


@@ -8,28 +9,28 @@ import Data.Maybe (catMaybes, isNothing)
 import Data.String.Utils (splitWs)
 import System.Exit (ExitCode(..), exitSuccess, exitWith)
 import System.IO (stderr, hPutStrLn)
 import Data.String.Utils (splitWs)
 import System.Exit (ExitCode(..), exitSuccess, exitWith)
 import System.IO (stderr, hPutStrLn)

-
-import Cidr (Cidr(..),
-             cidr_from_string,
-             combine_all,
-             enumerate,
-             max_octet1,
-             max_octet2,
-             max_octet3,
-             max_octet4,
-             min_octet1,
-             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 Text.Read (readMaybe)
+
+import Cidr (
+  Cidr(..),
+  combine_all,
+  enumerate,
+  max_octet1,
+  max_octet2,
+  max_octet3,
+  max_octet4,
+  min_octet1,
+  min_octet2,
+  min_octet3,
+  min_octet4 )
+import CommandLine (
+  help_set,
+  help_text,
+  input_function,
+  Mode(..),
+  parse_errors,
+  parse_mode )
+import DNS (Domain, PTRResult, lookup_ptrs)

 import ExitCodes ( exit_args_parse_failed, exit_invalid_cidr )
 import Octet ()
 
 import ExitCodes ( exit_args_parse_failed, exit_invalid_cidr )
 import Octet ()
 


@@ -55,6 +56,7 @@ 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 :: Cidr.Cidr -> String
 cidr_to_regex cidr =
     addr_barrier (intercalate "\\." [range1, range2, range3, range4])


@@ -112,7 +114,7 @@ main = do
   input <- inputfunc
 
   let cidr_strings = splitWs input
   input <- inputfunc
 
   let cidr_strings = splitWs input

-  let cidrs = map cidr_from_string cidr_strings
+  let cidrs = map readMaybe cidr_strings

 
   when (any isNothing cidrs) $ do
     putStrLn "Error: not valid CIDR notation."
 
   when (any isNothing cidrs) $ do
     putStrLn "Error: not valid CIDR notation."


@@ -152,18 +154,17 @@ main = do
       let addr_bytestrings = map (BS.pack . show) addrs
       ptrs <- lookup_ptrs addr_bytestrings
       let pairs = zip addr_bytestrings ptrs
       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