[tor-commits] [tordnsel/master] remove internal Control.DeepSeq
arlo at torproject.org
arlo at torproject.org
Fri Mar 4 19:38:13 UTC 2016
commit d210b013e36b46d1c16927aa22e45c7fe05bd7f5
Author: David Kaloper <david at 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 at 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 at googlemail.com, lunar at debian.org, andrew at 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,
More information about the tor-commits
mailing list