diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,28 @@ +Copyright © 2011, Jon Kristensen + +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 Pontarius nor the names of its 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 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. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,20 @@ +HLogger is a simple and concurrent logging utility for Haskell under the +development by the Pontarius project. The goal is to provide a name and facility +for a set of logging functionalities that many Haskell developers re-invent and +maintain their own implementations of. We are not entirely sure yet what the +scope of this library will be, but we will continue to evolve it in parallel +with the development of Pontarius and HXMPP, utilizing it in those two projects. + +We have just released HLogger 0.1 Alpha 2 with support for custom logging +behaviors. See the documentation for information on how to use HLogger, and how +to write your own HLogger extension. + +See for more information. + +Please note that we are not recommending anyone to use HLogger at this time as +it's still in an experimental stage and will have its API and data types +modified frequently. We have scheduled the first beta release for the 4th of +May. That being said, if you are interested to use HLogger anyway, feel free to +do so and to contact the Pontarius project if you need any assistance. + +We will release the next version, 0.1 Alpha 2, on the 13th of April. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/System/Log/HLogger.hs b/System/Log/HLogger.hs new file mode 100644 --- /dev/null +++ b/System/Log/HLogger.hs @@ -0,0 +1,210 @@ +-- | Module: $Header$ +-- Description: Easy-to-use, concurrent and extendable logging framework +-- Copyright: Copyright © 2010-2011 Jon Kristensen +-- License: BSD-3 +-- +-- Maintainer: info@pontarius.org +-- Stability: unstable +-- Portability: portable +-- +-- This is a work in progress for a simple logging framework that aims to be +-- easy-to-use, concurrent and extendable through plug-ins. You cannot use +-- this module for logging directly, instead you want to use an HLogger +-- implementation. If you simply want to log messages to a file, consider +-- using the SimpleLogger implementation. If you want a more complicated +-- logger, see below. +-- +-- * Implementing a Customized Logger +-- +-- If the loggers provided by the HLogger project (currently only +-- SimpleLogger) are insufficient for your application, implementing a custom +-- logging implementation on top of HLogger is simple. You can modify the +-- logger behaviour (how it logs), but not the logger's API (logging levels +-- and exported functions). Another limitation of HLogger implementations is +-- that they are immutable (operating in a static environment, cannot have +-- their state changed). +-- +-- See the SimpleLogger module for an example on how an implementation can be +-- made. + + +module System.Log.HLogger (LogMessage (..), Logger (..), logger) where + + +import Control.Concurrent (forkIO) +import Control.Concurrent.Chan (Chan, newChan, writeChan) + + +-- LogLevel indicates the importance of a log entry. The log levels are the +-- same as in the Syslog application. The below list is ordered by priority, +-- Debug being the least significant message. + +data LogLevel = Debug | -- Debug messages + Info | -- Purely informational messages + Notice | -- Significant messages for normal conditions + Warning | -- Warning condition messages + Error | -- Error condition messages + Critical | -- Critical condition messages + Alert | -- Indication that action must be taken + Emergency -- Indication that the system is unusable + deriving (Eq, Ord, Read, Show) + + +-- | This object provides the logging API. Consult the documentation for the +-- logging implementation (or SimpleLogger) about how to acquire a Logger +-- object. + +data Logger = Logger { -- | Logs a debug message. Debug messages are the least + -- significant messages. + logDebug :: String -> IO () + + -- | Logs a purely informational message. Use logNotice + -- instead of the information message is significant. + , logInfo :: String -> IO () + + -- | Logs a significant purely informational message. Use + -- logNotice instead of the information message is + -- significant. + , logNotice :: String -> IO () + + -- | Logs a message signaling a warning condition. + , logWarning :: String -> IO () + + -- | Logs a message signaling that a non-critical error + -- has occurred. + , logError :: String -> IO () + + -- | Logs a message signaling that a critical error has + -- occurred. + , logCritical :: String -> IO () + + -- | Logs a message signaling that an action must be + -- taken. + , logAlert :: String -> IO () + + -- | Logs a message signaling that the system is + -- unusable. + , logEmergency :: String -> IO () + + -- | Stops the logger. This action is asynchronous. + , stopLogger :: IO () } + + +-- | Used by logging implementations only. Contains information about the log +-- message. + +-- TODO: Add date information? + +data LogMessage = LogMessage { message :: String, level :: LogLevel } + + +-- | Used by logging implementations only. Provides a Logger object, given a +-- looping function operating on a 'LogMessage' channel. + +logger :: (Chan (Maybe LogMessage) -> IO ()) -> IO Logger + +logger l = + do c <- newChan + forkIO $ l c + return Logger { logDebug = logDebug_ c + , logInfo = logInfo_ c + , logNotice = logNotice_ c + , logWarning = logWarning_ c + , logError = logError_ c + , logCritical = logCritical_ c + , logAlert = logAlert_ c + , logEmergency = logEmergency_ c + , stopLogger = stopLogger_ c } + + +-- Stops the logger. This action is asynchronous. + +stopLogger_ :: Chan (Maybe LogMessage) -> IO () + +stopLogger_ c = writeChan c Nothing + + +-- Logs a debug message. Debug messages are the least significant messages. + +logDebug_ :: Chan (Maybe LogMessage) -> String -> IO () + +logDebug_ c s = + do let m = toLogMessage s Debug + writeChan c (Just m) + return () + + +-- Logs a purely informational message. Use logNotice instead of the information +-- message is significant. + +logInfo_ :: Chan (Maybe LogMessage) -> String -> IO () + +logInfo_ c s = + do let m = toLogMessage s Info + writeChan c (Just m) + return () + + +-- Logs a significant purely informational message. + +logNotice_ :: Chan (Maybe LogMessage) -> String -> IO () + +logNotice_ c s = + do let m = toLogMessage s Notice + writeChan c (Just m) + return () + + +-- Logs a message signaling a warning condition. + +logWarning_ :: Chan (Maybe LogMessage) -> String -> IO () + +logWarning_ c s = + do let m = toLogMessage s Warning + writeChan c (Just m) + return () + + +-- Logs a message signaling that a non-critical error has occurred. + +logError_ :: Chan (Maybe LogMessage) -> String -> IO () + +logError_ c s = + do let m = toLogMessage s Error + writeChan c (Just m) + return () + + +-- Logs a message signaling that a critical error has occurred. + +logCritical_ :: Chan (Maybe LogMessage) -> String -> IO () + +logCritical_ c s = + do let m = toLogMessage s Critical + writeChan c (Just m) + return () + + +-- Logs a message signaling that an action must be taken. + +logAlert_ c s = + do let m = toLogMessage s Alert + writeChan c (Just m) + return () + + +-- Logs a message signaling that the system is unusable. + +logEmergency_ :: Chan (Maybe LogMessage) -> String -> IO () + +logEmergency_ c s = + do let m = toLogMessage s Emergency + writeChan c (Just m) + return () + + +-- Function to wrap a string and a log level into a LogMessage record. + +toLogMessage :: String -> LogLevel -> LogMessage + +toLogMessage m l = LogMessage { message = m, level = l } diff --git a/System/Log/SimpleHLogger.hs b/System/Log/SimpleHLogger.hs new file mode 100644 --- /dev/null +++ b/System/Log/SimpleHLogger.hs @@ -0,0 +1,74 @@ +-- | Module: $Header$ +-- Description: Simple HLogger implementation for logging to a text file +-- Copyright: Copyright © 2010-2011 Jon Kristensen +-- License: BSD-3 +-- +-- Maintainer: info@pontarius.org +-- Stability: unstable +-- Portability: portable +-- +-- This is a simple HLogger implementation that allows developers to +-- conveniently log to a text file. A usage example would be: +-- +-- @ +-- import System.Log.SimpleHLogger +-- main = +-- do logger <- simpleLogger "LoggerTest" +-- logDebug logger "This is a test message!" +-- stopLogger logger +-- @ +-- +-- The above example would log "This is a test message!" to a file in the +-- current directory. + + +-- Note that Logger is exported. This is so that applications wont have to +-- import System.Log.HLogger.Logger. + +module System.Log.SimpleHLogger (Logger (..), simpleLogger) where + + +import System.Log.HLogger (LogMessage (..), Logger (..), logger) +import System.IO (Handle, IOMode (WriteMode), hClose, hFlush, hPutStrLn, + openFile) +import Control.Concurrent.Chan (Chan, readChan) +import Control.Applicative ((<$>)) +import Data.Time.Clock (getCurrentTime) +import Data.Time.Format (formatTime) +import System.Locale (defaultTimeLocale) + + +-- | Acquires a SimpleLogger Logger object. It takes a String, @prefix@, and +-- creates a file @prefix-YYYYMMDDHHMMSS.log@ in the current directory. It +-- will use UTC time on system that supports it, and local time otherwise. + +simpleLogger :: String -> IO Logger +simpleLogger p = + do d0 <- datetime0 + h <- openFile (p ++ "-" ++ d0 ++ ".log") WriteMode + logger $ loggerLoop h + where + loggerLoop :: Handle -> Chan (Maybe LogMessage) -> IO () + loggerLoop h c = + do logMessage <- readChan c + case logMessage of + Nothing -> + do hClose h + Just m -> + do d1 <- datetime1 + let r = d1 ++ ": " ++ show (level m) ++ ": " ++ message m + hPutStrLn h r + hFlush h + loggerLoop h c + + +-- Datetime string in the format of `YYYYMMDDHHMMSS'. + +datetime0 :: IO String +datetime0 = formatTime defaultTimeLocale "%Y%m%d%H%M%S" <$> getCurrentTime + + +-- Datetime string in the format of `YYYY-MM-DD HH:MM:SS'. + +datetime1 :: IO String +datetime1 = formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" <$> getCurrentTime diff --git a/hlogger.cabal b/hlogger.cabal new file mode 100644 --- /dev/null +++ b/hlogger.cabal @@ -0,0 +1,63 @@ +-- TODO: Set dependency versions. +-- TODO: Highlighting bug: The last line of the description. + +Name: hlogger +Version: 0.0.2.0 +Cabal-Version: >= 1.6 +Build-Type: Simple +License: BSD3 +License-File: LICENSE +Copyright: Copyright © 2011, Jon Kristensen +Author: Jon Kristensen, Mahdi Abdinejadi +Maintainer: jon.kristensen@pontarius.org +Stability: alpha +Homepage: http://www.pontarius.org/sub-projects/hlogger/ +Bug-Reports: mailto:info@pontarius.org +Package-URL: http://www.pontarius.org/releases/hlogger-0.0.2.0.tar.gz +Synopsis: Simple, concurrent, extendable and easy-to-use logging + library +Description: This is a work in progress for a logging framework that + aims to be simple, concurrent, extendable and easy-to-use. +Category: Logging, Concurrency +Tested-With: GHC ==6.12.3 +-- Data-Files: +-- Data-Dir: +-- Extra-Source-Files: +-- Extra-Tmp-Files: + +Library + Exposed-Modules: System.Log.HLogger, System.Log.SimpleHLogger + Exposed: True + Build-Depends: base >= 2 && < 5, old-locale, time + -- Other-Modules: + -- HS-Source-Dirs: + -- Extensions: + -- Build-Tools: + -- Buildable: + -- GHC-Options: + -- GHC-Prof-Options: + -- Hugs-Options: + -- NHC98-Options: + -- Includes: + -- Install-Includes: + -- Include-Dirs: + -- C-Sources: + -- Extra-Libraries: + -- Extra-Lib-Dirs: + -- CC-Options: + -- LD-Options: + -- Pkgconfig-Depends: + -- Frameworks: + +Source-Repository head + Type: darcs + -- Module: + Location: https://patch-tag.com/r/jonkri/hlogger + -- Subdir: + +Source-Repository this + Type: darcs + -- Module: + Location: https://patch-tag.com/r/jonkri/hlogger + Tag: 0.0.2.0 + -- Subdir: