commit edc8c858a736c8b513b90cf2e0a7dd187ab5c2af Author: David Kaloper david@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