FIX: short-circuit for unsupported patterns

Promotes UnsupportedSocketType pattern to first element of
pairlist to prevent patterns whose CPP macros are undefined
from greedily displaying when calling show for -1 value

Adds UnsupportedCmsgId pattern to Network.Socket.*.Cmsg
and ensured proper short-circuiting

Reimplements read/show used in Network.Socket.Posix.Cmsg
in Network.Socket.Win32.Cmsg, omitting POSIX-exclusive CmsgIdFd pattern

Removes POSIX-exclusive CmsgIdFd from Network.Socket export list
Adds UnsupportedCmsgId pattern to Network.Socket export list

Author: archaephyrryx

Network/Socket.hs

@@ -244,7 +244,7 @@ module Network.Socket
             ,CmsgIdIPv6TClass
             ,CmsgIdIPv4PktInfo
             ,CmsgIdIPv6PktInfo
-            ,CmsgIdFd)
+            ,UnsupportedCmsgId)
     -- ** APIs for control message
     , lookupCmsg
     , filterCmsg

Network/Socket/Options.hsc

@@ -388,7 +388,8 @@ getSockOpt s (SockOpt level opt) = do
 
 socketOptionPairs :: [Pair SocketOption String]
 socketOptionPairs =
-    [ (Debug, "Debug")
+    [ (SockOpt -1 -1, "Unsupported")
+    , (Debug, "Debug")
     , (ReuseAddr, "ReuseAddr")
     , (SoDomain, "SoDomain")
     , (Type, "Type")

Network/Socket/Posix/Cmsg.hsc

@@ -38,6 +38,10 @@ data CmsgId = CmsgId {
   , cmsgType  :: !CInt
   } deriving (Eq)
 
+-- | Unsupported identifier
+pattern UnsupportedCmsgId :: CmsgId
+pattern UnsupportedCmsgId = CmsgId (-1) (-1)
+
 -- | The identifier for 'IPv4TTL'.
 pattern CmsgIdIPv4TTL :: CmsgId
 #if defined(darwin_HOST_OS) || defined(freebsd_HOST_OS)
@@ -227,7 +231,8 @@ instance ControlMessage Fd where
 
 cmsgIdPairs :: [Pair CmsgId String]
 cmsgIdPairs =
-    [ (CmsgIdIPv4TTL, "CmsgIdIPv4TTL")
+    [ (UnsupportedCmsgId, "Unsupported")
+    , (CmsgIdIPv4TTL, "CmsgIdIPv4TTL")
     , (CmsgIdIPv6HopLimit, "CmsgIdIPv6HopLimit")
     , (CmsgIdIPv4TOS, "CmsgIdIPv4TOS")
     , (CmsgIdIPv6TClass, "CmsgIdIPv6TClass")
@@ -240,7 +245,7 @@ cmsgIdBijection :: Bijection CmsgId String
 cmsgIdBijection = Bijection{..}
     where
         defname = "CmsgId"
-        defFwd = \(CmsgId l t) -> defname++show l++"_" ++show t
+        defFwd = \(CmsgId l t) -> defname++show l++"_"++show t
         defBwd s =
             case splitAt (length defname) s of
                 ("CmsgId", nm) -> uncurry CmsgId $ _parse nm

Network/Socket/Types.hsc

@@ -1318,13 +1318,13 @@ instance Storable In6Addr where
 
 socktypePairs :: [Pair SocketType String]
 socktypePairs =
-    [ (Stream, "Stream")
+    [ (UnsupportedSocketType, "Unsupported")
+    , (Stream, "Stream")
     , (Datagram, "Datagram") 
     , (Raw, "Raw")
     , (RDM, "RDM")
     , (SeqPacket, "SeqPacket")
     , (NoSocketType, "NoSocketType")
-    , (UnsupportedSocketType, "Unsupported")
     ]
 
 socktypeBijection :: Bijection SocketType String

Network/Socket/Win32/Cmsg.hsc

@@ -16,6 +16,9 @@ import System.IO.Unsafe (unsafeDupablePerformIO)
 
 import Network.Socket.Imports
 import Network.Socket.Types
+import Network.Socket.ReadShow
+
+import qualified Text.Read as P
 
 type DWORD = Word32
 type ULONG = Word32
@@ -32,7 +35,11 @@ data Cmsg = Cmsg {
 data CmsgId = CmsgId {
     cmsgLevel :: !CInt
   , cmsgType  :: !CInt
-  } deriving (Eq, Show)
+  } deriving (Eq)
+
+-- | Unsupported identifier
+pattern UnsupportedCmsgId :: CmsgId
+pattern UnsupportedCmsgId = CmsgId (-1) (-1)
 
 -- | The identifier for 'IPv4TTL'.
 pattern CmsgIdIPv4TTL :: CmsgId
@@ -178,3 +185,31 @@ instance Storable IPv6PktInfo where
         In6Addr ha6 <- (#peek IN6_PKTINFO, ipi6_addr)    p
         n :: ULONG  <- (#peek IN6_PKTINFO, ipi6_ifindex) p
         return $ IPv6PktInfo (fromIntegral n) ha6
+
+cmsgIdPairs :: [Pair CmsgId String]
+cmsgIdPairs =
+    [ (UnsupportedCmsgId, "Unsupported")
+    , (CmsgIdIPv4TTL, "CmsgIdIPv4TTL")
+    , (CmsgIdIPv6HopLimit, "CmsgIdIPv6HopLimit")
+    , (CmsgIdIPv4TOS, "CmsgIdIPv4TOS")
+    , (CmsgIdIPv6TClass, "CmsgIdIPv6TClass")
+    , (CmsgIdIPv4PktInfo, "CmsgIdIPv4PktInfo")
+    , (CmsgIdIPv6PktInfo, "CmsgIdIPv6PktInfo")
+    ]
+
+cmsgIdBijection :: Bijection CmsgId String
+cmsgIdBijection = Bijection{..}
+    where
+        defname = "CmsgId"
+        defFwd = \(CmsgId l t) -> defname++show l++"_"++show t
+        defBwd s =
+            case splitAt (length defname) s of
+                ("CmsgId", nm) -> uncurry CmsgId $ _parse nm
+                _ -> error "cmsgIdBijection: exception in WIP ReadShow code"
+        pairs = cmsgIdPairs
+
+instance Show CmsgId where
+    show = forward cmsgIdBijection
+
+instance Read CmsgId where
+    readPrec = P.lexP >>= \(P.Ident x) -> return $ backward cmsgIdBijection x