[tor-commits] [tordnsel/master] some monadic utilities

[arlo at torproject.org]

commit edc8c858a736c8b513b90cf2e0a7dd187ab5c2af
Author: David Kaloper <david at numm.org>
Date:   Sat Sep 21 19:13:02 2013 +0200

    some monadic utilities
---
 src/TorDNSEL/Config/Internals.hs          |  2 +-
 src/TorDNSEL/DNS/Internals.hs             |  2 +-
 src/TorDNSEL/ExitTest/Server/Internals.hs |  2 +-
 src/TorDNSEL/Statistics/Internals.hs      |  2 +-
 src/TorDNSEL/TorControl/Internals.hs      |  3 ++-
 src/TorDNSEL/Util.hsc                     | 22 +++++++++++-----------
 6 files changed, 17 insertions(+), 16 deletions(-)

diff --git a/src/TorDNSEL/Config/Internals.hs b/src/TorDNSEL/Config/Internals.hs
index d93da96..4b60db7 100644
--- a/src/TorDNSEL/Config/Internals.hs
+++ b/src/TorDNSEL/Config/Internals.hs
@@ -48,7 +48,7 @@ import Control.Arrow ((***), second)
 import Control.Concurrent.Chan
 import Control.Concurrent.MVar
 import qualified Control.Exception as E
-import Control.Monad (liftM, liftM2, ap)
+import Control.Monad (liftM, liftM2, ap, forever)
 import Control.Monad.Error (MonadError(..))
 import Control.Monad.Fix (fix)
 import Data.Char (isSpace, toLower)
diff --git a/src/TorDNSEL/DNS/Internals.hs b/src/TorDNSEL/DNS/Internals.hs
index 91b2391..76002d8 100644
--- a/src/TorDNSEL/DNS/Internals.hs
+++ b/src/TorDNSEL/DNS/Internals.hs
@@ -59,7 +59,7 @@ module TorDNSEL.DNS.Internals (
   ) where
 
 import qualified Control.Exception as E
-import Control.Monad (when, unless, replicateM, liftM2, liftM3, forM)
+import Control.Monad (when, unless, replicateM, liftM2, liftM3, forM, forever)
 import qualified Control.Monad.State as S
 import Control.Monad.Trans (lift)
 import Control.DeepSeq
diff --git a/src/TorDNSEL/ExitTest/Server/Internals.hs b/src/TorDNSEL/ExitTest/Server/Internals.hs
index 0d43db3..8f9a872 100644
--- a/src/TorDNSEL/ExitTest/Server/Internals.hs
+++ b/src/TorDNSEL/ExitTest/Server/Internals.hs
@@ -24,7 +24,7 @@ import Prelude hiding (log)
 import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan, isEmptyChan)
 import Control.Concurrent.QSemN (QSemN, newQSemN, waitQSemN, signalQSemN)
 import qualified Control.Exception as E
-import Control.Monad (when, forM, foldM)
+import Control.Monad (when, forM, foldM, forever)
 import Control.Monad.Fix (fix)
 import Control.Monad.Trans (lift)
 import Control.Applicative
diff --git a/src/TorDNSEL/Statistics/Internals.hs b/src/TorDNSEL/Statistics/Internals.hs
index 3932156..d05da2c 100644
--- a/src/TorDNSEL/Statistics/Internals.hs
+++ b/src/TorDNSEL/Statistics/Internals.hs
@@ -23,7 +23,7 @@ import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
 import Control.Concurrent.MVar (MVar, newMVar, modifyMVar_, readMVar)
 import Control.Concurrent.QSem (QSem, newQSem, waitQSem, signalQSem)
 import qualified Control.Exception as E
-import Control.Monad (when)
+import Control.Monad (when, forever)
 import Control.Monad.Fix (fix)
 import qualified Data.ByteString.Char8 as B
 import Data.Maybe (isJust, isNothing)
diff --git a/src/TorDNSEL/TorControl/Internals.hs b/src/TorDNSEL/TorControl/Internals.hs
index 39bb21f..254d6b1 100644
--- a/src/TorDNSEL/TorControl/Internals.hs
+++ b/src/TorDNSEL/TorControl/Internals.hs
@@ -137,10 +137,11 @@ import Control.Concurrent.Chan (newChan, readChan, writeChan)
 import Control.Concurrent.MVar
   (MVar, newMVar, newEmptyMVar, takeMVar, tryPutMVar, withMVar, modifyMVar_)
 import qualified Control.Exception as E
-import Control.Monad (when, unless, liftM, mzero, mplus)
+import Control.Monad (when, unless, liftM, mzero, mplus, forever)
 import Control.Monad.Error (MonadError(..))
 import Control.Monad.Fix (fix)
 import Control.Monad.State (StateT(StateT), get, put, lift, evalStateT)
+import Control.Applicative
 import qualified Data.ByteString.Char8 as B
 import Data.ByteString (ByteString)
 import Data.Char (isSpace, isAlphaNum, isDigit, isAlpha, toLower)
diff --git a/src/TorDNSEL/Util.hsc b/src/TorDNSEL/Util.hsc
index 1cf59b2..5cea0bb 100644
--- a/src/TorDNSEL/Util.hsc
+++ b/src/TorDNSEL/Util.hsc
@@ -43,9 +43,9 @@ module TorDNSEL.Util (
   , swap
   , partitionEither
   , whenJust
-  , forever
   , untilM
   , untilM_
+  , muntil
   , inet_htoa
   , encodeBase16
   , split
@@ -293,20 +293,20 @@ partitionEither (Right x:xs) = (x :) `second` partitionEither xs
 whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
 whenJust = flip . maybe . return $ ()
 
--- | Repeat an 'IO' action forever.
-forever :: IO a -> IO ()
-forever = sequence_ . repeat
-
 -- | Repeat an 'IO' action until a predicate is satisfied, collecting the
 -- results into a list. The predicate is evaluated before the 'IO' action.
-untilM :: IO Bool -> IO a -> IO [a]
-untilM p io = loop where loop = do p' <- p
-                                   if p' then return []
-                                         else liftM2 (:) io loop
+untilM :: Monad m => m Bool -> m a -> m [a]
+untilM p io = p >>= \p' ->
+  if p' then return [] else liftM2 (:) io $ untilM p io
 
 -- | Like 'untilM', but ignoring the results of the 'IO' action.
-untilM_ :: IO Bool -> IO a -> IO ()
-untilM_ p io = loop where loop = p >>= flip unless (io >> loop)
+untilM_ :: Monad m => m Bool -> m a -> m ()
+untilM_ p io = p >>= (`unless` (io >> untilM_ p io))
+
+-- | Like 'untilM', but the predicate is not monadic.
+muntil :: Monad m => (a -> Bool) -> m a -> m [a]
+muntil p a = a >>= \a' ->
+  if p a' then return [] else (a':) `liftM` muntil p a
 
 -- | Convert an IPv4 address to a 'String' in dotted-quad form.
 inet_htoa :: HostAddress -> String