SessionLogger (empty) → 0.3.0.0
raw patch · 4 files changed
+497/−0 lines, 4 filesdep +basedep +directorydep +filepathsetup-changed
Dependencies added: base, directory, filepath, hslogger, mtl, old-locale, random, time
Files
- LICENSE +165/−0
- SessionLogger.cabal +24/−0
- Setup.hs +3/−0
- src/System/Log/SessionLogger.hs +305/−0
+ LICENSE view
@@ -0,0 +1,165 @@+ GNU LESSER GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.+++ This version of the GNU Lesser General Public License incorporates+the terms and conditions of version 3 of the GNU General Public+License, supplemented by the additional permissions listed below.++ 0. Additional Definitions. ++ As used herein, "this License" refers to version 3 of the GNU Lesser+General Public License, and the "GNU GPL" refers to version 3 of the GNU+General Public License.++ "The Library" refers to a covered work governed by this License,+other than an Application or a Combined Work as defined below.++ An "Application" is any work that makes use of an interface provided+by the Library, but which is not otherwise based on the Library.+Defining a subclass of a class defined by the Library is deemed a mode+of using an interface provided by the Library.++ A "Combined Work" is a work produced by combining or linking an+Application with the Library. The particular version of the Library+with which the Combined Work was made is also called the "Linked+Version".++ The "Minimal Corresponding Source" for a Combined Work means the+Corresponding Source for the Combined Work, excluding any source code+for portions of the Combined Work that, considered in isolation, are+based on the Application, and not on the Linked Version.++ The "Corresponding Application Code" for a Combined Work means the+object code and/or source code for the Application, including any data+and utility programs needed for reproducing the Combined Work from the+Application, but excluding the System Libraries of the Combined Work.++ 1. Exception to Section 3 of the GNU GPL.++ You may convey a covered work under sections 3 and 4 of this License+without being bound by section 3 of the GNU GPL.++ 2. Conveying Modified Versions.++ If you modify a copy of the Library, and, in your modifications, a+facility refers to a function or data to be supplied by an Application+that uses the facility (other than as an argument passed when the+facility is invoked), then you may convey a copy of the modified+version:++ a) under this License, provided that you make a good faith effort to+ ensure that, in the event an Application does not supply the+ function or data, the facility still operates, and performs+ whatever part of its purpose remains meaningful, or++ b) under the GNU GPL, with none of the additional permissions of+ this License applicable to that copy.++ 3. Object Code Incorporating Material from Library Header Files.++ The object code form of an Application may incorporate material from+a header file that is part of the Library. You may convey such object+code under terms of your choice, provided that, if the incorporated+material is not limited to numerical parameters, data structure+layouts and accessors, or small macros, inline functions and templates+(ten or fewer lines in length), you do both of the following:++ a) Give prominent notice with each copy of the object code that the+ Library is used in it and that the Library and its use are+ covered by this License.++ b) Accompany the object code with a copy of the GNU GPL and this license+ document.++ 4. Combined Works.++ You may convey a Combined Work under terms of your choice that,+taken together, effectively do not restrict modification of the+portions of the Library contained in the Combined Work and reverse+engineering for debugging such modifications, if you also do each of+the following:++ a) Give prominent notice with each copy of the Combined Work that+ the Library is used in it and that the Library and its use are+ covered by this License.++ b) Accompany the Combined Work with a copy of the GNU GPL and this license+ document.++ c) For a Combined Work that displays copyright notices during+ execution, include the copyright notice for the Library among+ these notices, as well as a reference directing the user to the+ copies of the GNU GPL and this license document.++ d) Do one of the following:++ 0) Convey the Minimal Corresponding Source under the terms of this+ License, and the Corresponding Application Code in a form+ suitable for, and under terms that permit, the user to+ recombine or relink the Application with a modified version of+ the Linked Version to produce a modified Combined Work, in the+ manner specified by section 6 of the GNU GPL for conveying+ Corresponding Source.++ 1) Use a suitable shared library mechanism for linking with the+ Library. A suitable mechanism is one that (a) uses at run time+ a copy of the Library already present on the user's computer+ system, and (b) will operate properly with a modified version+ of the Library that is interface-compatible with the Linked+ Version. ++ e) Provide Installation Information, but only if you would otherwise+ be required to provide such information under section 6 of the+ GNU GPL, and only to the extent that such information is+ necessary to install and execute a modified version of the+ Combined Work produced by recombining or relinking the+ Application with a modified version of the Linked Version. (If+ you use option 4d0, the Installation Information must accompany+ the Minimal Corresponding Source and Corresponding Application+ Code. If you use option 4d1, you must provide the Installation+ Information in the manner specified by section 6 of the GNU GPL+ for conveying Corresponding Source.)++ 5. Combined Libraries.++ 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 that are not Applications and are not covered by this+License, and convey such a combined library under terms of your+choice, if you do both of the following:++ a) Accompany the combined library with a copy of the same work based+ on the Library, uncombined with any other library facilities,+ conveyed under the terms of this License.++ b) Give prominent notice with the combined library that part of it+ is a work based on the Library, and explaining where to find the+ accompanying uncombined form of the same work.++ 6. Revised Versions of the GNU Lesser General Public License.++ The Free Software Foundation may publish revised and/or new versions+of the GNU 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 as you received it specifies that a certain numbered version+of the GNU Lesser General Public License "or any later version"+applies to it, you have the option of following the terms and+conditions either of that published version or of any later version+published by the Free Software Foundation. If the Library as you+received it does not specify a version number of the GNU Lesser+General Public License, you may choose any version of the GNU Lesser+General Public License ever published by the Free Software Foundation.++ If the Library as you received it specifies that a proxy can decide+whether future versions of the GNU Lesser General Public License shall+apply, that proxy's public statement of acceptance of any version is+permanent authorization for you to choose that version for the+Library.
+ SessionLogger.cabal view
@@ -0,0 +1,24 @@+Name: SessionLogger+Version: 0.3.0.0+Synopsis: Easy Loggingframework+Description: Logger is a framework for making logging, especially web+ request, easy. It supports a special file hierachy where+ every request has its own directory with a main log file+ and serveral other files worth to log. In addition there+ is a main log file with important messages and an info file+ for things like performance meassuring. These two files+ are avaliable for each day separately.+License: LGPL-3+License-file: LICENSE+Author: Gero Kriependorf <gero-dev@physra.net>+Maintainer: Gero Kriependorf <gero-dev@physra.net>+Stability: Testing+Category: Logging+Build-type: Simple+Cabal-version: >=1.6+Library+ Exposed-modules: System.Log.SessionLogger+ Hs-Source-Dirs: src+ Build-depends: base==4.*, mtl==1.1.1.*, time==1.*, hslogger==1.*,+ directory==1.*, filepath==1.*, old-locale==1.0.*,+ random==1.0.*
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ src/System/Log/SessionLogger.hs view
@@ -0,0 +1,305 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleContexts #-}++-- | Example of Usage:+--+-- @+-- runIOLogger "Applicationname" $ do+-- initLogger+-- logNotice "Just a small notice"+-- logWarn "Something more important"+-- logData "filename" "Logfile Info" "data which is logged to file"+-- @++module System.Log.SessionLogger (+ -- * Binds ...+ (>>>=), (>>>>=)+ -- * Data+ , LoggerData(..), ExtraData, Logger(..)+ -- * Initializing functions+ , initLogger, testLogger, runIOLogger, withExtraData+ -- * Logging functions+ , logNotice, logInfo, logWarn, logError, logInternalInfo+ , logData, logGlobInfo+ -- * Internal/debugging functions+ , getLogId, generateLogId+) where++import System.Locale (defaultTimeLocale)+import System.FilePath.Posix ((</>))+import System.IO (hClose, openFile, hPutStrLn, IOMode(..), hFlush)+import System.Directory (createDirectoryIfMissing)+import System.Log.Logger (errorM, getRootLogger, saveGlobalLogger, setLevel+ , Priority(..), noticeM, setLevel+ , setHandlers)+import System.Log.Handler.Syslog (openlog,Facility(..))+import System.Random (randomIO)+import Data.Time.LocalTime (getZonedTime)+import Data.Time.Format (formatTime)+import Control.Monad.Trans (MonadIO(..), MonadTrans)+import Control.Monad.Reader (asks, ReaderT, local, runReaderT, MonadReader(..))+import System.IO (hSetEncoding, utf8)++--------------------------------------------------------------------------------+-- Definitions+--------------------------------------------------------------------------------++type Error = String++_LOGPATH_ = "logs/"+-- TODO: main.log with syslog+_MAIN_LOG_ = "logs/main.log"+_INFO_LOG_ = "logs/info.log"++type ExtraData = [String]+data LoggerData = LoggerData { ld_logId :: String+ , ld_appName :: String+ , ld_extraDatas :: [ExtraData]+ , ld_nolog :: Bool+ }++--type Logger a = ReaderT LoggerData IO a+newtype Logger m a = Logger (ReaderT LoggerData m a)+ deriving (Monad, MonadIO, MonadTrans)++-- TODO: really the right way?+initLogger :: (MonadIO m) => Logger m ()+initLogger = do+ logger <- liftIO $ getRootLogger+ name <- getAppName+ syslog <- liftIO $ openlog name [] LOCAL3 DEBUG+ liftIO $ saveGlobalLogger (setHandlers [syslog] (setLevel DEBUG logger))+ return ()++testLogger :: MonadIO m => Logger m a -> m a+testLogger (Logger readerT) =+ runReaderT readerT (LoggerData "42" "" [] True)++runIOLogger :: MonadIO m => String -> Logger m a -> m a+runIOLogger appname (Logger readerT) = do+ logid <- liftIO $ generateLogId+ runReaderT readerT (LoggerData logid appname [] False)++--------------------------------------------------------------------------------+-- Public Functions+--------------------------------------------------------------------------------++generateLogId :: IO String+generateLogId = do+ rand <- liftIO $ randomIO+ time <- createVerySimpleTS+ let logid = show (abs $ rand::Int)+ return $ time ++ (take 8 $ extend logid '0' 9)++-- Replace this Function. Inline recursion?+extend :: String -> Char -> Int -> String+extend str chr len = if (length str) < len+ then (extend (str++(show chr)) chr len)+ else str++getLogId ::(Monad m) => Logger m String+getLogId = Logger (asks ld_logId)++getAppName :: Monad m => Logger m String+getAppName = Logger (asks ld_appName)++getExtraDatas :: Monad m => Logger m [ExtraData]+getExtraDatas = Logger (asks ld_extraDatas)++getNolog :: Monad m => Logger m Bool+getNolog = Logger (asks ld_nolog)++(>>>>=) :: (MonadIO m, MonadReader LoggerData (Logger m), Show a) =>+ String -> IO a -> Logger m a+(>>>>=) str f = do+ ret <- liftIO f+ logid <- getLogId+ writeLog logid $ str ++ show ret+ logExtraDatas str+ return ret++(>>>=) :: (MonadIO m, MonadReader LoggerData (Logger m), Show a) =>+ String -> IO a -> Logger m a+(>>>=) str f = do+ ret <- liftIO f+ logid <- getLogId+ writeLog logid str+ logExtraDatas str+ return ret++logNotice :: (MonadIO m) => String -> Logger m ()+logNotice str = do+ let text = "NOTICE: " ++ str+ logid <- getLogId+ writeLog logid text++logInfo :: (MonadIO m) => String -> Logger m ()+logInfo str = do+ let text = "INFO: " ++ str+ logid <- getLogId+ writeLog logid text+ logGlobInfo str+ logExtraDatas text+ return ()++logWarn :: (MonadIO m) => String -> Logger m ()+logWarn str = do+ let text = "WARN: " ++ str+ logid <- getLogId+ writeLog logid text+ logExtraDatas text+ logMainSafe text++-- Only logs in syslog if initLogger was called first+logError :: (MonadIO m) => String -> Logger m ()+logError str = do+ let text = "ERROR: " ++ str+ logid <- getLogId+ writeLog logid text+ logExtraDatas text+ logMainSafe text+ appName <- getAppName+ liftIO $ errorM appName text+ return ()++logInternalInfo :: (MonadIO m) => String -> Logger m ()+logInternalInfo str = do+ let text = "INTERNAL INFO: " ++ str+ logid <- getLogId+ logMainSafe text++logData :: (MonadIO m) => String -> String -> String -> Logger m ()+logData filename str dat = do+ timestr <- liftIO $ createSimpleTimeString+ let file = timestr ++ "-" ++ filename+ text = "DATA: " ++ str ++ "\tFile: " ++ file+ logid <- getLogId+ writeLog logid text+ logExtraDatas text+ basepath <- liftIO $ createPath+ liftIO $ createDirectoryIfMissing True (basepath </> logid)+ writeLogFileSafe (logid</>file) dat+ return ()++logGlobInfo :: (MonadIO m) => String -> Logger m ()+logGlobInfo text = do+ time <- liftIO $ createTimeString+ logid <- getLogId+ logGlobInfoRaw (time ++ " \t" ++ logid ++ " \t" ++ text) >> return ()+ return ()++--------------------------------------------------------------------------------+-- Internal Functions+--------------------------------------------------------------------------------++-- TODO: Ring the bell if error occurs (email, short message etc.)+logMainSafe :: (MonadIO m) => String -> Logger m ()+logMainSafe text = do+ time <- liftIO $ createTimeString+ logid <- getLogId+ logMain (time ++ " \t" ++ logid ++ " \t" ++ text) >> return ()+ return ()++logMain :: (MonadIO m) => String -> Logger m (Maybe Error)+logMain text = do+ writeFileSafe _MAIN_LOG_ text+ writeLogFileSafe "main.log" text++logGlobInfoRaw :: (MonadIO m) => String -> Logger m (Maybe Error)+logGlobInfoRaw text = do+ writeFileSafe _INFO_LOG_ text+ writeLogFileSafe "info.log" text++--withExtraData :: ExtraData -> Logger m -> Logger m+--withExtraData :: (MonadReader LoggerData m) => ExtraData -> m a -> m a+--withExtraData :: (Monad m) => ExtraData -> Logger m a -> Logger m a+--withExtraData ed = local (\(LoggerData id app eds) -> LoggerData id app (ed:eds))+--withExtraData = undefined+-- local :: (MonadReader r m) => (r -> r) -> m a -> m a+-- Logger (ReaderT LoggerData m a)+withExtraData :: Monad m => ExtraData -> Logger m a -> Logger m a+withExtraData ed (Logger rt) = Logger $ local+ (\(LoggerData id app eds nl) ->+ LoggerData id app (ed:eds) nl) rt++logExtraDatas :: (MonadIO m) => String -> Logger m ()+logExtraDatas str = do+ eds <- getExtraDatas+ mapM_ (logExtraData str) eds++logExtraData :: (MonadIO m) => String -> ExtraData -> Logger m ()+logExtraData str ed = do+ let path = foldl (</>) "" ed+ logid <- getLogId+ basepath <- liftIO $ createPath+ liftIO $ createDirectoryIfMissing True (basepath </> path)+ writeLogFileSafe (path </> logid) str+ return ()++writeLog :: (MonadIO m) => String -> String -> Logger m ()+writeLog logid text = do+ time <- liftIO $ createTimeString+ writeLogFileSafe (logid ++ "/" ++ "log")+ (time ++ "\t" ++ text) >> return ()++-- TODO: Ring the bell if error occurs (email, short message etc.)+writeLogFileSafe :: (MonadIO m) => String -> String -> Logger m (Maybe Error)+writeLogFileSafe filename text = writeLogFile filename text+-- catch (writeLogFile filename text)+-- $ \e -> return $ Just+-- $ "Could not open File " ++ filename ++ "\t\t" ++ (show e)++writeLogFile :: (MonadIO m) => String -> String -> Logger m (Maybe Error)+writeLogFile filename text = do+ path <- liftIO createPath+ liftIO $ createDirectoryIfMissing True path+ let logfile = path </> filename+ writeFileSafe logfile text++writeFileSafe :: (MonadIO m) => String -> String -> Logger m (Maybe Error)+writeFileSafe file text =+ getNolog >>= \dummy ->+ if dummy == False then+ liftIO $ catch (do+ outh <- openFile file AppendMode+ hSetEncoding outh utf8+ hPutStrLn outh text+ hFlush outh+ hClose outh+ return Nothing)+ (\e -> return $ Just ("Could not open File " ++ file ++ "\t\t" ++ (show e)))+ else+ return Nothing++--------------------------------------------------------------------------------+-- Helper Functions+--------------------------------------------------------------------------------++createPath :: IO String+createPath = do+ zt <- getZonedTime+ let calDirectory = formatTime defaultTimeLocale "%Y-%m-%d" zt+ createDirectoryIfMissing True $ _LOGPATH_ ++ calDirectory+ return $ _LOGPATH_ ++ calDirectory++createTimeString :: IO String+createTimeString = do+ zt <- getZonedTime+ pico <- generatePicoSeconds+ return $ (formatTime defaultTimeLocale "%H:%M:%S." zt) ++ pico++createSimpleTimeString :: IO String+createSimpleTimeString = do+ zt <- getZonedTime+ pico <- generatePicoSeconds+ return $ (formatTime defaultTimeLocale "%H%M%S." zt) ++ pico++createVerySimpleTS :: IO String+createVerySimpleTS =+ getZonedTime >>= \zt ->+ return $ formatTime defaultTimeLocale "%H%M%S" zt++generatePicoSeconds :: IO String+generatePicoSeconds =+ getZonedTime >>= \zt ->+ return $ take 5 $ formatTime defaultTimeLocale "%q" zt