-- ------------------------------------------------------------------------------- Copyright 2002, Simon Marlow.-- Copyright 2006, Bjorn Bringert.-- Copyright 2009, Henning Thielemann.-- All rights reserved.---- 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 the name of the copyright holder(s) nor the names of-- 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 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-- OWNER OR 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.-- -----------------------------------------------------------------------------moduleNetwork.MoHWS.Logger(Handle,start,stop,log,)whereimportNetwork.MoHWS.Utility(dirname,)importqualifiedControl.ExceptionasExceptionimportControl.Exception(SomeException(SomeException),)importControl.Concurrent(Chan,ThreadId,newChan,forkIO,writeChan,readChan,)importSystem.Directory(createDirectoryIfMissing,)importSystem.IO(IOMode(AppendMode),hPutStrLn,stderr,hClose,hFlush,)importqualifiedSystem.IOasIOimportPreludehiding(log,)dataHandlea=Handle{handleChan::Chan(Commanda),handleThreadId::ThreadId}dataTa=Cons{chan::Chan(Commanda),format::(a->IOString),file::FilePath}dataCommanda=Stop|Logastart::(a->IOString)-- ^ Message formatting function->FilePath-- ^ log file path->IO(Handlea)startformat0file0=dochan0<-newChancreateDirectoryIfMissingTrue(dirnamefile0)letl=Cons{chan=chan0,format=format0,file=file0}t<-forkIO$runl`Exception.catch`\(SomeExceptione)->hPutStrLnstderr("Error starting logger: "++showe)return$Handle{handleChan=chan0,handleThreadId=t}stop::Handlea->IO()stopl=writeChan(handleChanl)Stoplog::Handlea->a->IO()loglx=writeChan(handleChanl)(Logx)-- Internalsrun::Ta->IO()runl=run1l`Exception.catch`\(SomeExceptione)->dohPutStrLnstderr("Logger died: "++showe)runlrun1::Ta->IO()run1l=Exception.bracket(openFile(filel))(\hdl->hClosehdl)(\hdl->handleCommandslhdl)whereopenFile::FilePath->IOIO.HandleopenFilef=IO.openFilefAppendMode`Exception.catch`\(SomeExceptione)->dohPutStrLnstderr("Failed to open log file: "++showe)Exception.throwehandleCommands::Ta->IO.Handle->IO()handleCommandslhdl=docomm<-readChan(chanl)casecommofStop->return()Logx->dowriteLinehdl=<<formatlxhandleCommandslhdlwherewriteLine::IO.Handle->String->IO()writeLinehndlstr=dohPutStrLnhndlstrhFlushhndl