Version bump to v0.4.1.

[haeredes.git] / src / Main.hs

diff --git a/src/Main.hs b/src/Main.hs
index a5dc79466067f0dc70fc529169f55d111ae13b96..70fa2f57c842ebb34c96e2e268070065b2488530 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -2,7 +2,7 @@ module Main
 where
 
 import Control.Concurrent.ParallelIO.Global (
-  parallel,
+  parallelInterleaved,
   stopGlobalPool )
 import Control.Monad (unless)
 import qualified Data.ByteString.Char8 as BS (
@@ -17,6 +17,8 @@ import Network.DNS (
   ResolvConf(resolvInfo, resolvTimeout),
   defaultResolvConf,
   makeResolvSeed,
+  normalize,
+  normalizeCase,
   withResolver )
 import System.Exit (ExitCode(..), exitWith)
 import System.IO (hPutStrLn, stderr)
@@ -27,8 +29,6 @@ import DNS (
   LookupResult,
   lookupMX',
   lookupNS',
-  normalize,
-  normalize_case,
   resolve_address )
 import ExitCodes (exit_bad_server)
 import Timeout (Timeout(..))
@@ -81,7 +81,7 @@ main = do
 
   let normalize_function =
         if (no_append_root cfg)
-        then normalize_case
+        then normalizeCase
         else normalize
 
   -- Normalize the given names and delegates
@@ -113,10 +113,17 @@ main = do
                           NS{} -> lookupNS'
                           MX{} -> lookupMX'
 
-  _ <- withResolver rs $ \resolver -> do
-         -- Bad stuff happens if we try to run these lookups in parallel
-         -- instead of the reports.
-         records <- mapM (lookup_function resolver) nrml_domains
-         parallel (map (report nrml_delegates) records)
+  let lookup' d = withResolver rs $ \resolver ->
+                    lookup_function resolver d
+
+  -- Construct a list of [IO whatever]. The withResolver calls
+  -- are the ones that should be run in parallel.
+  let actions = map lookup' nrml_domains
+
+  -- Run the lookup actions in parallel.
+  results <- parallelInterleaved actions
+
+  -- Output the results.
+  _ <- mapM (report nrml_delegates) results
 
   stopGlobalPool