------------------------------------------------------------------------------- |-- 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 (Dbg h x )n =doval <-readBlock x n hPutStrLnh ("--readBlock "++shown )hPutStrLnh (showval )returnval readLine (Dbg h x )=doval <-readLine x hPutStrLnh ("--readLine")hPutStrLnh (showval )returnval writeBlock (Dbg h x )str =doval <-writeBlock x str hPutStrLnh ("--writeBlock"++showstr )hPutStrLnh (showval )returnval close (Dbg h x )=dohPutStrLnh "--closing..."hFlushh close x hPutStrLnh "--closed."hCloseh closeOnEnd (Dbg h x )f =dohPutStrLnh ("--close-on-end.."++showf )hFlushh closeOnEnd x 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 file stream =doh <-openFilefile AppendModehPutStrLnh ("File \""++file ++"\" opened for appending.")return(Dbg h stream )debugByteStream::HStream ty =>FilePath->HandleStream ty ->IO(HandleStream ty )debugByteStream file stream =dosh <-getStreamHooks stream casesh ofJusth |hook_nameh ==file ->returnstream -- reuse the stream hooks._->doh <-openFilefile AppendModehSetBufferingh NoBufferinghPutStrLnh ("File \""++file ++"\" opened for appending.")setStreamHooks stream (debugStreamHooks h file )returnstream debugStreamHooks::HStream ty =>Handle->String->StreamHooks ty debugStreamHooks h nm =StreamHooks {hook_readBlock=\toStr n val ->doleteval =caseval of{Lefte ->Lefte ;Rightv ->Right$toStr v }hPutStrLnh ("--readBlock "++shown )hPutStrLnh (eithershowshoweval ),hook_readLine=\toStr val ->doleteval =caseval of{Lefte ->Lefte ;Rightv ->Right$toStr v }hPutStrLnh ("--readLine")hPutStrLnh (eithershowshoweval ),hook_writeBlock=\toStr str val ->dohPutStrLnh ("--writeBlock "++showval )hPutStrLnh (toStr str ),hook_close=dohPutStrLnh "--closing..."hFlushh hCloseh ,hook_name=nm }