------------------------------------------------------------------------------- |-- Module : Network.StreamDebugger-- Copyright : See LICENSE file-- License : BSD---- Maintainer : Ganesh Sittampalam <ganesh@earth.li>-- Stability : experimental-- Portability : non-portable (not tested)---- Implements debugging of @Stream@s. Originally part of Gray's\/Bringert's-- HTTP module.---- * Changes by Robin Bate Boerop <robin@bateboerop.name>:-- - Created. Made minor formatting changes.-------------------------------------------------------------------------------moduleNetwork.StreamDebugger(StreamDebugger ,debugStream ,debugByteStream )whereimportNetwork.Stream (Stream (..))importSystem.IO(Handle,hFlush,hPutStrLn,IOMode(AppendMode),hClose,openFile,hSetBuffering,BufferMode(NoBuffering))importNetwork.TCP (HandleStream ,HStream ,StreamHooks (..),setStreamHooks ,getStreamHooks )-- | Allows stream logging. Refer to 'debugStream' below.dataStreamDebugger x =Dbg Handlex instance(Stream x )=>Stream (StreamDebugger x )wherereadBlock :: StreamDebugger x -> Int -> IO (Result String)
readBlock (Dbg Handle
h x
x )Int
n =doResult String
val <-x -> Int -> IO (Result String)
forall x. Stream x => x -> Int -> IO (Result String)
readBlock x
x Int
n Handle -> String -> IO ()
hPutStrLnHandle
h (String
"--readBlock "String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
showInt
n )Handle -> String -> IO ()
hPutStrLnHandle
h (Result String -> String
forall a. Show a => a -> String
showResult String
val )Result String -> IO (Result String)
forall (m :: * -> *) a. Monad m => a -> m a
returnResult String
val readLine :: StreamDebugger x -> IO (Result String)
readLine (Dbg Handle
h x
x )=doResult String
val <-x -> IO (Result String)
forall x. Stream x => x -> IO (Result String)
readLine x
x Handle -> String -> IO ()
hPutStrLnHandle
h (String
"--readLine")Handle -> String -> IO ()
hPutStrLnHandle
h (Result String -> String
forall a. Show a => a -> String
showResult String
val )Result String -> IO (Result String)
forall (m :: * -> *) a. Monad m => a -> m a
returnResult String
val writeBlock :: StreamDebugger x -> String -> IO (Result ())
writeBlock (Dbg Handle
h x
x )String
str =doResult ()
val <-x -> String -> IO (Result ())
forall x. Stream x => x -> String -> IO (Result ())
writeBlock x
x String
str Handle -> String -> IO ()
hPutStrLnHandle
h (String
"--writeBlock"String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String
forall a. Show a => a -> String
showString
str )Handle -> String -> IO ()
hPutStrLnHandle
h (Result () -> String
forall a. Show a => a -> String
showResult ()
val )Result () -> IO (Result ())
forall (m :: * -> *) a. Monad m => a -> m a
returnResult ()
val close :: StreamDebugger x -> IO ()
close (Dbg Handle
h x
x )=doHandle -> String -> IO ()
hPutStrLnHandle
h String
"--closing..."Handle -> IO ()
hFlushHandle
h x -> IO ()
forall x. Stream x => x -> IO ()
close x
x Handle -> String -> IO ()
hPutStrLnHandle
h String
"--closed."Handle -> IO ()
hCloseHandle
h closeOnEnd :: StreamDebugger x -> Bool -> IO ()
closeOnEnd (Dbg Handle
h x
x )Bool
f =doHandle -> String -> IO ()
hPutStrLnHandle
h (String
"--close-on-end.."String -> String -> String
forall a. [a] -> [a] -> [a]
++Bool -> String
forall a. Show a => a -> String
showBool
f )Handle -> IO ()
hFlushHandle
h x -> Bool -> IO ()
forall x. Stream x => x -> Bool -> IO ()
closeOnEnd x
x Bool
f -- | Wraps a stream with logging I\/O.-- The first argument is a filename which is opened in @AppendMode@.debugStream ::(Stream a )=>FilePath->a ->IO(StreamDebugger a )debugStream :: String -> a -> IO (StreamDebugger a)
debugStream String
file a
stream =doHandle
h <-String -> IOMode -> IO Handle
openFileString
file IOMode
AppendModeHandle -> String -> IO ()
hPutStrLnHandle
h (String
"File \""String -> String -> String
forall a. [a] -> [a] -> [a]
++String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\" opened for appending.")StreamDebugger a -> IO (StreamDebugger a)
forall (m :: * -> *) a. Monad m => a -> m a
return(Handle -> a -> StreamDebugger a
forall x. Handle -> x -> StreamDebugger x
Dbg Handle
h a
stream )debugByteStream ::HStream ty =>FilePath->HandleStream ty ->IO(HandleStream ty )debugByteStream :: String -> HandleStream ty -> IO (HandleStream ty)
debugByteStream String
file HandleStream ty
stream =doMaybe (StreamHooks ty)
sh <-HandleStream ty -> IO (Maybe (StreamHooks ty))
forall ty. HandleStream ty -> IO (Maybe (StreamHooks ty))
getStreamHooks HandleStream ty
stream caseMaybe (StreamHooks ty)
sh ofJustStreamHooks ty
h |StreamHooks ty -> String
forall ty. StreamHooks ty -> String
hook_name StreamHooks ty
h String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
file ->HandleStream ty -> IO (HandleStream ty)
forall (m :: * -> *) a. Monad m => a -> m a
returnHandleStream ty
stream -- reuse the stream hooks.Maybe (StreamHooks ty)
_->doHandle
h <-String -> IOMode -> IO Handle
openFileString
file IOMode
AppendModeHandle -> BufferMode -> IO ()
hSetBufferingHandle
h BufferMode
NoBufferingHandle -> String -> IO ()
hPutStrLnHandle
h (String
"File \""String -> String -> String
forall a. [a] -> [a] -> [a]
++String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\" opened for appending.")HandleStream ty -> StreamHooks ty -> IO ()
forall ty. HandleStream ty -> StreamHooks ty -> IO ()
setStreamHooks HandleStream ty
stream (Handle -> String -> StreamHooks ty
forall ty. HStream ty => Handle -> String -> StreamHooks ty
debugStreamHooks Handle
h String
file )HandleStream ty -> IO (HandleStream ty)
forall (m :: * -> *) a. Monad m => a -> m a
returnHandleStream ty
stream debugStreamHooks ::HStream ty =>Handle->String->StreamHooks ty debugStreamHooks :: Handle -> String -> StreamHooks ty
debugStreamHooks Handle
h String
nm =StreamHooks :: forall ty.
((ty -> String) -> Result ty -> IO ())
-> ((ty -> String) -> Int -> Result ty -> IO ())
-> ((ty -> String) -> ty -> Result () -> IO ())
-> IO ()
-> String
-> StreamHooks ty
StreamHooks {hook_readBlock :: (ty -> String) -> Int -> Result ty -> IO ()
hook_readBlock =\ty -> String
toStr Int
n Result ty
val ->doleteval :: Result String
eval =caseResult ty
val of{LeftConnError
e ->ConnError -> Result String
forall a b. a -> Either a b
LeftConnError
e ;Rightty
v ->String -> Result String
forall a b. b -> Either a b
Right(String -> Result String) -> String -> Result String
forall a b. (a -> b) -> a -> b
$ty -> String
toStr ty
v }Handle -> String -> IO ()
hPutStrLnHandle
h (String
"--readBlock "String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
showInt
n )Handle -> String -> IO ()
hPutStrLnHandle
h ((ConnError -> String)
-> (String -> String) -> Result String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
eitherConnError -> String
forall a. Show a => a -> String
showString -> String
forall a. Show a => a -> String
showResult String
eval ),hook_readLine :: (ty -> String) -> Result ty -> IO ()
hook_readLine =\ty -> String
toStr Result ty
val ->doleteval :: Result String
eval =caseResult ty
val of{LeftConnError
e ->ConnError -> Result String
forall a b. a -> Either a b
LeftConnError
e ;Rightty
v ->String -> Result String
forall a b. b -> Either a b
Right(String -> Result String) -> String -> Result String
forall a b. (a -> b) -> a -> b
$ty -> String
toStr ty
v }Handle -> String -> IO ()
hPutStrLnHandle
h (String
"--readLine")Handle -> String -> IO ()
hPutStrLnHandle
h ((ConnError -> String)
-> (String -> String) -> Result String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
eitherConnError -> String
forall a. Show a => a -> String
showString -> String
forall a. Show a => a -> String
showResult String
eval ),hook_writeBlock :: (ty -> String) -> ty -> Result () -> IO ()
hook_writeBlock =\ty -> String
toStr ty
str Result ()
val ->doHandle -> String -> IO ()
hPutStrLnHandle
h (String
"--writeBlock "String -> String -> String
forall a. [a] -> [a] -> [a]
++Result () -> String
forall a. Show a => a -> String
showResult ()
val )Handle -> String -> IO ()
hPutStrLnHandle
h (ty -> String
toStr ty
str ),hook_close :: IO ()
hook_close =doHandle -> String -> IO ()
hPutStrLnHandle
h String
"--closing..."Handle -> IO ()
hFlushHandle
h Handle -> IO ()
hCloseHandle
h ,hook_name :: String
hook_name =String
nm }