commit d210b013e36b46d1c16927aa22e45c7fe05bd7f5 Author: David Kaloper <david@numm.org> Date: Tue Oct 29 05:09:36 2013 +0100 remove internal Control.DeepSeq --- src/TorDNSEL/DNS/Internals.hs | 61 ++++++++++++++++++----------------------- src/TorDNSEL/DeepSeq.hs | 39 -------------------------- src/TorDNSEL/Socks/Internals.hs | 8 ++---- src/TorDNSEL/Util.hsc | 14 +--------- tordnsel.cabal | 3 +- 5 files changed, 31 insertions(+), 94 deletions(-) diff --git a/src/TorDNSEL/DNS/Internals.hs b/src/TorDNSEL/DNS/Internals.hs index 54d1c08..735d7a8 100644 --- a/src/TorDNSEL/DNS/Internals.hs +++ b/src/TorDNSEL/DNS/Internals.hs @@ -63,6 +63,7 @@ import qualified Control.Exception as E import Control.Monad (when, unless, replicateM, liftM2, liftM3, forM) import qualified Control.Monad.State as S import Control.Monad.Trans (lift) +import Control.DeepSeq import Data.Bits ((.|.), (.&.), xor, shiftL, shiftR, testBit, setBit) import Data.List (foldl') import qualified Data.ByteString as B @@ -81,7 +82,6 @@ import Data.Binary.Get (runGet, getWord16be, getByteString, bytesRead, lookAhead, skip, isEmpty) import Data.Binary.Put (runPut, putWord16be, putByteString, PutM) -import TorDNSEL.DeepSeq import TorDNSEL.Util -------------------------------------------------------------------------------- @@ -295,11 +295,11 @@ data Message = Message msgAdditional :: {-# UNPACK #-} ![ResourceRecord] } deriving (Eq, Show) -instance DeepSeq Message where - deepSeq (Message a b c d e f g h i j k l m n) = - deepSeq a . deepSeq b . deepSeq c . deepSeq d . deepSeq e . deepSeq f . - deepSeq g . deepSeq h . deepSeq i . deepSeq j . deepSeq k . deepSeq l . - deepSeq m $ deepSeq n +instance NFData Message where + rnf !msg = msgQuestion msg `deepseq` + msgAnswers msg `deepseq` + msgAuthority msg `deepseq` + msgAdditional msg `deepseq` () instance BinaryPacket Message where getPacket pkt = do @@ -365,8 +365,8 @@ data Question = Question qClass :: {-# UNPACK #-} !Class } deriving (Eq, Show) -instance DeepSeq Question where - deepSeq (Question a b c) = deepSeq a . deepSeq b $ deepSeq c +instance NFData Question where + rnf !q = rnf (qName q) instance BinaryPacket Question where getPacket pkt = liftM3 Question (getPacket pkt) get get @@ -436,6 +436,14 @@ data ResourceRecord rrData :: {-# UNPACK #-} !ByteString } deriving (Eq, Show) +instance NFData ResourceRecord where + rnf !rr = rrName rr `deepseq` + case rr of + A{} -> aAddr rr `deepseq` () + NS{} -> nsDName rr `deepseq` () + SOA{} -> soaMName rr `deepseq` soaRName rr `deepseq` () + _ -> () + instance BinaryPacket ResourceRecord where getPacket pkt = do name <- getPacket pkt @@ -493,21 +501,12 @@ instance BinaryPacket ResourceRecord where putByteString rData incrOffset (10 + B.length rData) -instance DeepSeq ResourceRecord where - deepSeq (A a b c) = deepSeq a . deepSeq b $ deepSeq c - deepSeq (NS a b c) = deepSeq a . deepSeq b $ deepSeq c - deepSeq (SOA a b c d e f g h i) = - deepSeq a . deepSeq b . deepSeq c . deepSeq d . deepSeq e . - deepSeq f . deepSeq g . deepSeq h $ deepSeq i - deepSeq (UnsupportedResourceRecord a b c d e) = - deepSeq a . deepSeq b . deepSeq c . deepSeq d $ deepSeq e - -- | A domain name. newtype DomainName = DomainName [Label] deriving (Eq, Show) -instance DeepSeq DomainName where - deepSeq (DomainName ls) = deepSeq ls +instance NFData DomainName where + rnf (DomainName ls) = rnf ls instance BinaryPacket DomainName where -- Read a DomainName as a sequence of 'Label's ending with either a null label @@ -545,6 +544,8 @@ instance BinaryPacket DomainName where newtype Label = Label { unLabel :: ByteString } deriving (Eq, Ord, Show) +instance NFData Label where + instance Binary Label where get = do len <- getWord8 @@ -554,9 +555,6 @@ instance Binary Label where putWord8 . fromIntegral . B.length $ label putByteString label -instance DeepSeq Label where - deepSeq (Label bs) = deepSeq bs - -- | A response code set by the name server. data RCode = NoError -- ^ No error condition. @@ -570,7 +568,7 @@ data RCode -- operation for policy reasons. deriving (Eq, Show) -instance DeepSeq RCode where deepSeq = seq +instance NFData RCode where -- | Specifies the kind of query in a message set by the originator. data OpCode @@ -579,7 +577,7 @@ data OpCode | ServerStatusRequest -- ^ A server status request. deriving (Eq, Show) -instance DeepSeq OpCode where deepSeq = seq +instance NFData OpCode where -- | The TYPE or QTYPE values that appear in resource records or questions, -- respectively. @@ -591,6 +589,8 @@ data Type | UnsupportedType {-# UNPACK #-} !Word16 -- ^ Any other type. deriving (Eq, Show) +instance NFData Type where + instance Binary Type where get = do t <- get @@ -607,13 +607,6 @@ instance Binary Type where put TAny = putWord16be 255 put (UnsupportedType t) = put t -instance DeepSeq Type where - deepSeq TA = id - deepSeq TNS = id - deepSeq TAny = id - deepSeq TSOA = id - deepSeq (UnsupportedType t) = deepSeq t - -- | The CLASS or QCLASS values that appear in resource records or questions, -- respectively. data Class @@ -622,6 +615,8 @@ data Class deriving (Eq, Show) -- XXX support * +instance NFData Class where + instance Binary Class where get = do c <- get @@ -631,7 +626,3 @@ instance Binary Class where put IN = putWord16be 1 put (UnsupportedClass c) = put c - -instance DeepSeq Class where - deepSeq IN = id - deepSeq (UnsupportedClass c) = deepSeq c diff --git a/src/TorDNSEL/DeepSeq.hs b/src/TorDNSEL/DeepSeq.hs deleted file mode 100644 index 8e28314..0000000 --- a/src/TorDNSEL/DeepSeq.hs +++ /dev/null @@ -1,39 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : TorDNSEL.DeepSeq --- License : Public domain (see LICENSE) --- --- Maintainer : tup.tuple@googlemail.com --- Stability : alpha --- Portability : portable --- --- Deep strict evaluation. --- ------------------------------------------------------------------------------ - -module TorDNSEL.DeepSeq ( - DeepSeq(..) - , ($!!) - ) where - -import Data.ByteString (ByteString) -import Data.List (foldl') -import Data.Word (Word16, Word32) - --- | Deep strict evaluation. This is mainly used here to force any exceptional --- values contained in a data structure to show themselves. -class DeepSeq a where - deepSeq :: a -> b -> b - -infixr 0 `deepSeq`, $!! - -instance DeepSeq Bool where deepSeq = seq -instance DeepSeq Word16 where deepSeq = seq -instance DeepSeq Word32 where deepSeq = seq -instance DeepSeq ByteString where deepSeq = seq -instance DeepSeq a => DeepSeq [a] where - deepSeq = flip . foldl' . flip $ deepSeq - --- | Strict application, defined in terms of 'deepSeq'. -($!!) :: DeepSeq a => (a -> b) -> a -> b -f $!! x = x `deepSeq` f x diff --git a/src/TorDNSEL/Socks/Internals.hs b/src/TorDNSEL/Socks/Internals.hs index e556bf9..d6c91f7 100644 --- a/src/TorDNSEL/Socks/Internals.hs +++ b/src/TorDNSEL/Socks/Internals.hs @@ -49,11 +49,12 @@ import Data.Typeable (Typeable) import Network.Socket (HostAddress) import System.IO (Handle, BufferMode(NoBuffering), hClose, hSetBuffering) +import Control.DeepSeq + import Data.Binary (Binary(..), getWord8, putWord8) import Data.Binary.Get (runGet) import Data.Binary.Put (runPut, putWord32be, putByteString) -import TorDNSEL.DeepSeq import TorDNSEL.Util -------------------------------------------------------------------------------- @@ -97,8 +98,7 @@ data Response = Response , soRespPort :: {-# UNPACK #-} !Port -- ^ The destination port. } -instance DeepSeq Response where - deepSeq (Response a b c) = deepSeq a . deepSeq b $ deepSeq c +instance NFData Response where -- | A Socks4 result code. data Result @@ -118,8 +118,6 @@ instance Show Result where show IdentdMismatch = "Request rejected because the client program and \ \identd report different user-ids" -instance DeepSeq Result where deepSeq = seq - -------------------------------------------------------------------------------- -- Serialization diff --git a/src/TorDNSEL/Util.hsc b/src/TorDNSEL/Util.hsc index a2357d8..76c6525 100644 --- a/src/TorDNSEL/Util.hsc +++ b/src/TorDNSEL/Util.hsc @@ -132,22 +132,13 @@ import Network.Socket import System.Directory (doesFileExist, removeFile) import System.Environment (getProgName) import System.Exit (exitWith, ExitCode) -import System.IO (hPutStr) +import System.IO (Handle, hPutStr) import System.IO.Error (isEOFError) import System.Posix.Files (setFileMode) import System.Posix.Types (FileMode) import Text.Printf (printf) - -import GHC.Handle - (wantReadableHandle, fillReadBuffer, readCharFromBuffer, ioe_EOF) -import GHC.IOBase - ( Handle, Handle__(..), Buffer(..), readIORef, writeIORef - , BufferMode(NoBuffering) ) - import Data.Binary (Binary(..)) -import TorDNSEL.DeepSeq - #include <netinet/in.h> -------------------------------------------------------------------------------- @@ -613,9 +604,6 @@ instance Binary Port where get = Port `fmap` get put = put . unPort -instance DeepSeq Port where - deepSeq = seq . unPort - -- | Parse a port, returning the result or 'throwError' in the monad if parsing -- fails. parsePort :: MonadError ShowS m => ByteString -> m Port diff --git a/tordnsel.cabal b/tordnsel.cabal index c27fa2b..23fa628 100644 --- a/tordnsel.cabal +++ b/tordnsel.cabal @@ -13,7 +13,7 @@ Maintainer: tup.tuple@googlemail.com, lunar@debian.org, andrew@torproject.o Build-Type: Simple Build-Depends: base>=2.0, network>=2.0, mtl>=1.0, unix>=1.0, stm>=2.0, time>=1.0, HUnit>=1.1, binary>=0.4, bytestring>=0.9, array>=0.1, directory>=1.0, - containers>=0.1 + containers>=0.1, deepseq >= 1.3 Tested-With: GHC==6.6, GHC==6.8, GHC==6.10, GHC==6.12 Data-Files: config/tordnsel.conf.sample, contrib/cacti-input.pl, contrib/tordnsel-init.d-script.sample, doc/tordnsel.8 @@ -25,7 +25,6 @@ Other-Modules: TorDNSEL.Config, TorDNSEL.Control.Concurrent.Link, TorDNSEL.Control.Concurrent.Link.Internals, TorDNSEL.Control.Concurrent.Util, - TorDNSEL.DeepSeq, TorDNSEL.Directory, TorDNSEL.Directory.Internals, TorDNSEL.DistinctQueue,