diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -0,0 +1,510 @@ + + GNU LESSER GENERAL PUBLIC LICENSE + Version 2.1, February 1999 + + Copyright (C) 1991, 1999 Free Software Foundation, Inc. + 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +[This is the first released version of the Lesser GPL. It also counts + as the successor of the GNU Library Public License, version 2, hence + the version number 2.1.] + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software--to make sure the software is free for all its users. + + This license, the Lesser General Public License, applies to some +specially designated software packages--typically libraries--of the +Free Software Foundation and other authors who decide to use it. You +can use it too, but we suggest you first think carefully about whether +this license or the ordinary General Public License is the better +strategy to use in any particular case, based on the explanations +below. + + When we speak of free software, we are referring to freedom of use, +not price. Our General Public Licenses are designed to make sure that +you have the freedom to distribute copies of free software (and charge +for this service if you wish); that you receive source code or can get +it if you want it; that you can change the software and use pieces of +it in new free programs; and that you are informed that you can do +these things. + + To protect your rights, we need to make restrictions that forbid +distributors to deny you these rights or to ask you to surrender these +rights. These restrictions translate to certain responsibilities for +you if you distribute copies of the library or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link other code with the library, you must provide +complete object files to the recipients, so that they can relink them +with the library after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + We protect your rights with a two-step method: (1) we copyright the +library, and (2) we offer you this license, which gives you legal +permission to copy, distribute and/or modify the library. + + To protect each distributor, we want to make it very clear that +there is no warranty for the free library. Also, if the library is +modified by someone else and passed on, the recipients should know +that what they have is not the original version, so that the original +author's reputation will not be affected by problems that might be +introduced by others. + + Finally, software patents pose a constant threat to the existence of +any free program. We wish to make sure that a company cannot +effectively restrict the users of a free program by obtaining a +restrictive license from a patent holder. Therefore, we insist that +any patent license obtained for a version of the library must be +consistent with the full freedom of use specified in this license. + + Most GNU software, including some libraries, is covered by the +ordinary GNU General Public License. This license, the GNU Lesser +General Public License, applies to certain designated libraries, and +is quite different from the ordinary General Public License. We use +this license for certain libraries in order to permit linking those +libraries into non-free programs. + + When a program is linked with a library, whether statically or using +a shared library, the combination of the two is legally speaking a +combined work, a derivative of the original library. The ordinary +General Public License therefore permits such linking only if the +entire combination fits its criteria of freedom. The Lesser General +Public License permits more lax criteria for linking other code with +the library. + + We call this license the "Lesser" General Public License because it +does Less to protect the user's freedom than the ordinary General +Public License. It also provides other free software developers Less +of an advantage over competing non-free programs. These disadvantages +are the reason we use the ordinary General Public License for many +libraries. However, the Lesser license provides advantages in certain +special circumstances. + + For example, on rare occasions, there may be a special need to +encourage the widest possible use of a certain library, so that it +becomes a de-facto standard. To achieve this, non-free programs must +be allowed to use the library. A more frequent case is that a free +library does the same job as widely used non-free libraries. In this +case, there is little to gain by limiting the free library to free +software only, so we use the Lesser General Public License. + + In other cases, permission to use a particular library in non-free +programs enables a greater number of people to use a large body of +free software. For example, permission to use the GNU C Library in +non-free programs enables many more people to use the whole GNU +operating system, as well as its variant, the GNU/Linux operating +system. + + Although the Lesser General Public License is Less protective of the +users' freedom, it does ensure that the user of a program that is +linked with the Library has the freedom and the wherewithal to run +that program using a modified version of the Library. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +"work based on the library" and a "work that uses the library". The +former contains code derived from the library, whereas the latter must +be combined with the library in order to run. + + GNU LESSER GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library or other +program which contains a notice placed by the copyright holder or +other authorized party saying it may be distributed under the terms of +this Lesser General Public License (also called "this License"). +Each licensee is addressed as "you". + + A "library" means a collection of software functions and/or data +prepared so as to be conveniently linked with application programs +(which use some of those functions and data) to form executables. + + The "Library", below, refers to any such software library or work +which has been distributed under these terms. A "work based on the +Library" means either the Library or any derivative work under +copyright law: that is to say, a work containing the Library or a +portion of it, either verbatim or with modifications and/or translated +straightforwardly into another language. (Hereinafter, translation is +included without limitation in the term "modification".) + + "Source code" for a work means the preferred form of the work for +making modifications to it. For a library, complete source code means +all the source code for all modules it contains, plus any associated +interface definition files, plus the scripts used to control +compilation and installation of the library. + + Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running a program using the Library is not restricted, and output from +such a program is covered only if its contents constitute a work based +on the Library (independent of the use of the Library in a tool for +writing it). Whether that is true depends on what the Library does +and what the program that uses the Library does. + + 1. You may copy and distribute verbatim copies of the Library's +complete source code as you receive it, in any medium, provided that +you conspicuously and appropriately publish on each copy an +appropriate copyright notice and disclaimer of warranty; keep intact +all the notices that refer to this License and to the absence of any +warranty; and distribute a copy of this License along with the +Library. + + You may charge a fee for the physical act of transferring a copy, +and you may at your option offer warranty protection in exchange for a +fee. + + 2. You may modify your copy or copies of the Library or any portion +of it, thus forming a work based on the Library, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + + b) You must cause the files modified to carry prominent notices + stating that you changed the files and the date of any change. + + c) You must cause the whole of the work to be licensed at no + charge to all third parties under the terms of this License. + + d) If a facility in the modified Library refers to a function or a + table of data to be supplied by an application program that uses + the facility, other than as an argument passed when the facility + is invoked, then you must make a good faith effort to ensure that, + in the event an application does not supply such function or + table, the facility still operates, and performs whatever part of + its purpose remains meaningful. + + (For example, a function in a library to compute square roots has + a purpose that is entirely well-defined independent of the + application. Therefore, Subsection 2d requires that any + application-supplied function or table used by this function must + be optional: if the application does not supply it, the square + root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Library, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Library, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library +with the Library (or with a work based on the Library) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may opt to apply the terms of the ordinary GNU General Public +License instead of this License to a given copy of the Library. To do +this, you must alter all the notices that refer to this License, so +that they refer to the ordinary GNU General Public License, version 2, +instead of to this License. (If a newer version than version 2 of the +ordinary GNU General Public License has appeared, then you can specify +that version instead if you wish.) Do not make any other change in +these notices. + + Once this change is made in a given copy, it is irreversible for +that copy, so the ordinary GNU General Public License applies to all +subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of +the Library into a program that is not a library. + + 4. You may copy and distribute the Library (or a portion or +derivative of it, under Section 2) in object code or executable form +under the terms of Sections 1 and 2 above provided that you accompany +it with the complete corresponding machine-readable source code, which +must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the +source code from the same place satisfies the requirement to +distribute the source code, even though third parties are not +compelled to copy the source along with the object code. + + 5. A program that contains no derivative of any portion of the +Library, but is designed to work with the Library by being compiled or +linked with it, is called a "work that uses the Library". Such a +work, in isolation, is not a derivative work of the Library, and +therefore falls outside the scope of this License. + + However, linking a "work that uses the Library" with the Library +creates an executable that is a derivative of the Library (because it +contains portions of the Library), rather than a "work that uses the +library". The executable is therefore covered by this License. +Section 6 states terms for distribution of such executables. + + When a "work that uses the Library" uses material from a header file +that is part of the Library, the object code for the work may be a +derivative work of the Library even though the source code is not. +Whether this is true is especially significant if the work can be +linked without the Library, or if the work is itself a library. The +threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data +structure layouts and accessors, and small macros and small inline +functions (ten lines or less in length), then the use of the object +file is unrestricted, regardless of whether it is legally a derivative +work. (Executables containing this object code plus portions of the +Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may +distribute the object code for the work under the terms of Section 6. +Any executables containing that work also fall under Section 6, +whether or not they are linked directly with the Library itself. + + 6. As an exception to the Sections above, you may also combine or +link a "work that uses the Library" with the Library to produce a +work containing portions of the Library, and distribute that work +under terms of your choice, provided that the terms permit +modification of the work for the customer's own use and reverse +engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the +Library is used in it and that the Library and its use are covered by +this License. You must supply a copy of this License. If the work +during execution displays copyright notices, you must include the +copyright notice for the Library among them, as well as a reference +directing the user to the copy of this License. Also, you must do one +of these things: + + a) Accompany the work with the complete corresponding + machine-readable source code for the Library including whatever + changes were used in the work (which must be distributed under + Sections 1 and 2 above); and, if the work is an executable linked + with the Library, with the complete machine-readable "work that + uses the Library", as object code and/or source code, so that the + user can modify the Library and then relink to produce a modified + executable containing the modified Library. (It is understood + that the user who changes the contents of definitions files in the + Library will not necessarily be able to recompile the application + to use the modified definitions.) + + b) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (1) uses at run time a + copy of the library already present on the user's computer system, + rather than copying library functions into the executable, and (2) + will operate properly with a modified version of the library, if + the user installs one, as long as the modified version is + interface-compatible with the version that the work was made with. + + c) Accompany the work with a written offer, valid for at least + three years, to give the same user the materials specified in + Subsection 6a, above, for a charge no more than the cost of + performing this distribution. + + d) If distribution of the work is made by offering access to copy + from a designated place, offer equivalent access to copy the above + specified materials from the same place. + + e) Verify that the user has already received a copy of these + materials or that you have already sent this user a copy. + + For an executable, the required form of the "work that uses the +Library" must include any data and utility programs needed for +reproducing the executable from it. However, as a special exception, +the materials to be distributed need not include anything that is +normally distributed (in either source or binary form) with the major +components (compiler, kernel, and so on) of the operating system on +which the executable runs, unless that component itself accompanies +the executable. + + It may happen that this requirement contradicts the license +restrictions of other proprietary libraries that do not normally +accompany the operating system. Such a contradiction means you cannot +use both them and the Library together in an executable that you +distribute. + + 7. You may place library facilities that are a work based on the +Library side-by-side in a single library together with other library +facilities not covered by this License, and distribute such a combined +library, provided that the separate distribution of the work based on +the Library and of the other library facilities is otherwise +permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work + based on the Library, uncombined with any other library + facilities. This must be distributed under the terms of the + Sections above. + + b) Give prominent notice with the combined library of the fact + that part of it is a work based on the Library, and explaining + where to find the accompanying uncombined form of the same work. + + 8. You may not copy, modify, sublicense, link with, or distribute +the Library except as expressly provided under this License. Any +attempt otherwise to copy, modify, sublicense, link with, or +distribute the Library is void, and will automatically terminate your +rights under this License. However, parties who have received copies, +or rights, from you under this License will not have their licenses +terminated so long as such parties remain in full compliance. + + 9. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Library or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Library (or any work based on the +Library), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Library or works based on it. + + 10. Each time you redistribute the Library (or any work based on the +Library), the recipient automatically receives a license from the +original licensor to copy, distribute, link with or modify the Library +subject to these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties with +this License. + + 11. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Library at all. For example, if a patent +license would not permit royalty-free redistribution of the Library by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply, and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 12. If the distribution and/or use of the Library is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Library under this License +may add an explicit geographical distribution limitation excluding those +countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 13. The Free Software Foundation may publish revised and/or new +versions of the Lesser General Public License from time to time. +Such new versions will be similar in spirit to the present version, +but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Library +specifies a version number of this License which applies to it and +"any later version", you have the option of following the terms and +conditions either of that version or of any later version published by +the Free Software Foundation. If the Library does not specify a +license version number, you may choose any version ever published by +the Free Software Foundation. + + 14. If you wish to incorporate parts of the Library into other free +programs whose distribution conditions are incompatible with these, +write to the author to ask for permission. For software which is +copyrighted by the Free Software Foundation, write to the Free +Software Foundation; we sometimes make exceptions for this. Our +decision will be guided by the two goals of preserving the free status +of all derivatives of our free software and of promoting the sharing +and reuse of software generally. + + NO WARRANTY + + 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY +KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY +AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU +FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR +CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Libraries + + If you develop a new library, and you want it to be of the greatest +possible use to the public, we recommend making it free software that +everyone can redistribute and change. You can do so by permitting +redistribution under these terms (or, alternatively, under the terms +of the ordinary General Public License). + + To apply these terms, attach the following notices to the library. +It is safest to attach them to the start of each source file to most +effectively convey the exclusion of warranty; and each file should +have at least the "copyright" line and a pointer to where the full +notice is found. + + + + Copyright (C) + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +Also add information on how to contact you by electronic and paper mail. + +You should also get your employer (if you work as a programmer) or +your school, if any, to sign a "copyright disclaimer" for the library, +if necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + library `Frob' (a library for tweaking knobs) written by James + Random Hacker. + + , 1 April 1990 + Ty Coon, President of Vice + +That's all there is to it! + + diff --git a/COPYRIGHT b/COPYRIGHT new file mode 100644 --- /dev/null +++ b/COPYRIGHT @@ -0,0 +1,25 @@ +hslogger +Copyright (C) 2004-2006 John Goerzen + +All code is under the following license unless otherwise noted: + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation; either version 2.1 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Lesser General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + +The GNU General Public License is available in the file COPYING in the source +distribution. Debian GNU/Linux users may find this in +/usr/share/common-licenses/LGPL-2.1. + +If the LGPL is unacceptable for your uses, please e-mail me; alternative +terms can be negotiated for your project. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,5 @@ +#!/usr/bin/env runhaskell + +import Distribution.Simple + +main = defaultMain diff --git a/hslogger.cabal b/hslogger.cabal new file mode 100644 --- /dev/null +++ b/hslogger.cabal @@ -0,0 +1,46 @@ +Name: hslogger +Version: 1.0.2 +License: LGPL +Maintainer: John Goerzen +Author: John Goerzen +Stability: Stable +Copyright: Copyright (c) 2004-2007 John Goerzen +license-file: COPYRIGHT +Homepage: http://software.complete.org/hslogger +Synopsis: Versatile logging framework +Description: hslogger is a logging framework for Haskell, roughly similar to + Python's logging module. + . + hslogger lets each log message have a priority and source be associated + with it. The programmer can then define global handlers that route + or filter messages based on the priority and source. hslogger also + has a syslog handler built in. +Category: Interfaces +extra-source-files: COPYING +Cabal-Version: >= 1.2 + +flag small_base + description: choose the new smaller, split-up base package. + +Library + Exposed-Modules: + System.Log, System.Log.Handler, + System.Log.Handler.Simple, System.Log.Handler.Syslog, + System.Log.Handler.Growl, System.Log.Logger + Extensions: CPP, ExistentialQuantification + Build-Depends: network, mtl + if !os(win32) + Build-Depends: unix + if flag(small_base) + build-depends: base >= 3, containers, directory, process + else + build-depends: base < 3 + GHC-Options: -O2 + Hs-Source-Dirs: src + +Executable runtests + Buildable: False + Main-Is: runtests.hs + HS-Source-Dirs: testsrc, . + Extensions: ExistentialQuantification, OverlappingInstances, + UndecidableInstances, CPP diff --git a/src/System/Log.hs b/src/System/Log.hs new file mode 100644 --- /dev/null +++ b/src/System/Log.hs @@ -0,0 +1,70 @@ +{- arch-tag: Logging Main Definition +Copyright (C) 2004 John Goerzen + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU Lesser General Public License as published by +the Free Software Foundation; either version 2.1 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA +-} + +{- | + Module : System.Log + Copyright : Copyright (C) 2004 John Goerzen + License : GNU LGPL, version 2.1 or above + + Maintainer : John Goerzen + Stability : experimental + Portability: portable + +Haskell Logging Framework + +Written by John Goerzen, jgoerzen\@complete.org + +This module defines basic types used for logging. + +Extensive documentation is available in +"System.Log.Logger". + +-} + + + +module System.Log(-- * Types + Priority(..), + LogRecord +) + + where + +{- | Priorities are used to define how important a log messgae is. +Users can filter log messages based on priorities. + +These have their roots on the traditional syslog system. The standard +definitions are given below, but you are free to interpret them however you +like. They are listed here in ascending importance order. +-} + +data Priority = + DEBUG -- ^ Debug messages + | INFO -- ^ Information + | NOTICE -- ^ Normal runtime conditions + | WARNING -- ^ General Warnings + | ERROR -- ^ General Errors + | CRITICAL -- ^ Severe situations + | ALERT -- ^ Take immediate action + | EMERGENCY -- ^ System is unusable + deriving (Eq, Ord, Show, Read) + +{- | Internal type of log records -} + +type LogRecord = (Priority, String) + diff --git a/src/System/Log/Handler.hs b/src/System/Log/Handler.hs new file mode 100644 --- /dev/null +++ b/src/System/Log/Handler.hs @@ -0,0 +1,72 @@ +{- arch-tag: Log handlers main definition +Copyright (C) 2004-2006 John Goerzen + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU Lesser General Public License as published by +the Free Software Foundation; either version 2.1 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA +-} + +{- | + Module : System.Log.Handler + Copyright : Copyright (C) 2004-2006 John Goerzen + License : GNU LGPL, version 2.1 or above + + Maintainer : John Goerzen + Stability : provisional + Portability: portable + +Definition of log handler support + +For some handlers, check out "System.Log.Handler.Simple" and +"System.Log.Handler.Syslog". + +Please see "System.Log.Logger" for extensive documentation on the +logging system. + +Written by John Goerzen, jgoerzen\@complete.org +-} + +module System.Log.Handler(-- * Basic Types + LogHandler(..) + ) where +import System.Log +import System.IO + +{- | All log handlers should adhere to this. -} + +{- | This is the base class for the various log handlers. They should +all adhere to this class. -} + +class LogHandler a where + -- | Sets the log level. 'handle' will drop + -- items beneath this level. + setLevel :: a -> Priority -> a + -- | Gets the current level. + getLevel :: a -> Priority + -- | Logs an event if it meets the requirements + -- given by the most recent call to 'setLevel'. + handle :: a -> LogRecord -> String-> IO () + + handle h (pri, msg) logname = + if pri >= (getLevel h) + then emit h (pri, msg) logname + else return () + -- | Forces an event to be logged regardless of + -- the configured level. + emit :: a -> LogRecord -> String -> IO () + -- | Closes the logging system, causing it to close + -- any open files, etc. + close :: a -> IO () + + + diff --git a/src/System/Log/Handler/Growl.hs b/src/System/Log/Handler/Growl.hs new file mode 100644 --- /dev/null +++ b/src/System/Log/Handler/Growl.hs @@ -0,0 +1,154 @@ +{- arch-tag: Growl log handlers +Copyright (C) 2007 John Goerzen + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU Lesser General Public License as published by +the Free Software Foundation; either version 2.1 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA +-} + +{- | + Module : System.Log.Handler.Growl + Copyright : Copyright (C) 2007 John Goerzen + License : GNU LGPL, version 2.1 or above + + Maintainer : Richard M. Neswold, Jr. + Stability : provisional + Portability: portable + +Simple log handlers + +Written by Richard M. Neswold, Jr. rich.neswold\@gmail.com +-} + +module System.Log.Handler.Growl(addTarget, growlHandler) + where + +import Data.Char +import Data.Word +import Network.Socket +import Network.BSD +import System.Log +import System.Log.Handler + +data GrowlHandler = GrowlHandler { priority :: Priority, + appName :: String, + skt :: Socket, + targets :: [HostAddress] } + +instance LogHandler GrowlHandler where + + setLevel gh p = gh { priority = p } + + getLevel = priority + + emit gh lr _ = let pkt = buildNotification gh nmGeneralMsg lr + in mapM_ (sendNote (skt gh) pkt) (targets gh) + + close gh = let pkt = buildNotification gh nmClosingMsg + (WARNING, "Connection closing.") + s = skt gh + in mapM_ (sendNote s pkt) (targets gh) >> sClose s + +sendNote :: Socket -> String -> HostAddress -> IO Int +sendNote s pkt ha = sendTo s pkt (SockAddrInet 9887 ha) + +-- Right now there are two "notification names": "message" and +-- "disconnecting". All log messages are sent using the "message" +-- name. When the handler gets closed properly, the "disconnecting" +-- notification gets sent. + +nmGeneralMsg :: String +nmGeneralMsg = "message" + +nmClosingMsg :: String +nmClosingMsg = "disconnecting" + +{- | Creates a Growl handler. Once a Growl handler has been created, + machines that are to receive the message have to be specified. -} + +growlHandler :: String -- ^ The name of the service + -> Priority -- ^ Priority of handler + -> IO GrowlHandler +growlHandler nm pri = + do { s <- socket AF_INET Datagram 0 + ; return GrowlHandler { priority = pri, appName = nm, + skt = s, targets = [] } + } + +-- Converts a Word16 into a string of two characters. The value is +-- emitted in network byte order. + +emit16 :: Word16 -> String +emit16 v = let (h, l) = (fromEnum v) `divMod` 256 in [chr h, chr l] + +emitLen16 :: [a] -> String +emitLen16 = emit16 . fromIntegral . length + +-- Takes a Service record and generates a network packet +-- representing the service. + +buildRegistration :: GrowlHandler -> String +buildRegistration s = concat fields + where fields = [ ['\x1', '\x4'], + emitLen16 (appName s), + emitLen8 appNotes, + emitLen8 appNotes, + appName s, + foldl packIt [] appNotes, + ['\x0' .. (chr (length appNotes - 1))] ] + packIt a b = a ++ (emitLen16 b) ++ b + appNotes = [ nmGeneralMsg, nmClosingMsg ] + emitLen8 v = [chr $ length v] + +{- | Adds a remote machine's address to the list of targets that will + receive log messages. Calling this function sends a registration + packet to the machine. This function will throw an exception if + the host name cannot be found. -} + +addTarget :: HostName -> GrowlHandler -> IO GrowlHandler +addTarget hn gh = do { he <- getHostByName hn + ; let ha = hostAddress he + sa = SockAddrInet 9887 ha + in do { sendTo (skt gh) (buildRegistration gh) sa + ; return gh { targets = ha:(targets gh) } } } + +-- Converts a Priority type into the subset of integers needed in the +-- network packet's flag field. + +toFlags :: Priority -> Word16 +toFlags DEBUG = 12 +toFlags INFO = 10 +toFlags NOTICE = 0 +toFlags WARNING = 2 +toFlags ERROR = 3 -- Same as WARNING, but "sticky" bit set +toFlags CRITICAL = 3 -- Same as WARNING, but "sticky" bit set +toFlags ALERT = 4 +toFlags EMERGENCY = 5 -- Same as ALERT, but "sticky" bit set + +-- Creates a network packet containing a notification record. + +buildNotification :: GrowlHandler + -> String + -> LogRecord + -> String +buildNotification gh nm (p, msg) = concat fields + where fields = [ ['\x1', '\x5'], + emit16 (toFlags p), + emitLen16 nm, + emit16 0, + emitLen16 msg, + emitLen16 (appName gh), + nm, + [], + msg, + appName gh ] diff --git a/src/System/Log/Handler/Simple.hs b/src/System/Log/Handler/Simple.hs new file mode 100644 --- /dev/null +++ b/src/System/Log/Handler/Simple.hs @@ -0,0 +1,97 @@ +{- arch-tag: Simple log handlers +Copyright (C) 2004-2006 John Goerzen + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU Lesser General Public License as published by +the Free Software Foundation; either version 2.1 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA +-} + +{- | + Module : System.Log.Handler.Simple + Copyright : Copyright (C) 2004-2006 John Goerzen + License : GNU LGPL, version 2.1 or above + + Maintainer : John Goerzen + Stability : provisional + Portability: portable + +Simple log handlers + +Written by John Goerzen, jgoerzen\@complete.org +-} + +module System.Log.Handler.Simple(streamHandler, fileHandler, + verboseStreamHandler) + where + +import System.Log +import System.Log.Handler +import System.IO +import Control.Concurrent.MVar + +data GenericHandler a = GenericHandler {priority :: Priority, + privData :: a, + writeFunc :: a -> LogRecord -> String -> IO (), + closeFunc :: a -> IO () } + +instance LogHandler (GenericHandler a) where + setLevel sh p = sh{priority = p} + getLevel sh = priority sh + emit sh lr loggername = (writeFunc sh) (privData sh) lr loggername + close sh = (closeFunc sh) (privData sh) + + +{- | Create a stream log handler. Log messages sent to this handler will + be sent to the stream used initially. Note that the 'close' method + will have no effect on stream handlers; it does not actually close + the underlying stream. -} + +streamHandler :: Handle -> Priority -> IO (GenericHandler Handle) +streamHandler h pri = + do lock <- newMVar () + let mywritefunc hdl (_, msg) _ = + withMVar lock (\_ -> do hPutStrLn hdl msg + hFlush hdl + ) + return (GenericHandler {priority = pri, + privData = h, + writeFunc = mywritefunc, + closeFunc = \x -> return ()}) + +{- | Create a file log handler. Log messages sent to this handler + will be sent to the filename specified, which will be opened + in Append mode. Calling 'close' on the handler will close the file. + -} + +fileHandler :: FilePath -> Priority -> IO (GenericHandler Handle) +fileHandler fp pri = do + h <- openFile fp AppendMode + sh <- streamHandler h pri + return (sh{closeFunc = hClose}) + +{- | Like 'streamHandler', but note the priority and logger name along +with each message. -} +verboseStreamHandler :: Handle -> Priority -> IO (GenericHandler Handle) +verboseStreamHandler h pri = + do lock <- newMVar () + let mywritefunc hdl (prio, msg) loggername = + withMVar lock (\_ -> do hPutStrLn hdl ("[" ++ loggername + ++ "/" ++ + show prio ++ + "] " ++ msg) + hFlush hdl + ) + return (GenericHandler {priority = pri, + privData = h, + writeFunc = mywritefunc, + closeFunc = \x -> return ()}) diff --git a/src/System/Log/Handler/Syslog.hs b/src/System/Log/Handler/Syslog.hs new file mode 100644 --- /dev/null +++ b/src/System/Log/Handler/Syslog.hs @@ -0,0 +1,255 @@ +{-# LANGUAGE CPP #-} +{- arch-tag: Syslog handler +Copyright (C) 2004-2006 John Goerzen + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU Lesser General Public License as published by +the Free Software Foundation; either version 2.1 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA +-} + +{- | + Module : System.Log.Handler.Syslog + Copyright : Copyright (C) 2004-2006 John Goerzen + License : GNU LGPL, version 2.1 or above + + Maintainer : John Goerzen + Stability : provisional + Portability: portable + +Syslog handler for the Haskell Logging Framework + +Written by John Goerzen, jgoerzen\@complete.org + +This module implements an interface to the Syslog service commonly +found in Unix\/Linux systems. This interface is primarily of interest to +developers of servers, as Syslog does not typically display messages in +an interactive fashion. + +This module is written in pure Haskell and is capable of logging to a local +or remote machine using the Syslog protocol. + +You can create a new Syslog 'LogHandler' by calling 'openlog'. + +More information on the Haskell Logging Framework can be found at +"System.Log.Logger". This module can also be used outside +of the rest of that framework for those interested in that. +-} + +module System.Log.Handler.Syslog( + -- * Handler Initialization + openlog, + -- * Advanced handler initialization +#ifndef mingw32_HOST_OS + openlog_local, +#endif + openlog_remote, + openlog_generic, + -- * Data Types + Facility(..), + Option(..) + ) where + +import System.Log +import System.Log.Handler +import Data.Bits +import Network.Socket +import Network.BSD +import Data.List +#ifndef mingw32_HOST_OS +import System.Posix.Process(getProcessID) +#endif +import System.IO + +code_of_pri :: Priority -> Int +code_of_pri p = case p of + EMERGENCY -> 0 + ALERT -> 1 + CRITICAL -> 2 + ERROR -> 3 + WARNING -> 4 + NOTICE -> 5 + INFO -> 6 + DEBUG -> 7 + +{- | Facilities are used by the system to determine where messages +are sent. -} + +data Facility = + KERN -- ^ Kernel messages; you should likely never use this in your programs + | USER -- ^ General userland messages. Use this if nothing else is appropriate + | MAIL -- ^ E-Mail system + | DAEMON -- ^ Daemon (server process) messages + | AUTH -- ^ Authentication or security messages + | SYSLOG -- ^ Internal syslog messages; you should likely never use this in your programs + | LPR -- ^ Printer messages + | NEWS -- ^ Usenet news + | UUCP -- ^ UUCP messages + | CRON -- ^ Cron messages + | AUTHPRIV -- ^ Private authentication messages + | LOCAL0 -- ^ LOCAL0 through LOCAL7 are reserved for you to customize as you wish + | LOCAL1 + | LOCAL2 + | LOCAL3 + | LOCAL4 + | LOCAL5 + | LOCAL6 + | LOCAL7 + deriving (Eq, Show, Read) + +code_of_fac :: Facility -> Int +code_of_fac f = case f of + KERN -> 0 + USER -> 1 + MAIL -> 2 + DAEMON -> 3 + AUTH -> 4 + SYSLOG -> 5 + LPR -> 6 + NEWS -> 7 + UUCP -> 8 + CRON -> 9 + AUTHPRIV -> 10 + LOCAL0 -> 16 + LOCAL1 -> 17 + LOCAL2 -> 18 + LOCAL3 -> 19 + LOCAL4 -> 20 + LOCAL5 -> 21 + LOCAL6 -> 22 + LOCAL7 -> 23 + +makeCode :: Facility -> Priority -> Int +makeCode fac pri = + let faccode = code_of_fac fac + pricode = code_of_pri pri in + (faccode `shiftL` 3) .|. pricode + +{- | Options for 'openlog'. -} + +data Option = PID -- ^ Automatically log process ID (PID) with each message + | PERROR -- ^ Send a copy of each message to stderr + deriving (Eq,Show,Read) + +data SyslogHandler = SyslogHandler {options :: [Option], + facility :: Facility, + identity :: String, + logsocket :: Socket, + address :: SockAddr, + priority :: Priority} + +{- | Initialize the Syslog system using the local system's default interface, +\/dev\/log. Will return a new 'System.Log.Handler.LogHandler'. + +On Windows, instead of using \/dev\/log, this will attempt to send +UDP messages to something listening on the syslog port (514) on localhost. + +Use 'openlog_remote' if you need more control. +-} + +openlog :: String -- ^ The name of this program -- will be prepended to every log message + -> [Option] -- ^ A list of 'Option's. The list [] is perfectly valid. ['PID'] is probably most common here. + -> Facility -- ^ The 'Facility' value to pass to the syslog system for every message logged + -> Priority -- ^ Messages logged below this priority will be ignored. To include every message, set this to 'DEBUG'. + -> IO SyslogHandler -- ^ Returns the new handler + +#ifdef mingw32_HOST_OS +openlog = openlog_remote AF_INET "localhost" 514 +#else +openlog = openlog_local "/dev/log" +#endif + +{- | Initialize the Syslog system using an arbitrary Unix socket (FIFO). + +Not supported under Windows. +-} + +#ifndef mingw32_HOST_OS +openlog_local :: String -- ^ Path to FIFO + -> String -- ^ Program name + -> [Option] -- ^ 'Option's + -> Facility -- ^ Facility value + -> Priority -- ^ Priority limit + -> IO SyslogHandler +openlog_local fifopath ident options fac pri = + do + s <- socket AF_UNIX Datagram 0 + openlog_generic s (SockAddrUnix "/dev/log") ident options fac pri +#endif + +{- | Log to a remote server via UDP. -} +openlog_remote :: Family -- ^ Usually AF_INET or AF_INET6; see Network.Socket + -> HostName -- ^ Remote hostname. Some use @localhost@ + -> PortNumber -- ^ 514 is the default for syslog + -> String -- ^ Program name + -> [Option] -- ^ 'Option's + -> Facility -- ^ Facility value + -> Priority -- ^ Priority limit + -> IO SyslogHandler +openlog_remote fam hostname port ident options fac pri = + do + he <- getHostByName hostname + s <- socket fam Datagram 0 + let addr = SockAddrInet port (head (hostAddresses he)) + openlog_generic s addr ident options fac pri + +{- | The most powerful initialization mechanism. Takes an open datagram +socket. -} +openlog_generic :: Socket -- ^ A datagram socket + -> SockAddr -- ^ Address for transmissions + -> String -- ^ Program name + -> [Option] -- ^ 'Option's + -> Facility -- ^ Facility value + -> Priority -- ^ Priority limit + -> IO SyslogHandler +openlog_generic sock addr ident opt fac pri = + return (SyslogHandler {options = opt, + facility = fac, + identity = ident, + logsocket = sock, + address = addr, + priority = pri}) + +instance LogHandler SyslogHandler where + setLevel sh p = sh{priority = p} + getLevel sh = priority sh + emit sh (p, msg) loggername = + let code = makeCode (facility sh) p + getpid :: IO String + getpid = if (elem PID (options sh)) + then do +#ifndef mingw32_HOST_OS + pid <- getProcessID +#else + let pid = "windows" +#endif + return ("[" ++ show pid ++ "]") + else return "" + + sendstr :: String -> IO String + sendstr [] = return [] + sendstr omsg = do + sent <- sendTo (logsocket sh) omsg (address sh) + sendstr (genericDrop sent omsg) + in + do + pidstr <- getpid + let outstr = "<" ++ (show code) ++ ">" + ++ (identity sh) ++ pidstr ++ ": " + ++ "[" ++ loggername ++ "/" ++ (show p) ++ "] " ++ msg + if (elem PERROR (options sh)) + then hPutStrLn stderr outstr + else return () + sendstr (outstr ++ "\0") + return () + close sh = sClose (logsocket sh) + diff --git a/src/System/Log/Logger.hs b/src/System/Log/Logger.hs new file mode 100644 --- /dev/null +++ b/src/System/Log/Logger.hs @@ -0,0 +1,487 @@ +{-# OPTIONS -fglasgow-exts #-} +{- arch-tag: Logger main definition +Copyright (C) 2004-2006 John Goerzen + +This program is free software; you can redistribute it and/or modify +it under the terms of the GNU Lesser General Public License as published by +the Free Software Foundation; either version 2.1 of the License, or +(at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU Lesser General Public License for more details. + +You should have received a copy of the GNU Lesser General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA +-} + +{- | + Module : System.Log.Logger + Copyright : Copyright (C) 2004-2006 John Goerzen + License : GNU LGPL, version 2.1 or above + + Maintainer : John Goerzen + Stability : provisional + Portability: portable + +Haskell Logging Framework, Primary Interface + +Written by John Goerzen, jgoerzen\@complete.org + +Welcome to the error and information logging system for Haskell. + +This system is patterned after Python\'s @logging@ module, + and some of +the documentation here was based on documentation there. + +To log a message, you perform operations on 'Logger's. Each 'Logger' has a +name, and they are arranged hierarchically. Periods serve as separators. +Therefore, a 'Logger' named \"foo\" is the parent of loggers \"foo.printing\", +\"foo.html\", and \"foo.io\". These names can be anything you want. They're +used to indicate the area of an application or library in which a logged +message originates. Later you will see how you can use this concept to +fine-tune logging behaviors based on specific application areas. + +You can also tune logging behaviors based upon how important a message is. +Each message you log will have an importance associated with it. The different +importance levels are given by the 'Priority' type. I've also provided +some convenient functions that correspond to these importance levels: +'debugM' through 'emergencyM' log messages with the specified importance. + +Now, an importance level (or 'Priority') +is associated not just with a particular message but also +with a 'Logger'. If the 'Priority' of a given log message is lower than +the 'Priority' configured in the 'Logger', that message is ignored. This +way, you can globally control how verbose your logging output is. + +Now, let's follow what happens under the hood when you log a message. We'll +assume for the moment that you are logging something with a high enough +'Priority' that it passes the test in your 'Logger'. In your code, you'll +call 'logM' or something like 'debugM' to log the message. Your 'Logger' +decides to accept the message. What next? + +Well, we also have a notion of /handlers/ ('LogHandler's, to be precise). +A 'LogHandler' is a thing that takes a message and sends it somewhere. +That \"somewhere\" may be your screen (via standard error), your system's +logging infrastructure (via syslog), a file, or other things. Each +'Logger' can have zero or more 'LogHandler's associated with it. When your +'Logger' has a message to log, it passes it to every 'LogHandler' it knows +of to process. What's more, it is also passed to /all handlers of all +ancestors of the Logger/, regardless of whether those 'Logger's would +normally have passed on the message. + +To give you one extra little knob to turn, 'LogHandler's can also have +importance levels ('Priority') associated with them in the same way +that 'Logger's do. They act just like the 'Priority' value in the +'Logger's -- as a filter. It's useful, for instance, to make sure that +under no circumstances will a mere 'DEBUG' message show up in your syslog. + +There are three built-in handlers given in two built-in modules: +"System.Log.Handler.Simple" and "System.Log.Handler.Syslog". + +There is a special logger known as the /root logger/ that sits at the top +of the logger hierarchy. It is always present, and handlers attached +there will be called for every message. You can use 'getRootLogger' to get +it or 'rootLoggerName' to work with it by name. + +Here's an example to illustrate some of these concepts: + +> import System.Log.Logger +> import System.Log.Handler.Syslog +> +> -- By default, all messages of level WARNING and above are sent to stderr. +> -- Everything else is ignored. +> +> -- "MyApp.Component" is an arbitrary string; you can tune +> -- logging behavior based on it later. +> main = do +> debugM "MyApp.Component" "This is a debug message -- never to be seen" +> warningM "MyApp.Component2" "Something Bad is about to happen." +> +> -- Copy everything to syslog from here on out. +> s <- openlog "SyslogStuff" [PID] USER DEBUG +> updateGlobalLogger rootLoggerName (addHandler s) +> +> errorM "MyApp.Component" "This is going to stderr and syslog." +> +> -- Now we'd like to see everything from BuggyComponent +> -- at DEBUG or higher go to syslog and stderr. +> -- Also, we'd like to still ignore things less than +> -- WARNING in other areas. +> -- +> -- So, we adjust the Logger for MyApp.Component. +> +> updateGlobalLogger "MyApp.BuggyComponent" +> (setLevel DEBUG) +> +> -- This message will go to syslog and stderr +> debugM "MyApp.BuggyComponent" "This buggy component is buggy" +> +> -- This message will go to syslog and stderr too. +> warningM "MyApp.BuggyComponent" "Still Buggy" +> +> -- This message goes nowhere. +> debugM "MyApp.WorkingComponent" "Hello" + +-} + +module System.Log.Logger( + -- * Basic Types + Logger, + -- ** Re-Exported from System.Log + Priority(..), + -- * Logging Messages + -- ** Basic + logM, + -- ** Utility Functions + -- These functions are wrappers for 'logM' to + -- make your job easier. + debugM, infoM, noticeM, warningM, errorM, + criticalM, alertM, emergencyM, + traplogging, + -- ** Logging to a particular Logger by object + logL, + -- * Logger Manipulation +{- | These functions help you work with loggers. There are some +special things to be aware of. + +First of all, whenever you first access a given logger by name, it +magically springs to life. It has a default 'Priority' of 'DEBUG' +and an empty handler list -- which means that it will inherit whatever its +parents do. +-} + -- ** Finding \/ Creating Loggers + getLogger, getRootLogger, rootLoggerName, + -- ** Modifying Loggers +{- | Keep in mind that \"modification\" here is modification in the Haskell +sense. We do not actually cause mutation in a specific 'Logger'. Rather, +we return you a new 'Logger' object with the change applied. + +Also, please note that these functions will not have an effect on the +global 'Logger' hierarchy. You may use your new 'Logger's locally, +but other functions won't see the changes. To make a change global, +you'll need to use 'updateGlobalLogger' or 'saveGlobalLogger'. +-} + addHandler, setHandlers, + getLevel, setLevel, + -- ** Saving Your Changes +{- | These functions commit changes you've made to loggers to the global +logger hierarchy. -} + saveGlobalLogger, + updateGlobalLogger + ) where +import System.Log +import System.Log.Handler(LogHandler) +import qualified System.Log.Handler(handle) +import System.Log.Handler.Simple +import System.IO +import System.IO.Unsafe +import Control.Concurrent.MVar +import Data.List(map, isPrefixOf) +import qualified Data.Map as Map +import qualified Control.Exception +import Control.Monad.Error +--------------------------------------------------------------------------- +-- Basic logger types +--------------------------------------------------------------------------- +data HandlerT = forall a. LogHandler a => HandlerT a + +data Logger = Logger { level :: Priority, + handlers :: [HandlerT], + name :: String} + + +type LogTree = Map.Map String Logger + +{- | This is the base class for the various log handlers. They should +all adhere to this class. -} + + +--------------------------------------------------------------------------- +-- Utilities +--------------------------------------------------------------------------- + +-- | The name of the root logger, which is always defined and present +-- on the system. +rootLoggerName = "" + +{- | Placeholders created when a new logger must be created. This is used +only for the root logger default for now, as all others crawl up the tree +to find a sensible default. -} +placeholder :: Logger +placeholder = Logger {level = WARNING, handlers = [], name = ""} + +--------------------------------------------------------------------------- +-- Logger Tree Storage +--------------------------------------------------------------------------- + +-- | The log tree. Initialize it with a default root logger +-- and (FIXME) a logger for MissingH itself. + +{-# NOINLINE logTree #-} + +logTree :: MVar LogTree +-- note: only kick up tree if handled locally +logTree = + unsafePerformIO $ do + h <- streamHandler stderr DEBUG + newMVar (Map.singleton rootLoggerName (Logger + {level = WARNING, + name = "", + handlers = [HandlerT h]})) + +{- | Given a name, return all components of it, starting from the root. +Example return value: + +>["", "MissingH", "System.Cmd.Utils", "System.Cmd.Utils.pOpen"] + +-} +componentsOfName :: String -> [String] +componentsOfName name = + let joinComp [] _ = [] + joinComp (x:xs) [] = x : joinComp xs x + joinComp (x:xs) accum = + let newlevel = accum ++ "." ++ x in + newlevel : joinComp xs newlevel + in + rootLoggerName : joinComp (split "." name) [] + +--------------------------------------------------------------------------- +-- Logging With Location +--------------------------------------------------------------------------- + +{- | Log a message using the given logger at a given priority. -} + +logM :: String -- ^ Name of the logger to use + -> Priority -- ^ Priority of this message + -> String -- ^ The log text itself + -> IO () + +logM logname pri msg = do + l <- getLogger logname + logL l pri msg + +--------------------------------------------------------------------------- +-- Utility functions +--------------------------------------------------------------------------- + +{- | Log a message at 'DEBUG' priority -} +debugM :: String -- ^ Logger name + -> String -- ^ Log message + -> IO () +debugM s = logM s DEBUG + +{- | Log a message at 'INFO' priority -} +infoM :: String -- ^ Logger name + -> String -- ^ Log message + -> IO () +infoM s = logM s INFO + +{- | Log a message at 'NOTICE' priority -} +noticeM :: String -- ^ Logger name + -> String -- ^ Log message + -> IO () +noticeM s = logM s NOTICE + +{- | Log a message at 'WARNING' priority -} +warningM :: String -- ^ Logger name + -> String -- ^ Log message + -> IO () +warningM s = logM s WARNING + +{- | Log a message at 'ERROR' priority -} +errorM :: String -- ^ Logger name + -> String -- ^ Log message + -> IO () +errorM s = logM s ERROR + +{- | Log a message at 'CRITICAL' priority -} +criticalM :: String -- ^ Logger name + -> String -- ^ Log message + -> IO () +criticalM s = logM s CRITICAL + +{- | Log a message at 'ALERT' priority -} +alertM :: String -- ^ Logger name + -> String -- ^ Log message + -> IO () +alertM s = logM s ALERT + +{- | Log a message at 'EMERGENCY' priority -} +emergencyM :: String -- ^ Logger name + -> String -- ^ Log message + -> IO () +emergencyM s = logM s EMERGENCY + +--------------------------------------------------------------------------- +-- Public Logger Interaction Support +--------------------------------------------------------------------------- + +-- | Returns the logger for the given name. If no logger with that name +-- exists, creates new loggers and any necessary parent loggers, with +-- no connected handlers. + +getLogger :: String -> IO Logger +getLogger lname = modifyMVar logTree $ \lt -> + case Map.lookup lname lt of + Just x -> return (lt, x) -- A logger exists; return it and leave tree + Nothing -> do + -- Add logger(s). Then call myself to retrieve it. + let newlt = createLoggers (componentsOfName lname) lt + result <- Map.lookup lname newlt + return (newlt, result) + where createLoggers :: [String] -> LogTree -> LogTree + createLoggers [] lt = lt -- No names to add; return tree unmodified + createLoggers (x:xs) lt = -- Add logger to tree + if Map.member x lt + then createLoggers xs lt + else createLoggers xs + (Map.insert x ((modellogger lt) {name=x}) lt) + modellogger :: LogTree -> Logger + -- the modellogger is what we use for adding new loggers + modellogger lt = + findmodellogger lt (reverse $ componentsOfName lname) + findmodellogger _ [] = error "findmodellogger: root logger does not exist?!" + findmodellogger lt (x:xs) = + case Map.lookup x lt of + Left (_::String) -> findmodellogger lt xs + Right logger -> logger {handlers = []} + +-- | Returns the root logger. + +getRootLogger :: IO Logger +getRootLogger = getLogger rootLoggerName + +-- | Log a message, assuming the current logger's level permits it. +logL :: Logger -> Priority -> String -> IO () +logL l pri msg = handle l (pri, msg) + +-- | Handle a log request. +handle :: Logger -> LogRecord -> IO () +handle l (pri, msg) = + let parentHandlers [] = return [] + parentHandlers name = + let pname = (head . drop 1 . reverse . componentsOfName) name + in + do + --putStrLn (join "," foo) + --putStrLn pname + --putStrLn "1" + parent <- getLogger pname + --putStrLn "2" + next <- parentHandlers pname + --putStrLn "3" + return ((handlers parent) ++ next) + in + if pri >= (level l) + then do + ph <- parentHandlers (name l) + sequence_ (handlerActions (ph ++ (handlers l)) (pri, msg) + (name l)) + else return () + + +-- | Call a handler given a HandlerT. +callHandler :: LogRecord -> String -> HandlerT -> IO () +callHandler lr loggername ht = + case ht of + HandlerT x -> System.Log.Handler.handle x lr loggername + +-- | Generate IO actions for the handlers. +handlerActions :: [HandlerT] -> LogRecord -> String -> [IO ()] +handlerActions h lr loggername = map (callHandler lr loggername ) h + +-- | Add handler to 'Logger'. Returns a new 'Logger'. +addHandler :: LogHandler a => a -> Logger -> Logger +addHandler h l= l{handlers = (HandlerT h) : (handlers l)} + +-- | Set the 'Logger'\'s list of handlers to the list supplied. +-- All existing handlers are removed first. +setHandlers :: LogHandler a => [a] -> Logger -> Logger +setHandlers hl l = + l{handlers = map (\h -> HandlerT h) hl} + +-- | Returns the "level" of the logger. Items beneath this +-- level will be ignored. + +getLevel :: Logger -> Priority +getLevel l = level l + +-- | Sets the "level" of the 'Logger'. Returns a new +-- 'Logger' object with the new level. + +setLevel :: Priority -> Logger -> Logger +setLevel p l = l{level = p} + +-- | Updates the global record for the given logger to take into +-- account any changes you may have made. + +saveGlobalLogger :: Logger -> IO () +saveGlobalLogger l = modifyMVar_ logTree + (\lt -> return $ Map.insert (name l) l lt) + +{- | Helps you make changes on the given logger. Takes a function +that makes changes and writes those changes back to the global +database. Here's an example from above (\"s\" is a 'LogHandler'): + +> updateGlobalLogger "MyApp.BuggyComponent" +> (setLevel DEBUG . setHandlers [s]) +-} + +updateGlobalLogger :: String -- ^ Logger name + -> (Logger -> Logger) -- ^ Function to call + -> IO () +updateGlobalLogger ln func = + do l <- getLogger ln + saveGlobalLogger (func l) + +{- | Traps exceptions that may occur, logging them, then passing them on. + +Takes a logger name, priority, leading description text (you can set it to +@\"\"@ if you don't want any), and action to run. +-} + +traplogging :: String -- Logger name + -> Priority -- Logging priority + -> String -- Descriptive text to prepend to logged messages + -> IO a -- Action to run + -> IO a -- Return value +traplogging logger priority desc action = + let realdesc = case desc of + "" -> "" + x -> x ++ ": " + handler e = do + logM logger priority (realdesc ++ (show e)) + Control.Exception.throw e -- Re-raise it + in + Control.Exception.catch action handler + +{- This function pulled in from MissingH to avoid a dep on it -} +split :: Eq a => [a] -> [a] -> [[a]] +split _ [] = [] +split delim str = + let (firstline, remainder) = breakList (isPrefixOf delim) str + in + firstline : case remainder of + [] -> [] + x -> if x == delim + then [] : [] + else split delim + (drop (length delim) x) + +-- This function also pulled from MissingH +breakList :: ([a] -> Bool) -> [a] -> ([a], [a]) +breakList func = spanList (not . func) + +-- This function also pulled from MissingH +spanList :: ([a] -> Bool) -> [a] -> ([a], [a]) + +spanList _ [] = ([],[]) +spanList func list@(x:xs) = + if func list + then (x:ys,zs) + else ([],list) + where (ys,zs) = spanList func xs +