    {-# OPTIONS_GHC -fno-warn-orphans #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Network.StreamSocket
    -- Copyright   :  See LICENSE file
    -- License     :  BSD
    --
    -- Maintainer  :  Ganesh Sittampalam <http@projects.haskell.org>
    -- Stability   :  experimental
    -- Portability :  non-portable (not tested)
    --
    -- Socket Stream instance. Originally part of Gray's\/Bringert's HTTP module.
    --
    -- * Changes by Robin Bate Boerop <robin@bateboerop.name>:
    --      - Made dependencies explicit in import statements.
    --      - Removed false dependencies in import statements.
    --      - Created separate module for instance Stream Socket.
    --
    -- * Changes by Simon Foster:
    --      - Split module up into to sepearate Network.[Stream,TCP,HTTP] modules
    --
    -----------------------------------------------------------------------------
    module Network.StreamSocket
       ( handleSocketError
       , myrecv
       ) where

    import Network.Stream
       ( Stream(..), ConnError(ErrorReset, ErrorMisc), Result
       )
    import Network.Socket
       ( Socket, getSocketOption, shutdown, send, recv, sClose
       , ShutdownCmd(ShutdownBoth), SocketOption(SoError)
       )

    import Network.HTTP.Base ( catchIO )
    import Control.Monad (liftM)
    import Control.Exception as Exception (IOException)
    import System.IO.Error (isEOFError)

    -- | Exception handler for socket operations.
    handleSocketError :: Socket -> IOException -> IO (Result a)
    handleSocketError sk e =
        do se <- getSocketOption sk SoError
           case se of
              0     -> ioError e
              10054 -> return $ Left ErrorReset  -- reset
              _     -> return $ Left $ ErrorMisc $ show se

    myrecv :: Socket -> Int -> IO String
    myrecv sock len =
        let handler e = if isEOFError e then return [] else ioError e
            in catchIO (recv sock len) handler

    instance Stream Socket where
        readBlock sk n    = readBlockSocket sk n
        readLine sk       = readLineSocket sk
        writeBlock sk str = writeBlockSocket sk str
        close sk          = do
            -- This slams closed the connection (which is considered rude for TCP\/IP)
             shutdown sk ShutdownBoth
             sClose sk
        closeOnEnd _sk _  = return () -- can't really deal with this, so do run the risk of leaking sockets here.

    readBlockSocket :: Socket -> Int -> IO (Result String)
    readBlockSocket sk n = (liftM Right $ fn n) `catchIO` (handleSocketError sk)
      where
       fn x = do { str <- myrecv sk x
                 ; let len = length str
                 ; if len < x
                    then ( fn (x-len) >>= \more -> return (str++more) )
                    else return str
                 }

    -- Use of the following function is discouraged.
    -- The function reads in one character at a time,
    -- which causes many calls to the kernel recv()
    -- hence causes many context switches.
    readLineSocket :: Socket -> IO (Result String)
    readLineSocket sk = (liftM Right $ fn "") `catchIO` (handleSocketError sk)
      where
       fn str = do
         c <- myrecv sk 1 -- like eating through a straw.
         if null c || c == "\n"
          then return (reverse str++c)
          else fn (head c:str)

    writeBlockSocket :: Socket -> String -> IO (Result ())
    writeBlockSocket sk str = (liftM Right $ fn str) `catchIO` (handleSocketError sk)
      where
       fn [] = return ()
       fn x  = send sk x >>= \i -> fn (drop i x)