packages feed

network 2.2.1.10 → 2.2.3

raw patch · 18 files changed

+2259/−66 lines, 18 filesdep +bytestringdep +unixsetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: bytestring, unix

API changes (from Hackage documentation)

+ Network.Socket.ByteString: recv :: Socket -> Int -> IO ByteString
+ Network.Socket.ByteString: recvFrom :: Socket -> Int -> IO (ByteString, SockAddr)
+ Network.Socket.ByteString: send :: Socket -> ByteString -> IO Int
+ Network.Socket.ByteString: sendAll :: Socket -> ByteString -> IO ()
+ Network.Socket.ByteString: sendAllTo :: Socket -> ByteString -> SockAddr -> IO ()
+ Network.Socket.ByteString: sendMany :: Socket -> [ByteString] -> IO ()
+ Network.Socket.ByteString: sendManyTo :: Socket -> [ByteString] -> SockAddr -> IO ()
+ Network.Socket.ByteString: sendTo :: Socket -> ByteString -> SockAddr -> IO Int
+ Network.Socket.ByteString.Lazy: getContents :: Socket -> IO ByteString
+ Network.Socket.ByteString.Lazy: recv :: Socket -> Int64 -> IO ByteString
+ Network.Socket.ByteString.Lazy: send :: Socket -> ByteString -> IO Int64
+ Network.Socket.ByteString.Lazy: sendAll :: Socket -> ByteString -> IO ()
- Network.Socket: throwSocketErrorIfMinus1_ :: Num a => String -> IO a -> IO ()
+ Network.Socket: throwSocketErrorIfMinus1_ :: (Num a) => String -> IO a -> IO ()
- Network.Socket.Internal: throwSocketErrorIfMinus1Retry :: Num a => String -> IO a -> IO a
+ Network.Socket.Internal: throwSocketErrorIfMinus1Retry :: (Num a) => String -> IO a -> IO a
- Network.Socket.Internal: throwSocketErrorIfMinus1RetryMayBlock :: Num a => String -> IO b -> IO a -> IO a
+ Network.Socket.Internal: throwSocketErrorIfMinus1RetryMayBlock :: (Num a) => String -> IO b -> IO a -> IO a
- Network.Socket.Internal: throwSocketErrorIfMinus1_ :: Num a => String -> IO a -> IO ()
+ Network.Socket.Internal: throwSocketErrorIfMinus1_ :: (Num a) => String -> IO a -> IO ()

Files

