-----------------------------------------------------------------------------
-- |
-- Module      :  Network.Stream
-- Copyright   :  See LICENSE file
-- License     :  BSD
--
-- Maintainer  :  Ganesh Sittampalam <ganesh@earth.li>
-- Stability   :  experimental
-- Portability :  non-portable (not tested)
--
-- An library for creating abstract streams. Originally part of Gray's\/Bringert's
-- HTTP module.
--
-- * Changes by Robin Bate Boerop <robin@bateboerop.name>:
--      - Removed unnecessary import statements.
--      - Moved Debug code to StreamDebugger.hs
--      - Moved Socket-related code to StreamSocket.hs.
--
-- * Changes by Simon Foster:
--      - Split Network.HTTPmodule up into to separate
--        Network.[Stream,TCP,HTTP] modules
-----------------------------------------------------------------------------
module Network.Stream
   ( Stream(..)
   , ConnError(..)
   , Result
   , bindE
   , fmapE

   , failParse -- :: String -> Result a
   , failWith  -- :: ConnError -> Result a
   , failMisc  -- :: String -> Result a
   ) where

import Control.Monad.Error

data ConnError 
 = ErrorReset 
 | ErrorClosed
 | ErrorParse String
 | ErrorMisc String
   deriving(Int -> ConnError -> ShowS
[ConnError] -> ShowS
ConnError -> String
(Int -> ConnError -> ShowS)
-> (ConnError -> String)
-> ([ConnError] -> ShowS)
-> Show ConnError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnError] -> ShowS
$cshowList :: [ConnError] -> ShowS
show :: ConnError -> String
$cshow :: ConnError -> String
showsPrec :: Int -> ConnError -> ShowS
$cshowsPrec :: Int -> ConnError -> ShowS
Show,ConnError -> ConnError -> Bool
(ConnError -> ConnError -> Bool)
-> (ConnError -> ConnError -> Bool) -> Eq ConnError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnError -> ConnError -> Bool
$c/= :: ConnError -> ConnError -> Bool
== :: ConnError -> ConnError -> Bool
$c== :: ConnError -> ConnError -> Bool
Eq)

instance Error ConnError where
  noMsg :: ConnError
noMsg = String -> ConnError
forall a. Error a => String -> a
strMsg String
"unknown error"
  strMsg :: String -> ConnError
strMsg String
x = String -> ConnError
ErrorMisc String
x

-- in GHC 7.0 the Monad instance for Error no longer
-- uses fail x = Left (strMsg x). failMisc is therefore
-- used instead.
failMisc :: String -> Result a
failMisc :: String -> Result a
failMisc String
x = ConnError -> Result a
forall a. ConnError -> Result a
failWith (String -> ConnError
forall a. Error a => String -> a
strMsg String
x)

failParse :: String -> Result a
failParse :: String -> Result a
failParse String
x = ConnError -> Result a
forall a. ConnError -> Result a
failWith (String -> ConnError
ErrorParse String
x)

failWith :: ConnError -> Result a
failWith :: ConnError -> Result a
failWith ConnError
x = ConnError -> Result a
forall a b. a -> Either a b
Left ConnError
x

bindE :: Result a -> (a -> Result b) -> Result b
bindE :: Result a -> (a -> Result b) -> Result b
bindE (Left ConnError
e)  a -> Result b
_ = ConnError -> Result b
forall a b. a -> Either a b
Left ConnError
e
bindE (Right a
v) a -> Result b
f = a -> Result b
f a
v

fmapE :: (a -> Result b) -> IO (Result a) -> IO (Result b)
fmapE :: (a -> Result b) -> IO (Result a) -> IO (Result b)
fmapE a -> Result b
f IO (Result a)
a = do
 Result a
x <- IO (Result a)
a
 case Result a
x of
   Left  ConnError
e -> Result b -> IO (Result b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnError -> Result b
forall a b. a -> Either a b
Left ConnError
e)
   Right a
r -> Result b -> IO (Result b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Result b
f a
r) 
  
-- | This is the type returned by many exported network functions.
type Result a = Either ConnError   {- error  -}
                       a           {- result -}

-- | Streams should make layering of TLS protocol easier in future,
-- they allow reading/writing to files etc for debugging,
-- they allow use of protocols other than TCP/IP
-- and they allow customisation.
--
-- Instances of this class should not trim
-- the input in any way, e.g. leave LF on line
-- endings etc. Unless that is exactly the behaviour
-- you want from your twisted instances ;)
class Stream x where 
    readLine   :: x -> IO (Result String)
    readBlock  :: x -> Int -> IO (Result String)
    writeBlock :: x -> String -> IO (Result ())
    close      :: x -> IO ()
    closeOnEnd :: x -> Bool -> IO ()
      -- ^ True => shutdown the connection when response has been read / end-of-stream
      --           has been reached.