X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=haskell-dns.git;a=blobdiff_plain;f=Network%2FSocket%2FIsString.hs;fp=Network%2FSocket%2FIsString.hs;h=6ea9f8caa0aeec95e0324100d6f02270acf187a3;hp=0000000000000000000000000000000000000000;hb=845dca95afa7e073e62520ef3c4840b3b078bdad;hpb=826401d22c87d6c5d77ad4f427d28d6b97a9d12f

diff --git a/Network/Socket/IsString.hs b/Network/Socket/IsString.hs
new file mode 100644
index 0000000..6ea9f8c
--- /dev/null
+++ b/Network/Socket/IsString.hs
@@ -0,0 +1,37 @@
+module Network.Socket.IsString () where
+
+import Data.String
+import Network.Socket
+import System.IO.Unsafe
+
+instance IsString HostAddress where
+    fromString str
+        = let hint = defaultHints {
+                                addrFlags  = [AI_NUMERICHOST]
+                              , addrFamily = AF_INET
+                              }
+              ret  = unsafePerformIO $
+                     getAddrInfo (Just hint) (Just str) Nothing
+          in
+            case ret of
+              []     -> error (str ++ " seems not to be a valid IPv4 address")
+              (x:xs) -> case addrAddress x of
+                          SockAddrInet _ addr
+                              -> addr
+                          _   -> error ("getAddrInfo (" ++ str ++ ") returned a strange result: " ++ show (x:xs))
+
+instance IsString HostAddress6 where
+    fromString str
+        = let hint = defaultHints {
+                                 addrFlags  = [AI_NUMERICHOST]
+                               , addrFamily = AF_INET6
+                               }
+              ret  = unsafePerformIO $
+                     getAddrInfo (Just hint) (Just str) Nothing
+          in
+            case ret of
+              []     -> error (str ++ " seems not to be a valid IPv6 address")
+              (x:xs) -> case addrAddress x of
+                          SockAddrInet6 _ _ addr _
+                              -> addr
+                          _   -> error ("getAddrInfo (" ++ str ++ ") returned a strange result: " ++ show (x:xs))