diff --git a/network-ip.cabal b/network-ip.cabal --- a/network-ip.cabal +++ b/network-ip.cabal @@ -1,5 +1,5 @@ Name: network-ip -Version: 0.0.1 +Version: 0.1 Category: Network Stability: experimental Synopsis: Internet Protocol data structures diff --git a/src/Network/IP/Addr.hs b/src/Network/IP/Addr.hs --- a/src/Network/IP/Addr.hs +++ b/src/Network/IP/Addr.hs @@ -112,6 +112,15 @@ . showsPrec 11 o4 where (o1, o2, o3, o4) = ip4ToOctets a +instance Read IP4 where + readsPrec p = readParen (p > 10) $ \i → + [ (ip4FromOctets o1 o2 o3 o4, i4) + | ("ip4FromOctets", i') ← lex i + , (o1, i1) ← readsPrec 11 i' + , (o2, i2) ← readsPrec 11 i1 + , (o3, i3) ← readsPrec 11 i2 + , (o4, i4) ← readsPrec 11 i3 ] + instance Printable IP4 where print = P.fsep (P.char7 '.') . (P.nonNegative Decimal <$>) . ip4ToOctetList {-# INLINE print #-} @@ -191,6 +200,19 @@ where (w1, w2, w3, w4, w5, w6, w7, w8) = ip6ToWords a +instance Read IP6 where + readsPrec p = readParen (p > 10) $ \i → + [ (ip6FromWords w1 w2 w3 w4 w5 w6 w7 w8, i8) + | ("ip6FromWords", i') ← lex i + , (w1, i1) ← readsPrec 11 i' + , (w2, i2) ← readsPrec 11 i1 + , (w3, i3) ← readsPrec 11 i2 + , (w4, i4) ← readsPrec 11 i3 + , (w5, i5) ← readsPrec 11 i4 + , (w6, i6) ← readsPrec 11 i5 + , (w7, i7) ← readsPrec 11 i6 + , (w8, i8) ← readsPrec 11 i7 ] + instance Printable IP6 where print addr = case addrZeroes of Nothing → P.fsep (P.char7 ':') $ hex <$> addrWords @@ -341,7 +363,7 @@ -- IP address. data IP = IPv4 {-# UNPACK #-} !IP4 | IPv6 {-# UNPACK #-} !IP6 - deriving (Typeable, Eq, Ord, Show) + deriving (Typeable, Eq, Ord, Show, Read) -- | 'IP' proxy value. anIP ∷ Proxy IP @@ -419,15 +441,36 @@ . showString " " . showsPrec 11 w +instance Read Net4Addr where + readsPrec p = readParen (p > 10) $ \i → + [ (netAddr a w, i2) + | ("netAddr", i') ← lex i + , (a, i1) ← readsPrec 11 i' + , (w, i2) ← readsPrec 11 i1 ] + +instance Read Net6Addr where + readsPrec p = readParen (p > 10) $ \i → + [ (netAddr a w, i2) + | ("netAddr", i') ← lex i + , (a, i1) ← readsPrec 11 i' + , (w, i2) ← readsPrec 11 i1 ] + +instance Read (NetAddr IP) where + readsPrec p = readParen (p > 10) $ \i → + [ (netAddr a w, i2) + | ("netAddr", i') ← lex i + , (a, i1) ← readsPrec 11 i' + , (w, i2) ← readsPrec 11 i1 ] + instance Printable a ⇒ Printable (NetAddr a) where print (NetAddr a m) = print a <> P.char7 '/' <> print m {-# INLINE print #-} -instance Textual (NetAddr IP4) where +instance Textual Net4Addr where textual = net4Parser {-# INLINE textual #-} -instance Textual (NetAddr IP6) where +instance Textual Net6Addr where textual = net6Parser {-# INLINE textual #-} @@ -574,9 +617,13 @@ anInetPort = Proxy instance Show InetPort where - show (InetPort p) = show p + showsPrec p (InetPort w) = showsPrec p w {-# INLINE show #-} +instance Read InetPort where + readsPrec p = fmap (\(w, s) → (InetPort w, s)) . readsPrec p + {-# INLINE readsPrec #-} + instance Textual InetPort where textual = InetPort <$> nncBounded Decimal "port number" @@ -589,7 +636,7 @@ -- | Socket address: host address + port number. data InetAddr a = InetAddr { inetHost ∷ a , inetPort ∷ {-# UNPACK #-} !InetPort - } deriving (Eq, Ord, Show) + } deriving (Eq, Ord, Show, Read) deriving instance Typeable1 InetAddr diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -54,7 +54,9 @@ main = defaultMain [ testGroup "IP4" - [ testProperty "print -> parse" $ \a → + [ testProperty "show -> read" $ \a → + read (show a) == (a ∷ IP4) + , testProperty "print -> parse" $ \a → fromString (toString a) == Just (a ∷ IP4) , testProperty "parsing \"1.2.3.4\"" $ fromString "1.2.3.4" == Just (IP4 0x01020304) @@ -80,7 +82,9 @@ fromStringAs anIP4 "1a.2.3.4" == Nothing ] , testGroup "IP6" - [ testProperty "print -> parse" $ \a → + [ testProperty "show -> read" $ \a → + read (show a) == (a ∷ IP6) + , testProperty "print -> parse" $ \a → fromString (toString a) == Just (a ∷ IP6) , testProperty "parsing \"::\"" $ fromString "::" == Just anyIP6 @@ -131,11 +135,15 @@ fromStringAs anIP6 "1:2:3:4:5:6:7:8g" == Nothing ] , testGroup "IP" - [ testProperty "print -> parse" $ \a → + [ testProperty "show -> read" $ \a → + read (show a) == (a ∷ IP) + , testProperty "print -> parse" $ \a → fromString (toString a) == Just (a ∷ IP) ] , testGroup "Net4Addr" - [ testProperty "print -> parse" $ \n → + [ testProperty "show -> read" $ \n → + read (show n) == (n ∷ Net4Addr) + , testProperty "print -> parse" $ \n → fromString (toString n) == Just (n ∷ Net4Addr) , testProperty "parsing \"11.22.33.44/14\"" $ case fromStringAs aNet4Addr "11.22.33.44/14" of @@ -162,7 +170,9 @@ fromStringAs aNet4Addr "1.2.3.4/012" == Nothing ] , testGroup "Net6Addr" - [ testProperty "print -> parse" $ \n → + [ testProperty "show -> read" $ \n → + read (show n) == (n ∷ Net6Addr) + , testProperty "print -> parse" $ \n → fromString (toString n) == Just (n ∷ Net6Addr) , testProperty "parsing \"1234:5678:9abc:def::/22\"" $ case fromStringAs aNet6Addr "1234:5678:9abc:def::/22" of @@ -189,11 +199,15 @@ fromStringAs aNet6Addr "::/01" == Nothing ] , testGroup "NetAddr" - [ testProperty "print -> parse" $ \n → + [ testProperty "show -> read" $ \n → + read (show n) == (n ∷ NetAddr IP) + , testProperty "print -> parse" $ \n → fromString (toString n) == Just (n ∷ NetAddr IP) ] , testGroup "InetPort" - [ testProperty "print -> parse" $ \p → + [ testProperty "show -> read" $ \p → + read (show p) == (p ∷ InetPort) + , testProperty "print -> parse" $ \p → fromString (toString p) == Just (p ∷ InetPort) , testProperty "parsing \"01\" fails" $ fromStringAs anInetPort "01" == Nothing @@ -203,7 +217,9 @@ fromStringAs anInetPort "65536" == Nothing ] , testGroup "Inet4Addr" - [ testProperty "print -> parse" $ \a → + [ testProperty "show -> read" $ \a → + read (show a) == (a ∷ Inet4Addr) + , testProperty "print -> parse" $ \a → fromString (toString a) == Just (a ∷ Inet4Addr) , testProperty "parsing \"11.22.33.44:55\"" $ case fromString "11.22.33.44:55" of @@ -211,7 +227,9 @@ _ → False ] , testGroup "Inet6Addr" - [ testProperty "print -> parse" $ \a → + [ testProperty "show -> read" $ \a → + read (show a) == (a ∷ Inet6Addr) + , testProperty "print -> parse" $ \a → fromString (toString a) == Just (a ∷ Inet6Addr) , testProperty "parsing \"[1234:5678:9abc:def::]:55\"" $ case fromString "[1234:5678:9abc:def::]:55" of @@ -219,7 +237,9 @@ _ → False ] , testGroup "InetAddr" - [ testProperty "print -> parse" $ \a → + [ testProperty "show -> read" $ \a → + read (show a) == (a ∷ InetAddr IP) + , testProperty "print -> parse" $ \a → fromString (toString a) == Just (a ∷ InetAddr IP) ] ]