LICENSE view
@@ -1,21 +1,19 @@-The Glasgow Haskell Compiler License--Copyright 2002, The University Court of the University of Glasgow. -All rights reserved.+Copyright (c) 2002-2010, The University Court of the University of Glasgow.+Copyright (c) 2007-2010, Johan Tibell  Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:  - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.- + - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.- + - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without-specific prior written permission. +specific prior written permission.  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
Network/Socket.hsc view
@@ -24,26 +24,9 @@ -- NOTE: ##, we want this interpreted when compiling the .hs, not by hsc2hs. ##include "Typeable.h" -#if defined(HAVE_WINSOCK_H) && !defined(cygwin32_HOST_OS)-#define WITH_WINSOCK  1-#endif--#if !defined(mingw32_HOST_OS) && !defined(_WIN32)-#define DOMAIN_SOCKET_SUPPORT 1-#endif--#if !defined(CALLCONV)-#ifdef WITH_WINSOCK-#define CALLCONV stdcall-#else-#define CALLCONV ccall-#endif-#endif- -- In order to process this file, you need to have CALLCONV defined.  module Network.Socket (-     -- * Types     Socket(..),		-- instance Eq, Show     Family(..),		@@ -104,6 +87,8 @@      socketToHandle,	-- :: Socket -> IOMode -> IO Handle +    -- ** Sending and receiving data+    -- $sendrecv     sendTo,		-- :: Socket -> String -> SockAddr -> IO Int     sendBufTo,          -- :: Socket -> Ptr a -> Int -> SockAddr -> IO Int @@ -640,6 +625,17 @@ foreign import ccall unsafe "free"   c_free:: Ptr a -> IO () #endif++-----------------------------------------------------------------------------+-- ** Sending and reciving data++-- $sendrecv+--+-- Do not use the @send@ and @recv@ functions defined in this module+-- in new code, as they incorrectly represent binary data as a Unicode+-- string.  As a result, these functions are inefficient and may lead+-- to bugs in the program.  Instead use the @send@ and @recv@+-- functions defined in the 'Network.Socket.ByteString' module.  ----------------------------------------------------------------------------- -- sendTo & recvFrom
+ Network/Socket/ByteString.hsc view
@@ -0,0 +1,373 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}++#include "HsNet.h"++-- |+-- Module      : Network.Socket.ByteString+-- Copyright   : (c) Johan Tibell 2007-2010+-- License     : BSD-style+--+-- Maintainer  : johan.tibell@gmail.com+-- Stability   : stable+-- Portability : portable+--+-- This module provides access to the BSD /socket/ interface.  This+-- module is generally more efficient than the 'String' based network+-- functions in 'Network.Socket'.  For detailed documentation, consult+-- your favorite POSIX socket reference. All functions communicate+-- failures by converting the error number to 'System.IO.IOError'.+--+-- This module is made to be imported with 'Network.Socket' like so:+--+-- > import Network.Socket hiding (send, sendTo, recv, recvFrom)+-- > import Network.Socket.ByteString+--+module Network.Socket.ByteString+  ( -- * Send data to a socket+    send+  , sendAll+  , sendTo+  , sendAllTo++    -- ** Vectored I/O+    -- $vectored+  , sendMany+  , sendManyTo++    -- * Receive data from a socket+  , recv+  , recvFrom++    -- * Example+    -- $example+  ) where++import Control.Monad (liftM, when)+import Data.ByteString (ByteString)+import Data.ByteString.Internal (createAndTrim)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.Word (Word8)+import Foreign.C.Types (CInt)+import Foreign.Marshal.Alloc (allocaBytes)+import Foreign.Ptr (Ptr, castPtr)+import Network.Socket (SockAddr, Socket(..), sendBufTo, recvBufFrom)++import qualified Data.ByteString as B++import Network.Socket.ByteString.Internal++#if !defined(mingw32_HOST_OS)+import Control.Monad (zipWithM_)+import Foreign.C.Types (CChar, CSize)+import Foreign.Marshal.Array (allocaArray)+import Foreign.Marshal.Utils (with)+import Foreign.Ptr (plusPtr)+import Foreign.Storable (Storable(..))+import Network.Socket.Internal (throwSocketErrorIfMinus1RetryMayBlock,+                                withSockAddr)++import Network.Socket.ByteString.IOVec (IOVec(..))+import Network.Socket.ByteString.MsgHdr (MsgHdr(..))++#  if defined(__GLASGOW_HASKELL__)+import GHC.Conc (threadWaitRead, threadWaitWrite)+#  endif+#else+#  if defined(__GLASGOW_HASKELL__)+#    if __GLASGOW_HASKELL__ >= 611+import GHC.IO.FD+#    else+import GHC.Handle (readRawBufferPtr, writeRawBufferPtr)+#    endif+#  endif+#endif++#if !defined(mingw32_HOST_OS)+foreign import CALLCONV unsafe "send"+  c_send :: CInt -> Ptr a -> CSize -> CInt -> IO CInt+foreign import CALLCONV unsafe "recv"+  c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt+#endif++-- ----------------------------------------------------------------------------+-- Sending++-- | Send data to the socket.  The socket must be connected to a+-- remote socket.  Returns the number of bytes sent. Applications are+-- responsible for ensuring that all data has been sent.+send :: Socket      -- ^ Connected socket+     -> ByteString  -- ^ Data to send+     -> IO Int      -- ^ Number of bytes sent+send (MkSocket s _ _ _ _) xs =+    unsafeUseAsCStringLen xs $ \(str, len) ->+    liftM fromIntegral $+#if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS)+#  if __GLASGOW_HASKELL__ >= 611+        writeRawBufferPtr "Network.Socket.ByteString.send"+        (FD s 1) (castPtr str) 0 (fromIntegral len)+#  else+        writeRawBufferPtr "Network.Socket.ByteString.send"+        (fromIntegral s) True str 0 (fromIntegral len)+#  endif+#else+#  if !defined(__HUGS__)+        throwSocketErrorIfMinus1RetryMayBlock "send"+        (threadWaitWrite (fromIntegral s)) $+#  endif+        c_send s str (fromIntegral len) 0+#endif++-- | Send data to the socket.  The socket must be connected to a+-- remote socket.  Unlike 'send', this function continues to send data+-- until either all data has been sent or an error occurs.  On error,+-- an exception is raised, and there is no way to determine how much+-- data, if any, was successfully sent.+sendAll :: Socket      -- ^ Connected socket+        -> ByteString  -- ^ Data to send+        -> IO ()+sendAll sock bs = do+    sent <- send sock bs+    when (sent < B.length bs) $ sendAll sock (B.drop sent bs)++-- | Send data to the socket.  The recipient can be specified+-- explicitly, so the socket need not be in a connected state.+-- Returns the number of bytes sent. Applications are responsible for+-- ensuring that all data has been sent.+sendTo :: Socket      -- ^ Socket+       -> ByteString  -- ^ Data to send+       -> SockAddr    -- ^ Recipient address+       -> IO Int      -- ^ Number of bytes sent+sendTo sock xs addr =+    unsafeUseAsCStringLen xs $ \(str, len) -> sendBufTo sock str len addr++-- | Send data to the socket. The recipient can be specified+-- explicitly, so the socket need not be in a connected state.  Unlike+-- 'sendTo', this function continues to send data until either all+-- data has been sent or an error occurs.  On error, an exception is+-- raised, and there is no way to determine how much data, if any, was+-- successfully sent.+sendAllTo :: Socket      -- ^ Socket+          -> ByteString  -- ^ Data to send+          -> SockAddr    -- ^ Recipient address+          -> IO ()+sendAllTo sock xs addr = do+    sent <- sendTo sock xs addr+    when (sent < B.length xs) $ sendAllTo sock (B.drop sent xs) addr++-- ----------------------------------------------------------------------------+-- ** Vectored I/O++-- $vectored+--+-- Vectored I\/O, also known as scatter\/gather I\/O, allows multiple+-- data segments to be sent using a single system call, without first+-- concatenating the segments.  For example, given a list of+-- @ByteString@s, @xs@,+--+-- > sendMany sock xs+--+-- is equivalent to+--+-- > sendAll sock (concat xs)+--+-- but potentially more efficient.+--+-- Vectored I\/O are often useful when implementing network protocols+-- that, for example, group data into segments consisting of one or+-- more fixed-length headers followed by a variable-length body.++-- | Send data to the socket.  The socket must be in a connected+-- state.  The data is sent as if the parts have been concatenated.+-- This function continues to send data until either all data has been+-- sent or an error occurs.  On error, an exception is raised, and+-- there is no way to determine how much data, if any, was+-- successfully sent.+sendMany :: Socket        -- ^ Connected socket+         -> [ByteString]  -- ^ Data to send+         -> IO ()+#if !defined(mingw32_HOST_OS)+sendMany sock@(MkSocket fd _ _ _ _) cs = do+    sent <- sendManyInner+    when (sent < totalLength cs) $ sendMany sock (remainingChunks sent cs)+  where+    sendManyInner =+      liftM fromIntegral . withIOVec cs $ \(iovsPtr, iovsLen) ->+          throwSocketErrorIfMinus1RetryMayBlock "writev"+              (threadWaitWrite (fromIntegral fd)) $+              c_writev (fromIntegral fd) iovsPtr (fromIntegral iovsLen)+#else+sendMany sock = sendAll sock . B.concat+#endif++-- | Send data to the socket.  The recipient can be specified+-- explicitly, so the socket need not be in a connected state.  The+-- data is sent as if the parts have been concatenated.  This function+-- continues to send data until either all data has been sent or an+-- error occurs.  On error, an exception is raised, and there is no+-- way to determine how much data, if any, was successfully sent.+sendManyTo :: Socket        -- ^ Socket+           -> [ByteString]  -- ^ Data to send+           -> SockAddr      -- ^ Recipient address+           -> IO ()+#if !defined(mingw32_HOST_OS)+sendManyTo sock@(MkSocket fd _ _ _ _) cs addr = do+    sent <- liftM fromIntegral sendManyToInner+    when (sent < totalLength cs) $ sendManyTo sock (remainingChunks sent cs) addr+  where+    sendManyToInner =+      withSockAddr addr $ \addrPtr addrSize ->+        withIOVec cs $ \(iovsPtr, iovsLen) -> do+          let msgHdr = MsgHdr+                addrPtr (fromIntegral addrSize)+                iovsPtr (fromIntegral iovsLen)+          with msgHdr $ \msgHdrPtr ->+            throwSocketErrorIfMinus1RetryMayBlock "sendmsg"+              (threadWaitWrite (fromIntegral fd)) $+              c_sendmsg (fromIntegral fd) msgHdrPtr 0+#else+sendManyTo sock cs = sendAllTo sock (B.concat cs)+#endif++-- ----------------------------------------------------------------------------+-- Receiving++-- | Receive data from the socket.  The socket must be in a connected+-- state.  This function may return fewer bytes than specified.  If+-- the message is longer than the specified length, it may be+-- discarded depending on the type of socket.  This function may block+-- until a message arrives.+--+-- Considering hardware and network realities, the maximum number of bytes to+-- receive should be a small power of 2, e.g., 4096.+--+-- For TCP sockets, a zero length return value means the peer has+-- closed its half side of the connection.+recv :: Socket         -- ^ Connected socket+     -> Int            -- ^ Maximum number of bytes to receive+     -> IO ByteString  -- ^ Data received+recv (MkSocket s _ _ _ _) nbytes+    | nbytes < 0 = ioError (mkInvalidRecvArgError "Network.Socket.ByteString.recv")+    | otherwise  = createAndTrim nbytes $ recvInner s nbytes++recvInner :: CInt -> Int -> Ptr Word8 -> IO Int+recvInner s nbytes ptr =+    fmap fromIntegral $+#if defined(__GLASGOW_HASKELL__) && defined(mingw32_HOST_OS)+#  if __GLASGOW_HASKELL__ >= 611+        readRawBufferPtr "Network.Socket.ByteString.recv" (FD s 1) ptr 0 (fromIntegral nbytes)+#  else+        readRawBufferPtr "Network.Socket.ByteString.recv" (fromIntegral s)+        True (castPtr ptr) 0 (fromIntegral nbytes)+#  endif+#else+#  if !defined(__HUGS__)+        throwSocketErrorIfMinus1RetryMayBlock "recv"+        (threadWaitRead (fromIntegral s)) $+#  endif+        c_recv s (castPtr ptr) (fromIntegral nbytes) 0+#endif++-- | Receive data from the socket.  The socket need not be in a+-- connected state.  Returns @(bytes, address)@ where @bytes@ is a+-- 'ByteString' representing the data received and @address@ is a+-- 'SockAddr' representing the address of the sending socket.+recvFrom :: Socket                     -- ^ Socket+         -> Int                        -- ^ Maximum number of bytes to receive+         -> IO (ByteString, SockAddr)  -- ^ Data received and sender address+recvFrom sock nbytes =+    allocaBytes nbytes $ \ptr -> do+        (len, sockaddr) <- recvBufFrom sock ptr nbytes+        str <- B.packCStringLen (ptr, len)+        return (str, sockaddr)++-- ----------------------------------------------------------------------------+-- Not exported++#if !defined(mingw32_HOST_OS)+-- | Suppose we try to transmit a list of chunks @cs@ via a gathering write+-- operation and find that @n@ bytes were sent. Then @remainingChunks n cs@ is+-- list of chunks remaining to be sent.+remainingChunks :: Int -> [ByteString] -> [ByteString]+remainingChunks _ [] = []+remainingChunks i (x:xs)+    | i < len        = B.drop i x : xs+    | otherwise      = let i' = i - len in i' `seq` remainingChunks i' xs+  where+    len = B.length x++-- | @totalLength cs@ is the sum of the lengths of the chunks in the list @cs@.+totalLength :: [ByteString] -> Int+totalLength = sum . map B.length++-- | @withIOVec cs f@ executes the computation @f@, passing as argument a pair+-- consisting of a pointer to a temporarily allocated array of pointers to+-- 'IOVec' made from @cs@ and the number of pointers (@length cs@).+-- /Unix only/.+withIOVec :: [ByteString] -> ((Ptr IOVec, Int) -> IO a) -> IO a+withIOVec cs f =+    allocaArray csLen $ \aPtr -> do+        zipWithM_ pokeIov (ptrs aPtr) cs+        f (aPtr, csLen)+  where+    csLen = length cs+    ptrs = iterate (`plusPtr` sizeOf (undefined :: IOVec))+    pokeIov ptr s =+        unsafeUseAsCStringLen s $ \(sPtr, sLen) ->+        poke ptr $ IOVec sPtr (fromIntegral sLen)+#endif++-- ---------------------------------------------------------------------+-- Example++-- $example+--+-- Here are two minimal example programs using the TCP/IP protocol: a+-- server that echoes all data that it receives back (servicing only+-- one client) and a client using it.+--+-- > -- Echo server program+-- > module Main where+-- >+-- > import Control.Monad (unless)+-- > import Network.Socket hiding (recv)+-- > import qualified Data.ByteString as S+-- > import Network.Socket.ByteString (recv, sendAll)+-- >+-- > main :: IO ()+-- > main = withSocketsDo $+-- >     do addrinfos <- getAddrInfo+-- >                     (Just (defaultHints {addrFlags = [AI_PASSIVE]}))+-- >                     Nothing (Just "3000")+-- >        let serveraddr = head addrinfos+-- >        sock <- socket (addrFamily serveraddr) Stream defaultProtocol+-- >        bindSocket sock (addrAddress serveraddr)+-- >        listen sock 1+-- >        (conn, _) <- accept sock+-- >        talk conn+-- >        sClose conn+-- >        sClose sock+-- >+-- >     where+-- >       talk :: Socket -> IO ()+-- >       talk conn =+-- >           do msg <- recv conn 1024+-- >              unless (S.null msg) $ sendAll conn msg >> talk conn+--+-- > -- Echo client program+-- > module Main where+-- >+-- > import Network.Socket hiding (recv)+-- > import Network.Socket.ByteString (recv, sendAll)+-- > import qualified Data.ByteString.Char8 as C+-- >+-- > main :: IO ()+-- > main = withSocketsDo $+-- >     do addrinfos <- getAddrInfo Nothing (Just "") (Just "3000")+-- >        let serveraddr = head addrinfos+-- >        sock <- socket (addrFamily serveraddr) Stream defaultProtocol+-- >        connect sock (addrAddress serveraddr)+-- >        sendAll sock $ C.pack "Hello, world!"+-- >        msg <- recv sock 1024+-- >        sClose sock+-- >        putStr "Received "+-- >        C.putStrLn msg
+ Network/Socket/ByteString/IOVec.hsc view
@@ -0,0 +1,28 @@+-- | Support module for the POSIX writev system call.+module Network.Socket.ByteString.IOVec+  ( IOVec(..)+  ) where++import Foreign.C.Types (CChar, CInt, CSize)+import Foreign.Ptr (Ptr)+import Foreign.Storable (Storable(..))++#include <sys/uio.h>++data IOVec = IOVec+    { iovBase :: Ptr CChar+    , iovLen  :: CSize+    }++instance Storable IOVec where+  sizeOf _    = (#const sizeof(struct iovec))+  alignment _ = alignment (undefined :: CInt)++  peek p = do+    base <- (#peek struct iovec, iov_base) p+    len  <- (#peek struct iovec, iov_len)  p+    return $ IOVec base len++  poke p iov = do+    (#poke struct iovec, iov_base) p (iovBase iov)+    (#poke struct iovec, iov_len)  p (iovLen  iov)
+ Network/Socket/ByteString/Internal.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE CPP, ForeignFunctionInterface #-}++-- |+-- Module      : Network.Socket.ByteString.Internal+-- Copyright   : (c) Johan Tibell 2007-2010+-- License     : BSD-style+--+-- Maintainer  : johan.tibell@gmail.com+-- Stability   : stable+-- Portability : portable+--+module Network.Socket.ByteString.Internal+  ( mkInvalidRecvArgError+#if !defined(mingw32_HOST_OS)+  , c_writev+  , c_sendmsg+#endif+  ) where++import System.IO.Error (ioeSetErrorString, mkIOError)++#if !defined(mingw32_HOST_OS)+import Foreign.C.Types (CInt)+import Foreign.Ptr (Ptr)+import System.Posix.Types (CSsize)++import Network.Socket.ByteString.IOVec (IOVec)+import Network.Socket.ByteString.MsgHdr (MsgHdr)+#endif++#ifdef __GLASGOW_HASKELL__+# if __GLASGOW_HASKELL__ < 611+import GHC.IOBase (IOErrorType(..))+# else+import GHC.IO.Exception (IOErrorType(..))+# endif+#elif __HUGS__+import Hugs.Prelude (IOErrorType(..))+#endif++mkInvalidRecvArgError :: String -> IOError+mkInvalidRecvArgError loc = ioeSetErrorString (mkIOError+#ifdef __GLASGOW_HASKELL__+                                    InvalidArgument+#else+                                    IllegalOperation+#endif+                                    loc Nothing Nothing) "non-positive length"++#if !defined(mingw32_HOST_OS)+foreign import ccall unsafe "writev"+  c_writev :: CInt -> Ptr IOVec -> CInt -> IO CSsize++foreign import ccall unsafe "sendmsg"+  c_sendmsg :: CInt -> Ptr MsgHdr -> CInt -> IO CSsize+#endif
+ Network/Socket/ByteString/Lazy.hsc view
@@ -0,0 +1,153 @@+{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface #-}++-- |+-- Module      : Network.Socket.ByteString.Lazy+-- Copyright   : (c) Bryan O'Sullivan 2009+-- License     : BSD-style+--+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : POSIX, GHC+--+-- This module provides access to the BSD /socket/ interface.  This+-- module is generally more efficient than the 'String' based network+-- functions in 'Network.Socket'.  For detailed documentation, consult+-- your favorite POSIX socket reference. All functions communicate+-- failures by converting the error number to 'System.IO.IOError'.+--+-- This module is made to be imported with 'Network.Socket' like so:+--+-- > import Network.Socket hiding (send, sendTo, recv, recvFrom)+-- > import Network.Socket.ByteString.Lazy+-- > import Prelude hiding (getContents)+--+module Network.Socket.ByteString.Lazy+  (+#if !defined(mingw32_HOST_OS)+    -- * Send data to a socket+      send,+      sendAll,+#endif++    -- * Receive data from a socket+      getContents,+      recv+  ) where++import Control.Monad (liftM)+import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)+import Data.Int (Int64)+import Network.Socket (Socket(..), ShutdownCmd(..), shutdown)+import Prelude hiding (getContents)+import System.IO.Unsafe (unsafeInterleaveIO)++import qualified Data.ByteString as S+import qualified Network.Socket.ByteString as N++#if !defined(mingw32_HOST_OS)+import Control.Monad (unless)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Foreign.Marshal.Array (allocaArray)+import Foreign.Ptr (plusPtr)+import Foreign.Storable (Storable(..))+import Network.Socket.ByteString.IOVec (IOVec(IOVec))+import Network.Socket.ByteString.Internal (c_writev)+import Network.Socket.Internal (throwSocketErrorIfMinus1RetryMayBlock)++import qualified Data.ByteString.Lazy as L++#  if defined(__GLASGOW_HASKELL__)+import GHC.Conc (threadWaitWrite)+#  endif+#endif++#if !defined(mingw32_HOST_OS)+-- -----------------------------------------------------------------------------+-- Sending++-- | Send data to the socket. The socket must be in a connected state.+-- Returns the number of bytes sent. Applications are responsible for+-- ensuring that all data has been sent.+--+-- Because a lazily generated 'ByteString' may be arbitrarily long,+-- this function caps the amount it will attempt to send at 4MB.  This+-- number is large (so it should not penalize performance on fast+-- networks), but not outrageously so (to avoid demanding lazily+-- computed data unnecessarily early).  Before being sent, the lazy+-- 'ByteString' will be converted to a list of strict 'ByteString's+-- with 'L.toChunks'; at most 1024 chunks will be sent.  /Unix only/.+send :: Socket      -- ^ Connected socket+     -> ByteString  -- ^ Data to send+     -> IO Int64    -- ^ Number of bytes sent+send (MkSocket fd _ _ _ _) s = do+  let cs  = take maxNumChunks (L.toChunks s)+      len = length cs+  liftM fromIntegral . allocaArray len $ \ptr ->+    withPokes cs ptr $ \niovs ->+#  if !defined(__HUGS__)+      throwSocketErrorIfMinus1RetryMayBlock "writev"+        (threadWaitWrite (fromIntegral fd)) $+#  endif+        c_writev (fromIntegral fd) ptr niovs+  where+    withPokes ss p f = loop ss p 0 0+      where loop (c:cs) q k !niovs+                | k < maxNumBytes =+                    unsafeUseAsCStringLen c $ \(ptr,len) -> do+                      poke q $ IOVec ptr (fromIntegral len)+                      loop cs (q `plusPtr` sizeOf (undefined :: IOVec))+                              (k + fromIntegral len) (niovs + 1)+                | otherwise = f niovs+            loop _ _ _ niovs = f niovs+    maxNumBytes  = 4194304 :: Int  -- maximum number of bytes to transmit in one system call+    maxNumChunks = 1024    :: Int  -- maximum number of chunks to transmit in one system call++-- | Send data to the socket.  The socket must be in a connected+-- state. This function continues to send data until either all data+-- has been sent or an error occurs.  If there is an error, an+-- exception is raised, and there is no way to determine how much data+-- was sent.  /Unix only/.+sendAll :: Socket      -- ^ Connected socket+        -> ByteString  -- ^ Data to send+        -> IO ()+sendAll sock bs = do+  sent <- send sock bs+  let bs' = L.drop sent bs+  unless (L.null bs') $ sendAll sock bs'+#endif++-- -----------------------------------------------------------------------------+-- Receiving++-- | Receive data from the socket.  The socket must be in a connected+-- state.  Data is received on demand, in chunks; each chunk will be+-- sized to reflect the amount of data received by individual 'recv'+-- calls.+--+-- All remaining data from the socket is consumed.  When there is no+-- more data to be received, the receiving side of the socket is shut+-- down.  If there is an error and an exception is thrown, the socket+-- is not shut down.+getContents :: Socket         -- ^ Connected socket+            -> IO ByteString  -- ^ Data received+getContents sock = loop where+  loop = unsafeInterleaveIO $ do+    s <- N.recv sock defaultChunkSize+    if S.null s+      then shutdown sock ShutdownReceive >> return Empty+      else Chunk s `liftM` loop++-- | Receive data from the socket.  The socket must be in a connected+-- state.  This function may return fewer bytes than specified.  If+-- the received data is longer than the specified length, it may be+-- discarded depending on the type of socket.  This function may block+-- until a message arrives.+--+-- If there is no more data to be received, returns an empty 'ByteString'.+recv :: Socket         -- ^ Connected socket+     -> Int64          -- ^ Maximum number of bytes to receive+     -> IO ByteString  -- ^ Data received+recv sock nbytes = chunk `liftM` N.recv sock (fromIntegral nbytes) where+  chunk k+    | S.null k  = Empty+    | otherwise = Chunk k Empty
+ Network/Socket/ByteString/MsgHdr.hsc view
@@ -0,0 +1,42 @@+{-# LANGUAGE CPP #-}++-- | Support module for the POSIX 'sendmsg' system call.+module Network.Socket.ByteString.MsgHdr+  ( MsgHdr(..)+  ) where++#include <sys/types.h>+#include <sys/socket.h>++import Foreign.C.Types (CInt, CSize)+import Foreign.Ptr (Ptr)+import Foreign.Storable (Storable(..))+import Network.Socket (SockAddr)++import Network.Socket.ByteString.IOVec (IOVec)++-- We don't use msg_control, msg_controllen, and msg_flags as these+-- don't exist on OpenSolaris.+data MsgHdr = MsgHdr+    { msgName    :: Ptr SockAddr+    , msgNameLen :: CSize+    , msgIov     :: Ptr IOVec+    , msgIovLen  :: CSize+    }++instance Storable MsgHdr where+  sizeOf _    = (#const sizeof(struct msghdr))+  alignment _ = alignment (undefined :: CInt)++  peek p = do+    name       <- (#peek struct msghdr, msg_name)       p+    nameLen    <- (#peek struct msghdr, msg_namelen)    p+    iov        <- (#peek struct msghdr, msg_iov)        p+    iovLen     <- (#peek struct msghdr, msg_iovlen)     p+    return $ MsgHdr name nameLen iov iovLen++  poke p mh = do+    (#poke struct msghdr, msg_name)       p (msgName       mh)+    (#poke struct msghdr, msg_namelen)    p (msgNameLen    mh)+    (#poke struct msghdr, msg_iov)        p (msgIov        mh)+    (#poke struct msghdr, msg_iovlen)     p (msgIovLen     mh)
Network/Socket/Internal.hsc view
@@ -18,22 +18,6 @@  #include "HsNet.h" -#if defined(HAVE_WINSOCK2_H) && !defined(cygwin32_HOST_OS)-#define WITH_WINSOCK  1-#endif--#if !defined(mingw32_HOST_OS) && !defined(_WIN32)-#define DOMAIN_SOCKET_SUPPORT 1-#endif--#if !defined(CALLCONV)-#ifdef WITH_WINSOCK-#define CALLCONV stdcall-#else-#define CALLCONV ccall-#endif-#endif- module Network.Socket.Internal     (       -- * Socket addresses
+ README view
@@ -0,0 +1,4 @@+To build this package using Cabal directly from git, you must run+"autoreconf" before the usual Cabal build steps (configure/build/install).+autoreconf is included in the GNU autoconf tools.  There is no need to run+the "configure" script: the "setup configure" step will do this for you.
Setup.hs view
@@ -1,6 +1,17 @@ module Main (main) where -import Distribution.Simple+import Control.Monad (unless)+import Distribution.Simple (defaultMainWithHooks, runTests, simpleUserHooks)+import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))+import Distribution.Simple.Utils (die)+import System.Cmd (system)+import System.Directory (doesDirectoryExist)  main :: IO ()-main = defaultMainWithHooks defaultUserHooks+main = defaultMainWithHooks $ simpleUserHooks { runTests = runTests' }+    where+      runTests' _ _ _ lbi = do+          built <- doesDirectoryExist $ buildDir lbi+          unless built $ die "Run the 'build' command first."+          system "runhaskell -i./dist/build tests/Simple.hs"+          return ()
+ examples/EchoClient.hs view
@@ -0,0 +1,18 @@+-- Echo client program+module Main where++import Network.Socket hiding (recv)+import Network.Socket.ByteString (recv, sendAll)+import qualified Data.ByteString.Char8 as C++main :: IO ()+main = withSocketsDo $+    do addrinfos <- getAddrInfo Nothing (Just "") (Just "3000")+       let serveraddr = head addrinfos+       sock <- socket (addrFamily serveraddr) Stream defaultProtocol+       connect sock (addrAddress serveraddr)+       sendAll sock $ C.pack "Hello, world!"+       msg <- recv sock 1024+       sClose sock+       putStr "Received "+       C.putStrLn msg
+ examples/EchoServer.hs view
@@ -0,0 +1,27 @@+-- Echo server program+module Main where++import Control.Monad (unless)+import Network.Socket hiding (recv)+import qualified Data.ByteString as S+import Network.Socket.ByteString (recv, sendAll)++main :: IO ()+main = withSocketsDo $+    do addrinfos <- getAddrInfo+                    (Just (defaultHints {addrFlags = [AI_PASSIVE]}))+                    Nothing (Just "3000")+       let serveraddr = head addrinfos+       sock <- socket (addrFamily serveraddr) Stream defaultProtocol+       bindSocket sock (addrAddress serveraddr)+       listen sock 1+       (conn, _) <- accept sock+       talk conn+       sClose conn+       sClose sock++    where+      talk :: Socket -> IO ()+      talk conn =+          do msg <- recv conn 1024+             unless (S.null msg) $ sendAll conn msg >> talk conn
include/HsNet.h view
@@ -174,4 +174,20 @@ } #endif +#if defined(HAVE_WINSOCK_H) && !defined(cygwin32_HOST_OS)+# define WITH_WINSOCK  1 #endif++#if !defined(mingw32_HOST_OS) && !defined(_WIN32)+# define DOMAIN_SOCKET_SUPPORT 1+#endif++#if !defined(CALLCONV)+# if defined(WITH_WINSOCK)+#  define CALLCONV stdcall+# else+#  define CALLCONV ccall+# endif+#endif++#endif /* HSNET_H */
network.cabal view
@@ -1,46 +1,66 @@ name:           network-version:        2.2.1.10+version:        2.2.3 license:        BSD3 license-file:   LICENSE maintainer:     Johan Tibell <johan.tibell@gmail.com>-synopsis:       Networking-related facilities+synopsis:       Low-level networking interface+description:    Low-level networking interface category:       Network build-type:     Configure cabal-version:  >=1.6 extra-tmp-files:-                config.log config.status autom4te.cache-                network.buildinfo include/HsNetworkConfig.h+  config.log config.status autom4te.cache network.buildinfo+  include/HsNetworkConfig.h extra-source-files:-                config.guess config.sub install-sh-                configure.ac configure-                network.buildinfo.in include/HsNetworkConfig.h.in-                include/HsNet.h include/Typeable.h-                -- C sources only used on some systems-                cbits/ancilData.c-                cbits/asyncAccept.c cbits/initWinSock.c cbits/winSockErr.c+  README examples/*.hs tests/*.hs config.guess config.sub install-sh+  configure.ac configure network.buildinfo.in+  include/HsNetworkConfig.h.in include/HsNet.h include/Typeable.h+  -- C sources only used on some systems+  cbits/ancilData.c cbits/asyncAccept.c cbits/initWinSock.c+  cbits/winSockErr.c+homepage:       http://github.com/haskell/network bug-reports:    http://trac.haskell.org/network/  flag base4  library   exposed-modules:-                Network Network.BSD Network.Socket.Internal Network.Socket-                Network.URI-  build-depends: base < 5, parsec+    Network+    Network.BSD+    Network.Socket+    Network.Socket.ByteString+    Network.Socket.ByteString.Lazy+    Network.Socket.Internal+    Network.URI+  other-modules:+    Network.Socket.ByteString.Internal +  if !os(windows)+    other-modules:+      Network.Socket.ByteString.IOVec+      Network.Socket.ByteString.MsgHdr++  build-depends:+    base < 5,+    bytestring < 1.0,+    parsec++  if !os(windows)+    build-depends:+      unix >= 2 && < 3+   if flag(base4)-      build-depends:    base >= 4 && < 4.4-      cpp-options:      -DBASE4+    build-depends: base >= 4 && < 4.4+    cpp-options: -DBASE4   else-      build-depends:    base<4+    build-depends: base<4 -  extensions:   CPP, DeriveDataTypeable, ForeignFunctionInterface,-                TypeSynonymInstances-  include-dirs:         include-  includes:       HsNet.h-  install-includes:-                HsNet.h HsNetworkConfig.h-  c-sources:    cbits/HsNet.c+  extensions:+    CPP, DeriveDataTypeable, ForeignFunctionInterface, TypeSynonymInstances+  include-dirs: include+  includes: HsNet.h+  install-includes: HsNet.h HsNetworkConfig.h+  c-sources: cbits/HsNet.c  source-repository head   type:     git
+ tests/Simple.hs view
@@ -0,0 +1,141 @@+module Main where++import Control.Concurrent (forkIO)+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)+import Control.Exception (bracket)+import Control.Monad (when)+import Network.Socket hiding (recv, recvFrom, send)+import System.Exit (exitFailure)+import Test.HUnit (Counts(..), Test(..), (@=?), runTestTT)++import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as C+import qualified Data.ByteString.Lazy.Char8 as L++import Network.Socket.ByteString (recv, recvFrom, send, sendAll, sendMany)+import qualified Network.Socket.ByteString.Lazy as NSBL++------------------------------------------------------------------------++port :: PortNumber+port = fromIntegral (3000 :: Int)++testMsg :: S.ByteString+testMsg = C.pack "This is a test message."++testLazySend :: Test+testLazySend = TestCase $ connectedTest client server+    where+      server sock = recv sock 1024 >>= (@=?) (C.take 1024 strictTestMsg)+      client sock = NSBL.send sock lazyTestMsg >>= (@=?) 1024++      -- message containing too many chunks to be sent in one system call+      lazyTestMsg = let alphabet = map C.singleton ['a'..'z']+                    in L.fromChunks (concat (replicate 100 alphabet))++      strictTestMsg = C.concat . L.toChunks $ lazyTestMsg++------------------------------------------------------------------------+-- Tests++testSendAll :: Test+testSendAll = TestCase $ connectedTest client server+    where+      server sock = recv sock 1024 >>= (@=?) testMsg+      client sock = sendAll sock testMsg++testSendMany :: Test+testSendMany = TestCase $ connectedTest client server+    where+      server sock = recv sock 1024 >>= (@=?) (S.append seg1 seg2)+      client sock = sendMany sock [seg1, seg2]++      seg1 = C.pack "This is a "+      seg2 = C.pack "test message."++testRecv :: Test+testRecv = TestCase $ connectedTest client server+    where+      server sock = recv sock 1024 >>= (@=?) testMsg+      client sock = send sock testMsg++testOverFlowRecv :: Test+testOverFlowRecv = TestCase $ connectedTest client server+    where+      server sock = do seg1 <- recv sock (S.length testMsg - 3)+                       seg2 <- recv sock 1024+                       let msg = S.append seg1 seg2+                       testMsg @=? msg++      client sock = send sock testMsg++testRecvFrom :: Test+testRecvFrom = TestCase $ connectedTest client server+    where+      server sock = do (msg, _) <- recvFrom sock 1024+                       testMsg @=? msg++      client sock = send sock testMsg++testOverFlowRecvFrom :: Test+testOverFlowRecvFrom = TestCase $ connectedTest client server+    where+      server sock = do (seg1, _) <- recvFrom sock (S.length testMsg - 3)+                       (seg2, _) <- recvFrom sock 1024+                       let msg = S.append seg1 seg2+                       testMsg @=? msg++      client sock = send sock testMsg++------------------------------------------------------------------------+-- Test helpers++-- | Run a client/server pair and synchronize them so that the server+-- is started before the client and the specified server action is+-- finished before the client closes the connection.+connectedTest :: (Socket -> IO a) -> (Socket -> IO b) -> IO ()+connectedTest clientAct serverAct = do+    barrier <- newEmptyMVar+    forkIO $ server barrier+    client barrier+  where+    server barrier = do+        addr <- inet_addr "127.0.0.1"+        bracket (socket AF_INET Stream defaultProtocol) sClose $ \sock -> do+            setSocketOption sock ReuseAddr 1+            bindSocket sock (SockAddrInet port addr)+            listen sock 1+            serverReady+            (clientSock, _) <- accept sock+            serverAct clientSock+            sClose clientSock+            putMVar barrier ()+      where+        -- | Signal to the client that it can proceed.+        serverReady = putMVar barrier ()++    client barrier = do+        takeMVar barrier+        bracket (socket AF_INET Stream defaultProtocol) sClose $ \sock -> do+            addr <- inet_addr "127.0.0.1"+            connect sock $ SockAddrInet port addr+            clientAct sock+            takeMVar barrier++------------------------------------------------------------------------+-- Test harness++main :: IO ()+main = withSocketsDo $ do+    counts <- runTestTT tests+    when (errors counts + failures counts > 0) exitFailure++tests :: Test+tests = TestList [ TestLabel "testLazySend" testLazySend+                 , TestLabel "testSendAll" testSendMany+                 , TestLabel "testSendMany" testSendMany+                 , TestLabel "testRecv" testRecv+                 , TestLabel "testOverFlowRecv" testOverFlowRecv+                 , TestLabel "testRecvFrom" testRecvFrom+                 , TestLabel "testOverFlowRecvFrom" testOverFlowRecvFrom+                 ]
+ tests/net001.hs view
@@ -0,0 +1,27 @@+module Main where++import Network+import Control.Concurrent+import System.IO++-- NOTE: this test depends on non-blocking I/O support,+-- which win32 doesn't support. Rather than having the+-- test program block, we fail to initialise WinSock+-- (via withSocketsDo) here so that the test will fall over+-- (and repeatedly remind us to implement Win32 support+-- for non-blocking I/O !)++main = {- withSocketsDo $ -} do+   forkIO server+   threadDelay 1000000+   h <- connectTo "localhost" (PortNumber 22222)+   l <- hGetLine h+   hClose h+   print l+ where+   server = do+	  s <- listenOn (PortNumber 22222)+	  (h, host, port) <- accept s+	  hPutStrLn h "hello"+	  hClose h+
+ tests/net002.hs view
@@ -0,0 +1,133 @@+-- $Id: net002.hs,v 1.5 2005/01/17 09:57:24 simonmar Exp $+-- http://www.bagley.org/~doug/shootout/+-- Haskell echo/client server+-- written by Brian Gregor+-- compile with:+-- ghc -O -o echo -package net -package concurrent -package lang echo.hs+    +-- !!! exposed a bug in 5.02.2's network library, accept wasn't setting the+-- socket it returned to non-blocking mode.++-- NOTE: this test depends on non-blocking I/O support,+-- which win32 doesn't support. Rather than having the+-- test program block, we fail to initialise WinSock+-- (via withSocketsDo) here so that the test will fall over+-- (and repeatedly remind us to implement Win32 support+-- for non-blocking I/O !)++module Main where++import Network.Socket++import Prelude hiding (putStr)+import System.IO hiding (putStr)+import qualified System.IO+import System.IO.Error+import Control.Concurrent+import System.Environment 	( getArgs )+import System.Exit 		( exitFailure )+import Control.Exception 	( finally )++server_sock :: IO (Socket)+server_sock = do+    s <- socket AF_INET Stream 6+    setSocketOption s ReuseAddr 1+    -- bindSocket s (SockAddrInet (mkPortNumber portnum) iNADDR_ANY)+    bindSocket s (SockAddrInet (PortNum portnum) iNADDR_ANY)+    listen s 2+    return s++eofAsEmptyHandler :: IOError -> IO String+eofAsEmptyHandler e+ | isEOFError e = return ""+ | otherwise    = ioError e++-- For debugging, enable the putStr below.  Turn it off to get deterministic+-- results: on a multiprocessor we can't predict the order of the messages.+putStr = const (return ())+-- putStr = System.IO.putStr ++echo_server s = do+    (s', clientAddr) <- accept s+    proc <- read_data s' 0+    putStrLn ("server processed "++(show proc)++" bytes")+    sClose s'+    where+        read_data sock totalbytes = do+            -- (str,i) <- readSocket sock 19+            str <- recv sock 19 `catch` eofAsEmptyHandler+            -- if (i >= 19) +            putStr ("Server recv: " ++ str)+            if ((length str) >= 19) +                then do+                    putStr ("Server read: " ++ str)+                    -- writ <- writeSocket sock str+                    writ <- send sock str+                    putStr ("Server wrote: " ++ str)+                    --+                    read_data sock $! (totalbytes+(length $! str))+                    -- read_data sock (totalbytes+(length str))+                else do+                    putStr ("server read: " ++ str)+                    return totalbytes++local       = "127.0.0.1"        +message     = "Hello there sailor\n"+portnum     = 7001++client_sock = do+    s <- socket AF_INET Stream 6+    ia <- inet_addr local+    -- connect s (SockAddrInet (mkPortNumber portnum) ia)+    connect s (SockAddrInet (PortNum portnum) ia)+    return s++echo_client n = do+    s <- client_sock+    drop <- server_echo s n+    sClose s+    where+        server_echo sock n = if n > 0+            then do +                -- writeSocket sock message+                send sock message+                putStr ("Client wrote: " ++ message)+                --+                -- (str,i) <- readSocket sock 19+                str <- recv sock 19 `catch` eofAsEmptyHandler+                if (str /= message)+                    then do+                        putStr ("Client read error: " ++ str ++ "\n")+                        exitFailure+                    else do+                        putStr ("Client read success")+                        server_echo sock (n-1)+            else do +                putStr "Client read nil\n"+                return []++main = {- withSocketsDo $ -} do +    ~[n] <- getArgs+    -- server & client semaphores+    -- get the server socket+    ssock <- server_sock +    -- fork off the server+    s <- myForkIO (echo_server ssock)+    -- fork off the client+    c <- myForkIO (echo_client (read n::Int))+    -- let 'em run until they've signaled they're done+    join s+    System.IO.putStr "join s\n"+    join c+    System.IO.putStr "join c\n"++-- these are used to make the main thread wait until+-- the child threads have exited+myForkIO :: IO () -> IO (MVar ())+myForkIO io = do+    mvar <- newEmptyMVar+    forkIO (io `finally` putMVar mvar ())+    return mvar++join :: MVar () -> IO ()+join mvar = readMVar mvar
+ tests/uri001.hs view
@@ -0,0 +1,1166 @@+--------------------------------------------------------------------------------+--  $Id: URITest.hs,v 1.8 2005/07/19 22:01:27 gklyne Exp $+--+--  Copyright (c) 2004, G. KLYNE.  All rights reserved.+--  See end of this file for licence information.+--------------------------------------------------------------------------------+-- |+--  Module      :  URITest+--  Copyright   :  (c) 2004, Graham Klyne+--  License     :  BSD-style (see end of this file)+--+--  Maintainer  :  Graham Klyne+--  Stability   :  provisional+--  Portability :  H98+--+--  This Module contains test cases for module URI.+--+--  Using GHC, I compile with this command line:+--  ghc --make -fglasgow-exts+--      -i..\;C:\Dev\Haskell\Lib\HUnit;C:\Dev\Haskell\Lib\Parsec+--      -o URITest.exe URITest -main-is URITest.main+--  The -i line may need changing for alternative installations.+--+--------------------------------------------------------------------------------++module Main where++import Network.URI+    ( URI(..), URIAuth(..)+    , nullURI+    , parseURI, parseURIReference, parseRelativeReference, parseAbsoluteURI+    , parseabsoluteURI+    , isURI, isURIReference, isRelativeReference, isAbsoluteURI+    , isIPv6address, isIPv4address+    , relativeTo, nonStrictRelativeTo+    , relativeFrom+    , uriToString+    , isUnescapedInURI, escapeURIString, unEscapeString+    , normalizeCase, normalizeEscape, normalizePathSegments+    )++import Test.HUnit++import IO ( Handle, openFile, IOMode(WriteMode), hClose, hPutStr, hPutStrLn )++import Maybe ( fromJust )++-- Test supplied string for valid URI reference syntax+--   isValidURIRef :: String -> Bool+-- Test supplied string for valid absolute URI reference syntax+--   isAbsoluteURIRef :: String -> Bool+-- Test supplied string for valid absolute URI syntax+--   isAbsoluteURI :: String -> Bool++data URIType = AbsId    -- URI form (absolute, no fragment)+             | AbsRf    -- Absolute URI reference+             | RelRf    -- Relative URI reference+             | InvRf    -- Invalid URI reference+isValidT :: URIType -> Bool+isValidT InvRf = False+isValidT _     = True++isAbsRfT :: URIType -> Bool+isAbsRfT AbsId = True+isAbsRfT AbsRf = True+isAbsRfT _     = False++isRelRfT :: URIType -> Bool+isRelRfT RelRf = True+isRelRfT _     = False++isAbsIdT :: URIType -> Bool+isAbsIdT AbsId = True+isAbsIdT _     = False++testEq :: (Eq a, Show a) => String -> a -> a -> Test+testEq lab a1 a2 = TestCase ( assertEqual lab a1 a2 )++testURIRef :: URIType -> String -> Test+testURIRef t u = TestList+  [ testEq ("test_isURIReference:"++u) (isValidT t) (isURIReference u)+  , testEq ("test_isRelativeReference:"++u)  (isRelRfT t) (isRelativeReference  u)+  , testEq ("test_isAbsoluteURI:"++u)  (isAbsIdT t) (isAbsoluteURI  u)+  ]++testURIRefComponents :: String -> (Maybe URI) -> String -> Test+testURIRefComponents lab uv us =+    testEq ("testURIRefComponents:"++us) uv (parseURIReference us)+++testURIRef001 = testURIRef AbsRf "http://example.org/aaa/bbb#ccc"+testURIRef002 = testURIRef AbsId "mailto:local@domain.org"+testURIRef003 = testURIRef AbsRf "mailto:local@domain.org#frag"+testURIRef004 = testURIRef AbsRf "HTTP://EXAMPLE.ORG/AAA/BBB#CCC"+testURIRef005 = testURIRef RelRf "//example.org/aaa/bbb#ccc"+testURIRef006 = testURIRef RelRf "/aaa/bbb#ccc"+testURIRef007 = testURIRef RelRf "bbb#ccc"+testURIRef008 = testURIRef RelRf "#ccc"+testURIRef009 = testURIRef RelRf "#"+testURIRef010 = testURIRef RelRf "/"+-- escapes+testURIRef011 = testURIRef AbsRf "http://example.org/aaa%2fbbb#ccc"+testURIRef012 = testURIRef AbsRf "http://example.org/aaa%2Fbbb#ccc"+testURIRef013 = testURIRef RelRf "%2F"+testURIRef014 = testURIRef RelRf "aaa%2Fbbb"+-- ports+testURIRef015 = testURIRef AbsRf "http://example.org:80/aaa/bbb#ccc"+testURIRef016 = testURIRef AbsRf "http://example.org:/aaa/bbb#ccc"+testURIRef017 = testURIRef AbsRf "http://example.org./aaa/bbb#ccc"+testURIRef018 = testURIRef AbsRf "http://example.123./aaa/bbb#ccc"+-- bare authority+testURIRef019 = testURIRef AbsId "http://example.org"+-- IPv6 literals (from RFC2732):+testURIRef021 = testURIRef AbsId "http://[FEDC:BA98:7654:3210:FEDC:BA98:7654:3210]:80/index.html"+testURIRef022 = testURIRef AbsId "http://[1080:0:0:0:8:800:200C:417A]/index.html"+testURIRef023 = testURIRef AbsId "http://[3ffe:2a00:100:7031::1]"+testURIRef024 = testURIRef AbsId "http://[1080::8:800:200C:417A]/foo"+testURIRef025 = testURIRef AbsId "http://[::192.9.5.5]/ipng"+testURIRef026 = testURIRef AbsId "http://[::FFFF:129.144.52.38]:80/index.html"+testURIRef027 = testURIRef AbsId "http://[2010:836B:4179::836B:4179]"+testURIRef028 = testURIRef RelRf "//[2010:836B:4179::836B:4179]"+testURIRef029 = testURIRef InvRf "[2010:836B:4179::836B:4179]"+-- RFC2396 test cases+testURIRef031 = testURIRef RelRf "./aaa"+testURIRef032 = testURIRef RelRf "../aaa"+testURIRef033 = testURIRef AbsId "g:h"+testURIRef034 = testURIRef RelRf "g"+testURIRef035 = testURIRef RelRf "./g"+testURIRef036 = testURIRef RelRf "g/"+testURIRef037 = testURIRef RelRf "/g"+testURIRef038 = testURIRef RelRf "//g"+testURIRef039 = testURIRef RelRf "?y"+testURIRef040 = testURIRef RelRf "g?y"+testURIRef041 = testURIRef RelRf "#s"+testURIRef042 = testURIRef RelRf "g#s"+testURIRef043 = testURIRef RelRf "g?y#s"+testURIRef044 = testURIRef RelRf ";x"+testURIRef045 = testURIRef RelRf "g;x"+testURIRef046 = testURIRef RelRf "g;x?y#s"+testURIRef047 = testURIRef RelRf "."+testURIRef048 = testURIRef RelRf "./"+testURIRef049 = testURIRef RelRf ".."+testURIRef050 = testURIRef RelRf "../"+testURIRef051 = testURIRef RelRf "../g"+testURIRef052 = testURIRef RelRf "../.."+testURIRef053 = testURIRef RelRf "../../"+testURIRef054 = testURIRef RelRf "../../g"+testURIRef055 = testURIRef RelRf "../../../g"+testURIRef056 = testURIRef RelRf "../../../../g"+testURIRef057 = testURIRef RelRf "/./g"+testURIRef058 = testURIRef RelRf "/../g"+testURIRef059 = testURIRef RelRf "g."+testURIRef060 = testURIRef RelRf ".g"+testURIRef061 = testURIRef RelRf "g.."+testURIRef062 = testURIRef RelRf "..g"+testURIRef063 = testURIRef RelRf "./../g"+testURIRef064 = testURIRef RelRf "./g/."+testURIRef065 = testURIRef RelRf "g/./h"+testURIRef066 = testURIRef RelRf "g/../h"+testURIRef067 = testURIRef RelRf "g;x=1/./y"+testURIRef068 = testURIRef RelRf "g;x=1/../y"+testURIRef069 = testURIRef RelRf "g?y/./x"+testURIRef070 = testURIRef RelRf "g?y/../x"+testURIRef071 = testURIRef RelRf "g#s/./x"+testURIRef072 = testURIRef RelRf "g#s/../x"+testURIRef073 = testURIRef RelRf ""+testURIRef074 = testURIRef RelRf "A'C"+testURIRef075 = testURIRef RelRf "A$C"+testURIRef076 = testURIRef RelRf "A@C"+testURIRef077 = testURIRef RelRf "A,C"+-- Invalid+testURIRef080 = testURIRef InvRf "http://foo.org:80Path/More"+testURIRef081 = testURIRef InvRf "::"+testURIRef082 = testURIRef InvRf " "+testURIRef083 = testURIRef InvRf "%"+testURIRef084 = testURIRef InvRf "A%Z"+testURIRef085 = testURIRef InvRf "%ZZ"+testURIRef086 = testURIRef InvRf "%AZ"+testURIRef087 = testURIRef InvRf "A C"+-- testURIRef088 = -- (case removed)+-- testURIRef089 = -- (case removed)+testURIRef090 = testURIRef InvRf "A\"C"+testURIRef091 = testURIRef InvRf "A`C"+testURIRef092 = testURIRef InvRf "A<C"+testURIRef093 = testURIRef InvRf "A>C"+testURIRef094 = testURIRef InvRf "A^C"+testURIRef095 = testURIRef InvRf "A\\C"+testURIRef096 = testURIRef InvRf "A{C"+testURIRef097 = testURIRef InvRf "A|C"+testURIRef098 = testURIRef InvRf "A}C"+-- From RFC2396:+-- rel_segment   = 1*( unreserved | escaped |+--                     ";" | "@" | "&" | "=" | "+" | "$" | "," )+-- unreserved    = alphanum | mark+-- mark          = "-" | "_" | "." | "!" | "~" | "*" | "'" |+--                 "(" | ")"+-- Note RFC 2732 allows '[', ']' ONLY for reserved purpose of IPv6 literals,+-- or does it?+testURIRef101 = testURIRef InvRf "A[C"+testURIRef102 = testURIRef InvRf "A]C"+testURIRef103 = testURIRef InvRf "A[**]C"+testURIRef104 = testURIRef InvRf "http://[xyz]/"+testURIRef105 = testURIRef InvRf "http://]/"+testURIRef106 = testURIRef InvRf "http://example.org/[2010:836B:4179::836B:4179]"+testURIRef107 = testURIRef InvRf "http://example.org/abc#[2010:836B:4179::836B:4179]"+testURIRef108 = testURIRef InvRf "http://example.org/xxx/[qwerty]#a[b]"+-- Random other things that crop up+testURIRef111 = testURIRef AbsRf "http://example/Andr&#567;"+testURIRef112 = testURIRef AbsId "file:///C:/DEV/Haskell/lib/HXmlToolbox-3.01/examples/"+testURIRef113 = testURIRef AbsId "http://46229EFFE16A9BD60B9F1BE88B2DB047ADDED785/demo.mp3"+testURIRef114 = testURIRef InvRf "http://example.org/xxx/qwerty#a#b"+testURIRef115 = testURIRef InvRf "dcp.tcp.pft://192.168.0.1:1002:3002?fec=1&crc=0"+testURIRef116 = testURIRef AbsId "dcp.tcp.pft://192.168.0.1:1002?fec=1&crc=0"+testURIRef117 = testURIRef AbsId "foo://"++testURIRefSuite = TestLabel "Test URIrefs" testURIRefList+testURIRefList = TestList+  [+    testURIRef001, testURIRef002, testURIRef003, testURIRef004,+    testURIRef005, testURIRef006, testURIRef007, testURIRef008,+    testURIRef009, testURIRef010,+    --+    testURIRef011, testURIRef012, testURIRef013, testURIRef014,+    testURIRef015, testURIRef016, testURIRef017, testURIRef018,+    --+    testURIRef019,+    --+    testURIRef021, testURIRef022, testURIRef023, testURIRef024,+    testURIRef025, testURIRef026, testURIRef027, testURIRef028,+    testURIRef029,+    --+    testURIRef031, testURIRef032, testURIRef033, testURIRef034,+    testURIRef035, testURIRef036, testURIRef037, testURIRef038,+    testURIRef039,+    testURIRef040, testURIRef041, testURIRef042, testURIRef043,+    testURIRef044, testURIRef045, testURIRef046, testURIRef047,+    testURIRef048, testURIRef049,+    testURIRef050, testURIRef051, testURIRef052, testURIRef053,+    testURIRef054, testURIRef055, testURIRef056, testURIRef057,+    testURIRef058, testURIRef059,+    testURIRef060, testURIRef061, testURIRef062, testURIRef063,+    testURIRef064, testURIRef065, testURIRef066, testURIRef067,+    testURIRef068, testURIRef069,+    testURIRef070, testURIRef071, testURIRef072, testURIRef073,+    testURIRef074, testURIRef075, testURIRef076, testURIRef077,+    --+    testURIRef080,+    testURIRef081, testURIRef082, testURIRef083, testURIRef084,+    testURIRef085, testURIRef086, testURIRef087, -- testURIRef088,+    -- testURIRef089,+    testURIRef090, testURIRef091, testURIRef092, testURIRef093,+    testURIRef094, testURIRef095, testURIRef096, testURIRef097,+    testURIRef098, -- testURIRef099,+    --+    testURIRef101, testURIRef102, testURIRef103, testURIRef104,+    testURIRef105, testURIRef106, testURIRef107, testURIRef108,+    --+    testURIRef111, testURIRef112, testURIRef113, testURIRef114,+    testURIRef115, testURIRef116, testURIRef117+  ]++-- test decomposition of URI into components+testComponent01 = testURIRefComponents "testComponent01"+        ( Just $ URI+            { uriScheme    = "http:"+            , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99")+            , uriPath      = "/aaa/bbb"+            , uriQuery     = "?qqq"+            , uriFragment  = "#fff"+            } )+        "http://user:pass@example.org:99/aaa/bbb?qqq#fff"+testComponent02 = testURIRefComponents "testComponent02"+        ( const Nothing+        ( Just $ URI+            { uriScheme    = "http:"+            , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99")+            , uriPath      = "aaa/bbb"+            , uriQuery     = ""+            , uriFragment  = ""+            } )+        )+        "http://user:pass@example.org:99aaa/bbb"+testComponent03 = testURIRefComponents "testComponent03"+        ( Just $ URI+            { uriScheme    = "http:"+            , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99")+            , uriPath      = ""+            , uriQuery     = "?aaa/bbb"+            , uriFragment  = ""+            } )+        "http://user:pass@example.org:99?aaa/bbb"+testComponent04 = testURIRefComponents "testComponent03"+        ( Just $ URI+            { uriScheme    = "http:"+            , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99")+            , uriPath      = ""+            , uriQuery     = ""+            , uriFragment  = "#aaa/bbb"+            } )+        "http://user:pass@example.org:99#aaa/bbb"+-- These test cases contributed by Robert Buck (mathworks.com)+testComponent11 = testURIRefComponents "testComponent03"+        ( Just $ URI+            { uriScheme    = "about:"+            , uriAuthority = Nothing+            , uriPath      = ""+            , uriQuery     = ""+            , uriFragment  = ""+            } )+        "about:"+testComponent12 = testURIRefComponents "testComponent03"+        ( Just $ URI+            { uriScheme    = "file:"+            , uriAuthority = Just (URIAuth "" "windowsauth" "")+            , uriPath      = "/d$"+            , uriQuery     = ""+            , uriFragment  = ""+            } )+        "file://windowsauth/d$"++testComponentSuite = TestLabel "Test URIrefs" $ TestList+  [ testComponent01+  , testComponent02+  , testComponent03+  , testComponent04+  , testComponent11+  , testComponent12+  ]++-- Get reference relative to given base+--   relativeRef :: String -> String -> String+--+-- Get absolute URI given base and relative reference+--   absoluteURI :: String -> String -> String+--+-- Test cases taken from: http://www.w3.org/2000/10/swap/uripath.py+-- (Thanks, Dan Connolly)+--+-- NOTE:  absoluteURI base (relativeRef base u) is always equivalent to u.+-- cf. http://lists.w3.org/Archives/Public/uri/2003Jan/0008.html++testRelSplit :: String -> String -> String -> String -> Test+testRelSplit label base uabs urel =+    testEq label urel (mkrel puabs pubas)+    where+        mkrel (Just u1) (Just u2) = show (u1 `relativeFrom` u2)+        mkrel Nothing   _         = "Invalid URI: "++urel+        mkrel _         Nothing   = "Invalid URI: "++uabs+        puabs = parseURIReference uabs+        pubas = parseURIReference base++testRelJoin  :: String -> String -> String -> String -> Test+testRelJoin label base urel uabs =+    testEq label uabs (mkabs purel pubas)+    where+        mkabs (Just u1) (Just u2) = shabs (u1 `relativeTo` u2)+        mkabs Nothing   _         = "Invalid URI: "++urel+        mkabs _         Nothing   = "Invalid URI: "++uabs+        shabs (Just u) = show u+        shabs Nothing  = "No result"+        purel = parseURIReference urel+        pubas = parseURIReference base++testRelative :: String -> String -> String -> String -> Test+testRelative label base uabs urel = TestList+    [+    (testRelSplit (label++"(rel)") base uabs urel),+    (testRelJoin  (label++"(abs)") base urel uabs)+    ]++testRelative01 = testRelative "testRelative01"+                    "foo:xyz" "bar:abc" "bar:abc"+testRelative02 = testRelative "testRelative02"+                    "http://example/x/y/z" "http://example/x/abc" "../abc"+testRelative03 = testRelative "testRelative03"+                    "http://example2/x/y/z" "http://example/x/abc" "//example/x/abc"+                    -- "http://example2/x/y/z" "http://example/x/abc" "http://example/x/abc"+testRelative04 = testRelative "testRelative04"+                    "http://ex/x/y/z" "http://ex/x/r" "../r"+testRelative05 = testRelative "testRelative05"+                    "http://ex/x/y/z" "http://ex/r" "/r"+                    -- "http://ex/x/y/z" "http://ex/r" "../../r"+testRelative06 = testRelative "testRelative06"+                    "http://ex/x/y/z" "http://ex/x/y/q/r" "q/r"+testRelative07 = testRelative "testRelative07"+                    "http://ex/x/y" "http://ex/x/q/r#s" "q/r#s"+testRelative08 = testRelative "testRelative08"+                    "http://ex/x/y" "http://ex/x/q/r#s/t" "q/r#s/t"+testRelative09 = testRelative "testRelative09"+                    "http://ex/x/y" "ftp://ex/x/q/r" "ftp://ex/x/q/r"+testRelative10 = testRelative "testRelative10"+                    -- "http://ex/x/y" "http://ex/x/y" "y"+                    "http://ex/x/y" "http://ex/x/y" ""+testRelative11 = testRelative "testRelative11"+                    -- "http://ex/x/y/" "http://ex/x/y/" "./"+                    "http://ex/x/y/" "http://ex/x/y/" ""+testRelative12 = testRelative "testRelative12"+                    -- "http://ex/x/y/pdq" "http://ex/x/y/pdq" "pdq"+                    "http://ex/x/y/pdq" "http://ex/x/y/pdq" ""+testRelative13 = testRelative "testRelative13"+                    "http://ex/x/y/" "http://ex/x/y/z/" "z/"+testRelative14 = testRelative "testRelative14"+                    -- "file:/swap/test/animal.rdf" "file:/swap/test/animal.rdf#Animal" "animal.rdf#Animal"+                    "file:/swap/test/animal.rdf" "file:/swap/test/animal.rdf#Animal" "#Animal"+testRelative15 = testRelative "testRelative15"+                    "file:/e/x/y/z" "file:/e/x/abc" "../abc"+testRelative16 = testRelative "testRelative16"+                    "file:/example2/x/y/z" "file:/example/x/abc" "/example/x/abc"+testRelative17 = testRelative "testRelative17"+                    "file:/ex/x/y/z" "file:/ex/x/r" "../r"+testRelative18 = testRelative "testRelative18"+                    "file:/ex/x/y/z" "file:/r" "/r"+testRelative19 = testRelative "testRelative19"+                    "file:/ex/x/y" "file:/ex/x/q/r" "q/r"+testRelative20 = testRelative "testRelative20"+                    "file:/ex/x/y" "file:/ex/x/q/r#s" "q/r#s"+testRelative21 = testRelative "testRelative21"+                    "file:/ex/x/y" "file:/ex/x/q/r#" "q/r#"+testRelative22 = testRelative "testRelative22"+                    "file:/ex/x/y" "file:/ex/x/q/r#s/t" "q/r#s/t"+testRelative23 = testRelative "testRelative23"+                    "file:/ex/x/y" "ftp://ex/x/q/r" "ftp://ex/x/q/r"+testRelative24 = testRelative "testRelative24"+                    -- "file:/ex/x/y" "file:/ex/x/y" "y"+                    "file:/ex/x/y" "file:/ex/x/y" ""+testRelative25 = testRelative "testRelative25"+                    -- "file:/ex/x/y/" "file:/ex/x/y/" "./"+                    "file:/ex/x/y/" "file:/ex/x/y/" ""+testRelative26 = testRelative "testRelative26"+                    -- "file:/ex/x/y/pdq" "file:/ex/x/y/pdq" "pdq"+                    "file:/ex/x/y/pdq" "file:/ex/x/y/pdq" ""+testRelative27 = testRelative "testRelative27"+                    "file:/ex/x/y/" "file:/ex/x/y/z/" "z/"+testRelative28 = testRelative "testRelative28"+                    "file:/devel/WWW/2000/10/swap/test/reluri-1.n3"+                    "file://meetings.example.com/cal#m1" "//meetings.example.com/cal#m1"+                    -- "file:/devel/WWW/2000/10/swap/test/reluri-1.n3"+                    -- "file://meetings.example.com/cal#m1" "file://meetings.example.com/cal#m1"+testRelative29 = testRelative "testRelative29"+                    "file:/home/connolly/w3ccvs/WWW/2000/10/swap/test/reluri-1.n3"+                    "file://meetings.example.com/cal#m1" "//meetings.example.com/cal#m1"+                    -- "file:/home/connolly/w3ccvs/WWW/2000/10/swap/test/reluri-1.n3"+                    -- "file://meetings.example.com/cal#m1" "file://meetings.example.com/cal#m1"+testRelative30 = testRelative "testRelative30"+                    "file:/some/dir/foo" "file:/some/dir/#blort" "./#blort"+testRelative31 = testRelative "testRelative31"+                    "file:/some/dir/foo" "file:/some/dir/#" "./#"+testRelative32 = testRelative "testRelative32"+                    "http://ex/x/y" "http://ex/x/q:r" "./q:r"+                    -- see RFC2396bis, section 5       ^^+testRelative33 = testRelative "testRelative33"+                    "http://ex/x/y" "http://ex/x/p=q:r" "./p=q:r"+                    -- "http://ex/x/y" "http://ex/x/p=q:r" "p=q:r"+testRelative34 = testRelative "testRelative34"+                    "http://ex/x/y?pp/qq" "http://ex/x/y?pp/rr" "?pp/rr"+testRelative35 = testRelative "testRelative35"+                    "http://ex/x/y?pp/qq" "http://ex/x/y/z" "y/z"+testRelative36 = testRelative "testRelative36"+                    "mailto:local"+                    "mailto:local/qual@domain.org#frag"+                    "local/qual@domain.org#frag"+testRelative37 = testRelative "testRelative37"+                    "mailto:local/qual1@domain1.org"+                    "mailto:local/more/qual2@domain2.org#frag"+                    "more/qual2@domain2.org#frag"+testRelative38 = testRelative "testRelative38"+                    "http://ex/x/z?q" "http://ex/x/y?q" "y?q"+testRelative39 = testRelative "testRelative39"+                    "http://ex?p" "http://ex/x/y?q" "/x/y?q"+testRelative40 = testRelative "testRelative40"+                    "foo:a/b" "foo:a/c/d" "c/d"+testRelative41 = testRelative "testRelative41"+                    "foo:a/b" "foo:/c/d" "/c/d"+testRelative42 = testRelative "testRelative42"+                    "foo:a/b?c#d" "foo:a/b?c" ""+testRelative43 = testRelative "testRelative42"+                    "foo:a" "foo:b/c" "b/c"+testRelative44 = testRelative "testRelative44"+                    "foo:/a/y/z" "foo:/a/b/c" "../b/c"+testRelative45 = testRelJoin "testRelative45"+                    "foo:a" "./b/c" "foo:b/c"+testRelative46 = testRelJoin "testRelative46"+                    "foo:a" "/./b/c" "foo:/b/c"+testRelative47 = testRelJoin "testRelative47"+                    "foo://a//b/c" "../../d" "foo://a/d"+testRelative48 = testRelJoin "testRelative48"+                    "foo:a" "." "foo:"+testRelative49 = testRelJoin "testRelative49"+                    "foo:a" ".." "foo:"++-- add escape tests+testRelative50 = testRelative "testRelative50"+                    "http://example/x/y%2Fz" "http://example/x/abc" "abc"+testRelative51 = testRelative "testRelative51"+                    "http://example/a/x/y/z" "http://example/a/x%2Fabc" "../../x%2Fabc"+testRelative52 = testRelative "testRelative52"+                    "http://example/a/x/y%2Fz" "http://example/a/x%2Fabc" "../x%2Fabc"+testRelative53 = testRelative "testRelative53"+                    "http://example/x%2Fy/z" "http://example/x%2Fy/abc" "abc"+testRelative54 = testRelative "testRelative54"+                    "http://ex/x/y" "http://ex/x/q%3Ar" "q%3Ar"+testRelative55 = testRelative "testRelative55"+                    "http://example/x/y%2Fz" "http://example/x%2Fabc" "/x%2Fabc"+-- Apparently, TimBL prefers the following way to 41, 42 above+-- cf. http://lists.w3.org/Archives/Public/uri/2003Feb/0028.html+-- He also notes that there may be different relative fuctions+-- that satisfy the basic equivalence axiom:+-- cf. http://lists.w3.org/Archives/Public/uri/2003Jan/0008.html+testRelative56 = testRelative "testRelative56"+                    "http://example/x/y/z" "http://example/x%2Fabc" "/x%2Fabc"+testRelative57 = testRelative "testRelative57"+                    "http://example/x/y%2Fz" "http://example/x%2Fabc" "/x%2Fabc"++-- Other oddball tests+    -- Check segment normalization code:+testRelative60 = testRelJoin "testRelative60"+                    "ftp://example/x/y" "http://example/a/b/../../c" "http://example/c"+testRelative61 = testRelJoin "testRelative61"+                    "ftp://example/x/y" "http://example/a/b/c/../../" "http://example/a/"+testRelative62 = testRelJoin "testRelative62"+                    "ftp://example/x/y" "http://example/a/b/c/./" "http://example/a/b/c/"+testRelative63 = testRelJoin "testRelative63"+                    "ftp://example/x/y" "http://example/a/b/c/.././" "http://example/a/b/"+testRelative64 = testRelJoin "testRelative64"+                    "ftp://example/x/y" "http://example/a/b/c/d/../../../../e" "http://example/e"+testRelative65 = testRelJoin "testRelative65"+                    "ftp://example/x/y" "http://example/a/b/c/d/../.././../../e" "http://example/e"+    -- Check handling of queries and fragments with non-relative paths+testRelative70 = testRelative "testRelative70"+                    "mailto:local1@domain1?query1" "mailto:local2@domain2"+                    "local2@domain2"+testRelative71 = testRelative "testRelative71"+                    "mailto:local1@domain1" "mailto:local2@domain2?query2"+                    "local2@domain2?query2"+testRelative72 = testRelative "testRelative72"+                    "mailto:local1@domain1?query1" "mailto:local2@domain2?query2"+                    "local2@domain2?query2"+testRelative73 = testRelative "testRelative73"+                    "mailto:local@domain?query1" "mailto:local@domain?query2"+                    "?query2"+testRelative74 = testRelative "testRelative74"+                    "mailto:?query1" "mailto:local@domain?query2"+                    "local@domain?query2"+testRelative75 = testRelative "testRelative75"+                    "mailto:local@domain?query1" "mailto:local@domain?query2"+                    "?query2"+testRelative76 = testRelative "testRelative76"+                    "foo:bar" "http://example/a/b?c/../d"  "http://example/a/b?c/../d"+testRelative77 = testRelative "testRelative77"+                    "foo:bar" "http://example/a/b#c/../d"  "http://example/a/b#c/../d"+{- These (78-81) are some awkward test cases thrown up by a question on the URI list:+     http://lists.w3.org/Archives/Public/uri/2005Jul/0013+   Mote that RFC 3986 discards path segents after the final '/' only when merging two+   paths - otherwise the final segment in the base URI is mnaintained.  This leads to+   difficulty in constructinmg a reversible relativeTo/relativeFrom pair of functions.+-}+testRelative78 = testRelative "testRelative78"+                    "http://www.example.com/data/limit/.." "http://www.example.com/data/limit/test.xml"+                    "test.xml"+testRelative79 = testRelative "testRelative79"+                    "file:/some/dir/foo" "file:/some/dir/#blort" "./#blort"+testRelative80 = testRelative "testRelative80"+                    "file:/some/dir/foo" "file:/some/dir/#" "./#"+testRelative81 = testRelative "testRelative81"+                    "file:/some/dir/.." "file:/some/dir/#blort" "./#blort"++-- testRelative  base abs rel+-- testRelSplit  base abs rel+-- testRelJoin   base rel abs+testRelative91 = testRelSplit "testRelative91"+                    "http://example.org/base/uri" "http:this"+                    "this"+testRelative92 = testRelJoin "testRelative92"+                    "http://example.org/base/uri" "http:this"+                    "http:this"+testRelative93 = testRelJoin "testRelative93"+                    "http:base" "http:this"+                    "http:this"+testRelative94 = testRelJoin "testRelative94"+                    "f:/a" ".//g"+                    "f://g"+testRelative95 = testRelJoin "testRelative95"+                    "f://example.org/base/a" "b/c//d/e"+                    "f://example.org/base/b/c//d/e"+testRelative96 = testRelJoin "testRelative96"+                    "mid:m@example.ord/c@example.org" "m2@example.ord/c2@example.org"+                    "mid:m@example.ord/m2@example.ord/c2@example.org"+testRelative97 = testRelJoin "testRelative97"+                    "file:///C:/DEV/Haskell/lib/HXmlToolbox-3.01/examples/" "mini1.xml"+                    "file:///C:/DEV/Haskell/lib/HXmlToolbox-3.01/examples/mini1.xml"+testRelative98 = testRelative "testRelative98"+                    "foo:a/y/z" "foo:a/b/c" "../b/c"+testRelative99 = testRelJoin "testRelative99"+                    "f:/a/" "..//g"+                    "f://g"+++testRelativeSuite = TestLabel "Test Relative URIs" testRelativeList+testRelativeList  = TestList+  [ testRelative01, testRelative02, testRelative03, testRelative04+  , testRelative05, testRelative06, testRelative07, testRelative08+  , testRelative09+  , testRelative10, testRelative11, testRelative12, testRelative13+  , testRelative14, testRelative15, testRelative16, testRelative17+  , testRelative18, testRelative19+  , testRelative20, testRelative21, testRelative22, testRelative23+  , testRelative24, testRelative25, testRelative26, testRelative27+  , testRelative28, testRelative29+  , testRelative30, testRelative31, testRelative32, testRelative33+  , testRelative34, testRelative35, testRelative36, testRelative37+  , testRelative38, testRelative39+  , testRelative40, testRelative41, testRelative42, testRelative43+  , testRelative44, testRelative45, testRelative46, testRelative47+  , testRelative48, testRelative49+    --+  , testRelative50, testRelative51, testRelative52, testRelative53+  , testRelative54, testRelative55, testRelative56, testRelative57+    --+  , testRelative60, testRelative61, testRelative62, testRelative63+  , testRelative64, testRelative65+    --+  , testRelative70, testRelative71, testRelative72, testRelative73+  , testRelative74, testRelative75, testRelative76, testRelative77+  -- Awkward cases:+  , testRelative78, testRelative79, testRelative80, testRelative81+    --+  -- , testRelative90+  , testRelative91, testRelative92, testRelative93+  , testRelative94, testRelative95, testRelative96+  , testRelative97, testRelative98, testRelative99+  ]++-- RFC2396 relative-to-absolute URI tests++rfcbase  = "http://a/b/c/d;p?q"+-- normal cases, RFC2396bis 5.4.1+testRFC01 = testRelJoin "testRFC01" rfcbase "g:h" "g:h"+testRFC02 = testRelJoin "testRFC02" rfcbase "g" "http://a/b/c/g"+testRFC03 = testRelJoin "testRFC03" rfcbase "./g" "http://a/b/c/g"+testRFC04 = testRelJoin "testRFC04" rfcbase "g/" "http://a/b/c/g/"+testRFC05 = testRelJoin "testRFC05" rfcbase "/g" "http://a/g"+testRFC06 = testRelJoin "testRFC06" rfcbase "//g" "http://g"+testRFC07 = testRelJoin "testRFC07" rfcbase "?y" "http://a/b/c/d;p?y"+testRFC08 = testRelJoin "testRFC08" rfcbase "g?y" "http://a/b/c/g?y"+testRFC09 = testRelJoin "testRFC09" rfcbase "?q#s" "http://a/b/c/d;p?q#s"+testRFC23 = testRelJoin "testRFC10" rfcbase "#s" "http://a/b/c/d;p?q#s"+testRFC10 = testRelJoin "testRFC11" rfcbase "g#s" "http://a/b/c/g#s"+testRFC11 = testRelJoin "testRFC12" rfcbase "g?y#s" "http://a/b/c/g?y#s"+testRFC12 = testRelJoin "testRFC13" rfcbase ";x" "http://a/b/c/;x"+testRFC13 = testRelJoin "testRFC14" rfcbase "g;x" "http://a/b/c/g;x"+testRFC14 = testRelJoin "testRFC15" rfcbase "g;x?y#s" "http://a/b/c/g;x?y#s"+testRFC24 = testRelJoin "testRFC16" rfcbase "" "http://a/b/c/d;p?q"+testRFC15 = testRelJoin "testRFC17" rfcbase "." "http://a/b/c/"+testRFC16 = testRelJoin "testRFC18" rfcbase "./" "http://a/b/c/"+testRFC17 = testRelJoin "testRFC19" rfcbase ".." "http://a/b/"+testRFC18 = testRelJoin "testRFC20" rfcbase "../" "http://a/b/"+testRFC19 = testRelJoin "testRFC21" rfcbase "../g" "http://a/b/g"+testRFC20 = testRelJoin "testRFC22" rfcbase "../.." "http://a/"+testRFC21 = testRelJoin "testRFC23" rfcbase "../../" "http://a/"+testRFC22 = testRelJoin "testRFC24" rfcbase "../../g" "http://a/g"+-- abnormal cases, RFC2396bis 5.4.2+testRFC31 = testRelJoin "testRFC31" rfcbase "?q" rfcbase+testRFC32 = testRelJoin "testRFC32" rfcbase "../../../g" "http://a/g"+testRFC33 = testRelJoin "testRFC33" rfcbase "../../../../g" "http://a/g"+testRFC34 = testRelJoin "testRFC34" rfcbase "/./g" "http://a/g"+testRFC35 = testRelJoin "testRFC35" rfcbase "/../g" "http://a/g"+testRFC36 = testRelJoin "testRFC36" rfcbase "g." "http://a/b/c/g."+testRFC37 = testRelJoin "testRFC37" rfcbase ".g" "http://a/b/c/.g"+testRFC38 = testRelJoin "testRFC38" rfcbase "g.." "http://a/b/c/g.."+testRFC39 = testRelJoin "testRFC39" rfcbase "..g" "http://a/b/c/..g"+testRFC40 = testRelJoin "testRFC40" rfcbase "./../g" "http://a/b/g"+testRFC41 = testRelJoin "testRFC41" rfcbase "./g/." "http://a/b/c/g/"+testRFC42 = testRelJoin "testRFC42" rfcbase "g/./h" "http://a/b/c/g/h"+testRFC43 = testRelJoin "testRFC43" rfcbase "g/../h" "http://a/b/c/h"+testRFC44 = testRelJoin "testRFC44" rfcbase "g;x=1/./y" "http://a/b/c/g;x=1/y"+testRFC45 = testRelJoin "testRFC45" rfcbase "g;x=1/../y" "http://a/b/c/y"+testRFC46 = testRelJoin "testRFC46" rfcbase "g?y/./x" "http://a/b/c/g?y/./x"+testRFC47 = testRelJoin "testRFC47" rfcbase "g?y/../x" "http://a/b/c/g?y/../x"+testRFC48 = testRelJoin "testRFC48" rfcbase "g#s/./x" "http://a/b/c/g#s/./x"+testRFC49 = testRelJoin "testRFC49" rfcbase "g#s/../x" "http://a/b/c/g#s/../x"+testRFC50 = testRelJoin "testRFC50" rfcbase "http:x" "http:x"++-- Null path tests+-- See RFC2396bis, section 5.2,+-- "If the base URI's path component is the empty string, then a single+--  slash character is copied to the buffer"+testRFC60 = testRelative "testRFC60" "http://ex"     "http://ex/x/y?q" "/x/y?q"+testRFC61 = testRelJoin  "testRFC61" "http://ex"     "x/y?q"           "http://ex/x/y?q"+testRFC62 = testRelative "testRFC62" "http://ex?p"   "http://ex/x/y?q" "/x/y?q"+testRFC63 = testRelJoin  "testRFC63" "http://ex?p"   "x/y?q"           "http://ex/x/y?q"+testRFC64 = testRelative "testRFC64" "http://ex#f"   "http://ex/x/y?q" "/x/y?q"+testRFC65 = testRelJoin  "testRFC65" "http://ex#f"   "x/y?q"           "http://ex/x/y?q"+testRFC66 = testRelative "testRFC66" "http://ex?p"   "http://ex/x/y#g" "/x/y#g"+testRFC67 = testRelJoin  "testRFC67" "http://ex?p"   "x/y#g"           "http://ex/x/y#g"+testRFC68 = testRelative "testRFC68" "http://ex"     "http://ex/"      "/"+testRFC69 = testRelJoin  "testRFC69" "http://ex"     "./"              "http://ex/"+testRFC70 = testRelative "testRFC70" "http://ex"     "http://ex/a/b"   "/a/b"+testRFC71 = testRelative "testRFC71" "http://ex/a/b" "http://ex"       "./"++testRFC2396Suite = TestLabel "Test RFC2396 examples" testRFC2396List+testRFC2396List  = TestList+  [+    testRFC01, testRFC02, testRFC03, testRFC04,+    testRFC05, testRFC06, testRFC07, testRFC08,+    testRFC09,+    testRFC10, testRFC11, testRFC12, testRFC13,+    testRFC14, testRFC15, testRFC16, testRFC17,+    testRFC18, testRFC19,+    testRFC20, testRFC21, testRFC22, testRFC23,+    testRFC24,+    -- testRFC30,+    testRFC31, testRFC32, testRFC33,+    testRFC34, testRFC35, testRFC36, testRFC37,+    testRFC38, testRFC39,+    testRFC40, testRFC41, testRFC42, testRFC43,+    testRFC44, testRFC45, testRFC46, testRFC47,+    testRFC48, testRFC49,+    testRFC50,+    --+    testRFC60, testRFC61, testRFC62, testRFC63,+    testRFC64, testRFC65, testRFC66, testRFC67,+    testRFC68, testRFC69,+    testRFC70+  ]++-- And some other oddballs:+mailbase = "mailto:local/option@domain.org?notaquery#frag"+testMail01 = testRelJoin "testMail01"+            mailbase "more@domain"+            "mailto:local/more@domain"+testMail02 = testRelJoin "testMail02"+            mailbase "#newfrag"+            "mailto:local/option@domain.org?notaquery#newfrag"+testMail03 = testRelJoin "testMail03"+            mailbase "l1/q1@domain"+            "mailto:local/l1/q1@domain"++testMail11 = testRelJoin "testMail11"+             "mailto:local1@domain1?query1" "mailto:local2@domain2"+             "mailto:local2@domain2"+testMail12 = testRelJoin "testMail12"+             "mailto:local1@domain1" "mailto:local2@domain2?query2"+             "mailto:local2@domain2?query2"+testMail13 = testRelJoin "testMail13"+             "mailto:local1@domain1?query1" "mailto:local2@domain2?query2"+             "mailto:local2@domain2?query2"+testMail14 = testRelJoin "testMail14"+             "mailto:local@domain?query1" "mailto:local@domain?query2"+             "mailto:local@domain?query2"+testMail15 = testRelJoin "testMail15"+             "mailto:?query1" "mailto:local@domain?query2"+             "mailto:local@domain?query2"+testMail16 = testRelJoin "testMail16"+             "mailto:local@domain?query1" "?query2"+             "mailto:local@domain?query2"+testInfo17 = testRelJoin "testInfo17"+             "info:name/1234/../567" "name/9876/../543"+             "info:name/name/543"+testInfo18 = testRelJoin "testInfo18"+             "info:/name/1234/../567" "name/9876/../543"+             "info:/name/name/543"++testOddballSuite = TestLabel "Test oddball examples" testOddballList+testOddballList  = TestList+  [ testMail01, testMail02, testMail03+  , testMail11, testMail12, testMail13, testMail14, testMail15, testMail16+  , testInfo17+  ]++--  Normalization tests++--  Case normalization; cf. RFC2396bis section 6.2.2.1+--  NOTE:  authority case normalization is not performed+testNormalize01 = testEq "testNormalize01"+                  "http://EXAMPLE.com/Root/%2A?%2B#%2C"+                  (normalizeCase "HTTP://EXAMPLE.com/Root/%2a?%2b#%2c")++--  Encoding normalization; cf. RFC2396bis section 6.2.2.2+testNormalize11 = testEq "testNormalize11"+                  "HTTP://EXAMPLE.com/Root/~Me/"+                  (normalizeEscape "HTTP://EXAMPLE.com/Root/%7eMe/")+testNormalize12 = testEq "testNormalize12"+                  "foo:%40AZ%5b%60az%7b%2f09%3a-._~"+                  (normalizeEscape "foo:%40%41%5a%5b%60%61%7a%7b%2f%30%39%3a%2d%2e%5f%7e")+testNormalize13 = testEq "testNormalize13"+                  "foo:%3a%2f%3f%23%5b%5d%40"+                  (normalizeEscape "foo:%3a%2f%3f%23%5b%5d%40")++--  Path segment normalization; cf. RFC2396bis section 6.2.2.4+testNormalize21 = testEq "testNormalize21"+                    "http://example/c"+                    (normalizePathSegments "http://example/a/b/../../c")+testNormalize22 = testEq "testNormalize22"+                    "http://example/a/"+                    (normalizePathSegments "http://example/a/b/c/../../")+testNormalize23 = testEq "testNormalize23"+                    "http://example/a/b/c/"+                    (normalizePathSegments "http://example/a/b/c/./")+testNormalize24 = testEq "testNormalize24"+                    "http://example/a/b/"+                    (normalizePathSegments "http://example/a/b/c/.././")+testNormalize25 = testEq "testNormalize25"+                    "http://example/e"+                    (normalizePathSegments "http://example/a/b/c/d/../../../../e")+testNormalize26 = testEq "testNormalize26"+                    "http://example/e"+                    (normalizePathSegments "http://example/a/b/c/d/../.././../../e")+testNormalize27 = testEq "testNormalize27"+                    "http://example/e"+                    (normalizePathSegments "http://example/a/b/../.././../../e")+testNormalize28 = testEq "testNormalize28"+                    "foo:e"+                    (normalizePathSegments "foo:a/b/../.././../../e")++testNormalizeSuite = TestList+  [ testNormalize01+  , testNormalize11+  , testNormalize12+  , testNormalize13+  , testNormalize21, testNormalize22, testNormalize23, testNormalize24+  , testNormalize25, testNormalize26, testNormalize27, testNormalize28+  ]++-- URI formatting (show) tests++ts02URI = URI   { uriScheme    = "http:"+                , uriAuthority = Just (URIAuth "user:pass@" "example.org" ":99")+                , uriPath      = "/aaa/bbb"+                , uriQuery     = "?ccc"+                , uriFragment  = "#ddd/eee"+                }++ts04URI = URI   { uriScheme    = "http:"+                , uriAuthority = Just (URIAuth "user:anonymous@" "example.org" ":99")+                , uriPath      = "/aaa/bbb"+                , uriQuery     = "?ccc"+                , uriFragment  = "#ddd/eee"+                }++ts02str = "http://user:...@example.org:99/aaa/bbb?ccc#ddd/eee"+ts03str = "http://user:pass@example.org:99/aaa/bbb?ccc#ddd/eee"+ts04str = "http://user:...@example.org:99/aaa/bbb?ccc#ddd/eee"++testShowURI01 = testEq "testShowURI01" ""      (show nullURI)+testShowURI02 = testEq "testShowURI02" ts02str (show ts02URI)+testShowURI03 = testEq "testShowURI03" ts03str ((uriToString id ts02URI) "")+testShowURI04 = testEq "testShowURI04" ts04str (show ts04URI)++testShowURI = TestList+  [ testShowURI01+  , testShowURI02+  , testShowURI03+  , testShowURI04+  ]+++-- URI escaping tests++te01str = "http://example.org/az/09-_/.~:/?#[]@!$&'()*+,;="+te02str = "http://example.org/a</b>/c%/d /e"+te02esc = "http://example.org/a%3C/b%3E/c%25/d%20/e"++testEscapeURIString01 = testEq "testEscapeURIString01"+    te01str (escapeURIString isUnescapedInURI te01str)++testEscapeURIString02 = testEq "testEscapeURIString02"+    te02esc (escapeURIString isUnescapedInURI te02str)++testEscapeURIString03 = testEq "testEscapeURIString03"+    te01str (unEscapeString te01str)++testEscapeURIString04 = testEq "testEscapeURIString04"+    te02str (unEscapeString te02esc)+++testEscapeURIString = TestList+  [ testEscapeURIString01+  , testEscapeURIString02+  , testEscapeURIString03+  , testEscapeURIString04+  ]++-- URI string normalization tests++tn01str = "eXAMPLE://a/b/%7bfoo%7d"+tn01nrm = "example://a/b/%7Bfoo%7D"++tn02str = "example://a/b/%63/"+tn02nrm = "example://a/b/c/"++tn03str = "example://a/./b/../b/c/foo"+tn03nrm = "example://a/b/c/foo"++tn04str = "eXAMPLE://a/b/%7bfoo%7d"     -- From RFC2396bis, 6.2.2+tn04nrm = "example://a/b/%7Bfoo%7D"++tn06str = "file:/x/..//y"+tn06nrm = "file://y"++tn07str = "file:x/..//y/"+tn07nrm = "file:/y/"++testNormalizeURIString01 = testEq "testNormalizeURIString01"+    tn01nrm (normalizeCase tn01str)+testNormalizeURIString02 = testEq "testNormalizeURIString02"+    tn02nrm (normalizeEscape tn02str)+testNormalizeURIString03 = testEq "testNormalizeURIString03"+    tn03nrm (normalizePathSegments tn03str)+testNormalizeURIString04 = testEq "testNormalizeURIString04"+    tn04nrm ((normalizeCase . normalizeEscape . normalizePathSegments) tn04str)+testNormalizeURIString05 = testEq "testNormalizeURIString05"+    tn04nrm ((normalizePathSegments . normalizeEscape . normalizeCase) tn04str)+testNormalizeURIString06 = testEq "testNormalizeURIString06"+    tn06nrm (normalizePathSegments tn06str)+testNormalizeURIString07 = testEq "testNormalizeURIString07"+    tn07nrm (normalizePathSegments tn07str)++testNormalizeURIString = TestList+  [ testNormalizeURIString01+  , testNormalizeURIString02+  , testNormalizeURIString03+  , testNormalizeURIString04+  , testNormalizeURIString05+  , testNormalizeURIString06+  , testNormalizeURIString07+  ]++tnus67 = runTestTT $ TestList+  [ testNormalizeURIString06+  , testNormalizeURIString07+  ]++-- Test strict vs non-strict relativeTo logic++trbase = fromJust $ parseURIReference "http://bar.org/"++testRelativeTo01 = testEq "testRelativeTo01"+    "http://bar.org/foo"+    (show . fromJust $+      (fromJust $ parseURIReference "foo") `relativeTo` trbase)++testRelativeTo02 = testEq "testRelativeTo02"+    "http:foo"+    (show . fromJust $+      (fromJust $ parseURIReference "http:foo") `relativeTo` trbase)++testRelativeTo03 = testEq "testRelativeTo03"+    "http://bar.org/foo"+    (show . fromJust $+      (fromJust $ parseURIReference "http:foo") `nonStrictRelativeTo` trbase)++testRelativeTo = TestList+  [ testRelativeTo01+  , testRelativeTo02+  , testRelativeTo03+  ]++-- Test alternative parsing functions+testAltFn01 = testEq "testAltFn01" "Just http://a.b/c#f"+    (show . parseURI $ "http://a.b/c#f")+testAltFn02 = testEq "testAltFn02" "Just http://a.b/c#f"+    (show . parseURIReference $ "http://a.b/c#f")+testAltFn03 = testEq "testAltFn03" "Just c/d#f"+    (show . parseRelativeReference $ "c/d#f")+testAltFn04 = testEq "testAltFn04" "Nothing"+    (show . parseRelativeReference $ "http://a.b/c#f")+testAltFn05 = testEq "testAltFn05" "Just http://a.b/c"+    (show . parseAbsoluteURI $ "http://a.b/c")+testAltFn06 = testEq "testAltFn06" "Nothing"+    (show . parseAbsoluteURI $ "http://a.b/c#f")+testAltFn07 = testEq "testAltFn07" "Nothing"+    (show . parseAbsoluteURI $ "c/d")+testAltFn08 = testEq "testAltFn08" "Just http://a.b/c"+    (show . parseabsoluteURI $ "http://a.b/c")++testAltFn11 = testEq "testAltFn11" True  (isURI "http://a.b/c#f")+testAltFn12 = testEq "testAltFn12" True  (isURIReference "http://a.b/c#f")+testAltFn13 = testEq "testAltFn13" True  (isRelativeReference "c/d#f")+testAltFn14 = testEq "testAltFn14" False (isRelativeReference "http://a.b/c#f")+testAltFn15 = testEq "testAltFn15" True  (isAbsoluteURI "http://a.b/c")+testAltFn16 = testEq "testAltFn16" False (isAbsoluteURI "http://a.b/c#f")+testAltFn17 = testEq "testAltFn17" False (isAbsoluteURI "c/d")++testAltFn = TestList+  [ testAltFn01+  , testAltFn02+  , testAltFn03+  , testAltFn04+  , testAltFn05+  , testAltFn06+  , testAltFn07+  , testAltFn08+  , testAltFn11+  , testAltFn12+  , testAltFn13+  , testAltFn14+  , testAltFn15+  , testAltFn16+  , testAltFn17+  ]++-- Full test suite+allTests = TestList+  [ testURIRefSuite+  , testComponentSuite+  , testRelativeSuite+  , testRFC2396Suite+  , testOddballSuite+  , testNormalizeSuite+  , testShowURI+  , testEscapeURIString+  , testNormalizeURIString+  , testRelativeTo+  , testAltFn+  ]++main = runTestTT allTests++runTestFile t = do+    h <- openFile "a.tmp" WriteMode+    runTestText (putTextToHandle h False) t+    hClose h+tf = runTestFile+tt = runTestTT++-- Miscellaneous values for hand-testing/debugging in Hugs:++uref = testURIRefSuite+tr01 = testRelative01+tr02 = testRelative02+tr03 = testRelative03+tr04 = testRelative04+rel  = testRelativeSuite+rfc  = testRFC2396Suite+oddb = testOddballSuite++(Just bu02) = parseURIReference "http://example/x/y/z"+(Just ou02) = parseURIReference "../abc"+(Just ru02) = parseURIReference "http://example/x/abc"+-- fileuri = testURIReference "file:///C:/DEV/Haskell/lib/HXmlToolbox-3.01/examples/"++cu02 = ou02 `relativeTo` bu02++--------------------------------------------------------------------------------+--+--  Copyright (c) 2004, G. KLYNE.  All rights reserved.+--  Distributed as free software under the following license.+--+--  Redistribution and use in source and binary forms, with or without+--  modification, are permitted provided that the following conditions+--  are met:+--+--  - Redistributions of source code must retain the above copyright notice,+--  this list of conditions and the following disclaimer.+--+--  - Redistributions in binary form must reproduce the above copyright+--  notice, this list of conditions and the following disclaimer in the+--  documentation and/or other materials provided with the distribution.+--+--  - Neither name of the copyright holders nor the names of its+--  contributors may be used to endorse or promote products derived from+--  this software without specific prior written permission.+--+--  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE CONTRIBUTORS+--  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+--  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+--  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+--  HOLDERS OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,+--  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+--  BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS+--  OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND+--  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR+--  TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE+--  USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+--+--------------------------------------------------------------------------------+-- $Source: /srv/cvs/cvs.haskell.org/fptools/libraries/network/tests/URITest.hs,v $+-- $Author: gklyne $+-- $Revision: 1.8 $+-- $Log: URITest.hs,v $+-- Revision 1.8  2005/07/19 22:01:27  gklyne+-- Added some additional test cases raised by discussion on URI@w3.org mailing list about 2005-07-19.  The test p[roposed by this discussion exposed a subtle bug in relativeFrom not being an exact inverse of relativeTo.+--+-- Revision 1.7  2005/06/06 16:31:44  gklyne+-- Added two new test cases.+--+-- Revision 1.6  2005/05/31 17:18:36  gklyne+-- Added some additional test cases triggered by URI-list discussions.+--+-- Revision 1.5  2005/04/07 11:09:37  gklyne+-- Added test cases for alternate parsing functions (including deprecated 'parseabsoluteURI')+--+-- Revision 1.4  2005/04/05 12:47:32  gklyne+-- Added test case.+-- Changed module name, now requires GHC -main-is to compile.+-- All tests run OK with GHC 6.4 on MS-Windows.+--+-- Revision 1.3  2004/11/05 17:29:09  gklyne+-- Changed password-obscuring logic to reflect late change in revised URI+-- specification (password "anonymous" is no longer a special case).+-- Updated URI test module to use function 'escapeURIString'.+-- (Should unEscapeString be similarly updated?)+--+-- Revision 1.2  2004/10/27 13:06:55  gklyne+-- Updated URI module function names per:+-- http://www.haskell.org//pipermail/cvs-libraries/2004-October/002916.html+-- Added test cases to give better covereage of module functions.+--+-- Revision 1.1  2004/10/14 16:11:30  gklyne+-- Add URI unit test to cvs.haskell.org repository+--+-- Revision 1.17  2004/10/14 11:51:09  graham+-- Confirm that URITest runs with GHC.+-- Fix up some comments and other minor details.+--+-- Revision 1.16  2004/10/14 11:45:30  graham+-- Use moduke name main for GHC 6.2+--+-- Revision 1.15  2004/08/11 11:07:39  graham+-- Add new test case.+--+-- Revision 1.14  2004/06/30 11:35:27  graham+-- Update URI code to use hierarchical libraries for Parsec and Network.+--+-- Revision 1.13  2004/06/22 16:19:16  graham+-- New URI test case added.+--+-- Revision 1.12  2004/04/21 15:13:29  graham+-- Add test case+--+-- Revision 1.11  2004/04/21 14:54:05  graham+-- Fix up some tests+--+-- Revision 1.10  2004/04/20 14:54:13  graham+-- Fix up test cases related to port number in authority,+-- and add some more URI decomposition tests.+--+-- Revision 1.9  2004/04/07 15:06:17  graham+-- Add extra test case+-- Revise syntax in line with changes to RFC2396bis+--+-- Revision 1.8  2004/03/17 14:34:58  graham+-- Add Network.HTTP files to CVS+--+-- Revision 1.7  2004/03/16 14:19:38  graham+-- Change licence to BSD style;  add nullURI definition; new test cases.+--+-- Revision 1.6  2004/02/20 12:12:00  graham+-- Add URI normalization functions+--+-- Revision 1.5  2004/02/19 23:19:35  graham+-- Network.URI module passes all test cases+--+-- Revision 1.4  2004/02/17 20:06:02  graham+-- Revised URI parser to reflect latest RFC2396bis (-04)+--+-- Revision 1.3  2004/02/11 14:32:14  graham+-- Added work-in-progress notes.+--+-- Revision 1.2  2004/02/02 14:00:39  graham+-- Fix optional host name in URI.  Add test cases.+--+-- Revision 1.1  2004/01/27 21:13:45  graham+-- New URI module and test suite added,+-- implementing the GHC Network.URI interface.+--