Merge PR #459

Author: kazu-yamamoto

Network/Socket.hs

@@ -134,9 +134,9 @@ module Network.Socket
 
     -- * Socket options
     , SocketOption(SockOpt
-                  ,Debug,ReuseAddr,Type,SoError,DontRoute,Broadcast
-                  ,SendBuffer,RecvBuffer,KeepAlive,OOBInline,TimeToLive
-                  ,MaxSegment,NoDelay,Cork,Linger,ReusePort
+                  ,Debug,ReuseAddr,SoDomain,Type,SoProtocol,SoError,DontRoute
+                  ,Broadcast,SendBuffer,RecvBuffer,KeepAlive,OOBInline
+                  ,TimeToLive,MaxSegment,NoDelay,Cork,Linger,ReusePort
                   ,RecvLowWater,SendLowWater,RecvTimeOut,SendTimeOut
                   ,UseLoopBack,UserTimeout,IPv6Only
                   ,RecvIPv4TTL,RecvIPv4TOS,RecvIPv4PktInfo
@@ -160,11 +160,22 @@ module Network.Socket
     , mkSocket
     , socketToHandle
     -- ** Types of Socket
-    , SocketType(..)
+    , SocketType(GeneralSocketType, UnsupportedSocketType, NoSocketType
+                , Stream, Datagram, Raw, RDM, SeqPacket)
     , isSupportedSocketType
     , getSocketType
     -- ** Family
-    , Family(..)
+    , Family(GeneralFamily, UnsupportedFamily
+            ,AF_UNSPEC,AF_UNIX,AF_INET,AF_INET6,AF_IMPLINK,AF_PUP,AF_CHAOS
+            ,AF_NS,AF_NBS,AF_ECMA,AF_DATAKIT,AF_CCITT,AF_SNA,AF_DECnet
+            ,AF_DLI,AF_LAT,AF_HYLINK,AF_APPLETALK,AF_ROUTE,AF_NETBIOS
+            ,AF_NIT,AF_802,AF_ISO,AF_OSI,AF_NETMAN,AF_X25,AF_AX25,AF_OSINET
+            ,AF_GOSSIP,AF_IPX,Pseudo_AF_XTP,AF_CTF,AF_WAN,AF_SDL,AF_NETWARE
+            ,AF_NDD,AF_INTF,AF_COIP,AF_CNT,Pseudo_AF_RTIP,Pseudo_AF_PIP
+            ,AF_SIP,AF_ISDN,Pseudo_AF_KEY,AF_NATM,AF_ARP,Pseudo_AF_HDRCMPLT
+            ,AF_ENCAP,AF_LINK,AF_RAW,AF_RIF,AF_NETROM,AF_BRIDGE,AF_ATMPVC
+            ,AF_ROSE,AF_NETBEUI,AF_SECURITY,AF_PACKET,AF_ASH,AF_ECONET
+            ,AF_ATMSVC,AF_IRDA,AF_PPPOX,AF_WANPIPE,AF_BLUETOOTH,AF_CAN)
     , isSupportedFamily
     , packFamily
     , unpackFamily

Network/Socket/Imports.hs

@@ -7,7 +7,6 @@ module Network.Socket.Imports (
   , module Data.Maybe
   , module Data.Monoid
   , module Data.Ord
-  , module Data.Typeable
   , module Data.Word
   , module Foreign.C.String
   , module Foreign.C.Types
@@ -24,7 +23,6 @@ import Data.List
 import Data.Maybe
 import Data.Monoid
 import Data.Ord
-import Data.Typeable
 import Data.Word
 import Foreign.C.String
 import Foreign.C.Types

Network/Socket/Info.hsc

@@ -1,5 +1,4 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
@@ -63,7 +62,7 @@ data AddrInfoFlag =
     --   addresses are found, IPv6-mapped IPv4 addresses will be
     --   returned. (Only some platforms support this.)
     | AI_V4MAPPED
-    deriving (Eq, Read, Show, Typeable)
+    deriving (Eq, Read, Show)
 
 aiFlagMapping :: [(AddrInfoFlag, CInt)]
 
@@ -106,7 +105,7 @@ data AddrInfo = AddrInfo {
   , addrProtocol :: ProtocolNumber
   , addrAddress :: SockAddr
   , addrCanonName :: Maybe String
-  } deriving (Eq, Show, Typeable)
+  } deriving (Eq, Show)
 
 instance Storable AddrInfo where
     sizeOf    _ = #const sizeof(struct addrinfo)
@@ -124,18 +123,17 @@ instance Storable AddrInfo where
                         then return Nothing
                         else Just <$> peekCString ai_canonname_ptr
 
-        socktype <- unpackSocketType' "AddrInfo.peek" ai_socktype
         return $ AddrInfo {
             addrFlags = unpackBits aiFlagMapping ai_flags
           , addrFamily = unpackFamily ai_family
-          , addrSocketType = socktype
+          , addrSocketType = unpackSocketType ai_socktype
           , addrProtocol = ai_protocol
           , addrAddress = ai_addr
           , addrCanonName = ai_canonname
           }
 
     poke p (AddrInfo flags family sockType protocol _ _) = do
-        c_stype <- packSocketTypeOrThrow "AddrInfo.poke" sockType
+        let c_stype = packSocketType sockType
 
         (#poke struct addrinfo, ai_flags) p (packBits aiFlagMapping flags)
         (#poke struct addrinfo, ai_family) p (packFamily family)
@@ -171,7 +169,7 @@ data NameInfoFlag =
     --   looked up.  Instead, a numeric representation of the
     --   service is returned.
     | NI_NUMERICSERV
-    deriving (Eq, Read, Show, Typeable)
+    deriving (Eq, Read, Show)
 
 niFlagMapping :: [(NameInfoFlag, CInt)]
 

Network/Socket/Options.hsc

@@ -1,5 +1,4 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ViewPatterns #-}
@@ -9,8 +8,8 @@
 
 module Network.Socket.Options (
     SocketOption(SockOpt
-                ,Debug,ReuseAddr,Type,SoError,DontRoute,Broadcast
-                ,SendBuffer,RecvBuffer,KeepAlive,OOBInline,TimeToLive
+                ,Debug,ReuseAddr,SoDomain,Type,SoProtocol,SoError,DontRoute
+                ,Broadcast,SendBuffer,RecvBuffer,KeepAlive,OOBInline,TimeToLive
                 ,MaxSegment,NoDelay,Cork,Linger,ReusePort
                 ,RecvLowWater,SendLowWater,RecvTimeOut,SendTimeOut
                 ,UseLoopBack,UserTimeout,IPv6Only
@@ -53,8 +52,7 @@ isSupportedSocketOption opt = opt /= SockOpt (-1) (-1)
 --
 --   Since: 3.0.1.0
 getSocketType :: Socket -> IO SocketType
-getSocketType s = (fromMaybe NoSocketType . unpackSocketType . fromIntegral)
-                    <$> getSocketOption s Type
+getSocketType s = unpackSocketType <$> getSockOpt s Type
 
 #ifdef SOL_SOCKET
 -- | SO_DEBUG
@@ -71,13 +69,31 @@ pattern ReuseAddr      = SockOpt (#const SOL_SOCKET) (#const SO_REUSEADDR)
 #else
 pattern ReuseAddr      = SockOpt (-1) (-1)
 #endif
--- | SO_TYPE
+
+-- | SO_DOMAIN, read-only
+pattern SoDomain :: SocketOption
+#ifdef SO_DOMAIN
+pattern SoDomain       = SockOpt (#const SOL_SOCKET) (#const SO_DOMAIN)
+#else
+pattern SoDomain       = SockOpt (-1) (-1)
+#endif
+
+-- | SO_TYPE, read-only
 pattern Type :: SocketOption
 #ifdef SO_TYPE
 pattern Type           = SockOpt (#const SOL_SOCKET) (#const SO_TYPE)
 #else
 pattern Type           = SockOpt (-1) (-1)
 #endif
+
+-- | SO_PROTOCOL, read-only
+pattern SoProtocol :: SocketOption
+#ifdef SO_PROTOCOL
+pattern SoProtocol     = SockOpt (#const SOL_SOCKET) (#const SO_PROTOCOL)
+#else
+pattern SoProtocol     = SockOpt (-1) (-1)
+#endif
+
 -- | SO_ERROR
 pattern SoError :: SocketOption
 #ifdef SO_ERROR

Network/Socket/Shutdown.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
 
 #include "HsNetDef.h"
 
@@ -27,7 +26,6 @@ import Network.Socket.Types
 data ShutdownCmd = ShutdownReceive
                  | ShutdownSend
                  | ShutdownBoth
-                 deriving Typeable
 
 sdownCmdToInt :: ShutdownCmd -> CInt
 sdownCmdToInt ShutdownReceive = 0

Network/Socket/Syscall.hs

@@ -84,7 +84,7 @@ socket family stype protocol = E.bracketOnError create c_close $ \fd -> do
     return s
   where
     create = do
-        c_stype <- modifyFlag <$> packSocketTypeOrThrow "socket" stype
+        let c_stype = modifyFlag $ packSocketType stype
         throwSocketErrorIfMinus1Retry "Network.Socket.socket" $
             c_socket (packFamily family) c_stype protocol