logging-facade-0.1.0/0000755000000000000000000000000012561050170012522 5ustar0000000000000000logging-facade-0.1.0/logging-facade.cabal0000644000000000000000000000215112561050170016334 0ustar0000000000000000name: logging-facade version: 0.1.0 synopsis: Simple logging abstraction that allows multiple back-ends description: Simple logging abstraction that allows multiple back-ends license: MIT license-file: LICENSE copyright: (c) 2014 Simon Hengel author: Simon Hengel maintainer: Simon Hengel build-type: Simple cabal-version: >= 1.10 category: System source-repository head type: git location: https://github.com/sol/logging-facade library ghc-options: -Wall hs-source-dirs: src exposed-modules: System.Logging.Facade System.Logging.Facade.Sink System.Logging.Facade.Class System.Logging.Facade.Types build-depends: base == 4.* , transformers , template-haskell default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 ghc-options: -Wall hs-source-dirs: test main-is: Spec.hs other-modules: System.Logging.FacadeSpec build-depends: base == 4.* , logging-facade , hspec == 2.* default-language: Haskell2010 logging-facade-0.1.0/Setup.lhs0000644000000000000000000000011412561050170014326 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain logging-facade-0.1.0/LICENSE0000644000000000000000000000206212561050170013527 0ustar0000000000000000Copyright (c) 2014 Simon Hengel Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. logging-facade-0.1.0/test/0000755000000000000000000000000012561050170013501 5ustar0000000000000000logging-facade-0.1.0/test/Spec.hs0000644000000000000000000000005412561050170014726 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} logging-facade-0.1.0/test/System/0000755000000000000000000000000012561050170014765 5ustar0000000000000000logging-facade-0.1.0/test/System/Logging/0000755000000000000000000000000012561050170016353 5ustar0000000000000000logging-facade-0.1.0/test/System/Logging/FacadeSpec.hs0000644000000000000000000000124312561050170020665 0ustar0000000000000000module System.Logging.FacadeSpec (main, spec) where import Test.Hspec import Data.IORef import System.Logging.Facade.Types import System.Logging.Facade.Sink import System.Logging.Facade main :: IO () main = hspec spec spec :: Spec spec = do describe "info" $ do it "writes a log message with log level INFO" $ do ref <- newIORef [] let captureLogMessage :: LogSink captureLogMessage record = modifyIORef ref (record {logRecordLocation = Nothing} :) setLogSink captureLogMessage info "some log message" readIORef ref `shouldReturn` [LogRecord INFO Nothing "some log message"] logging-facade-0.1.0/src/0000755000000000000000000000000012561050170013311 5ustar0000000000000000logging-facade-0.1.0/src/System/0000755000000000000000000000000012561050170014575 5ustar0000000000000000logging-facade-0.1.0/src/System/Logging/0000755000000000000000000000000012561050170016163 5ustar0000000000000000logging-facade-0.1.0/src/System/Logging/Facade.hs0000644000000000000000000000330412561050170017662 0ustar0000000000000000{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,8,1) #define HAS_SOURCE_LOCATIONS {-# LANGUAGE ImplicitParams #-} #endif -- | -- This module is intended to be imported qualified: -- -- > import qualified System.Logging.Facade as Log module System.Logging.Facade ( -- * Producing log messages log , trace , debug , info , warn , error -- * Types , Logging , LogLevel(..) ) where import Prelude hiding (log, error) import System.Logging.Facade.Types import System.Logging.Facade.Class #ifdef HAS_SOURCE_LOCATIONS import GHC.SrcLoc import GHC.Stack #define with_loc (?loc :: CallStack) => #else #define with_loc #endif -- | Produce a log message with specified log level. log :: with_loc Logging m => LogLevel -> String -> m () log level message = consumeLogRecord (LogRecord level location message) where location :: Maybe Location #ifdef HAS_SOURCE_LOCATIONS location = case reverse (getCallStack ?loc) of (_, loc) : _ -> Just $ Location (srcLocPackage loc) (srcLocModule loc) (srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc) _ -> Nothing #else location = Nothing #endif -- | Produce a log message with log level `TRACE`. trace :: with_loc Logging m => String -> m () trace = log TRACE -- | Produce a log message with log level `DEBUG`. debug :: with_loc Logging m => String -> m () debug = log DEBUG -- | Produce a log message with log level `INFO`. info :: with_loc Logging m => String -> m () info = log INFO -- | Produce a log message with log level `WARN`. warn :: with_loc Logging m => String -> m () warn = log WARN -- | Produce a log message with log level `ERROR`. error :: with_loc Logging m => String -> m () error = log ERROR logging-facade-0.1.0/src/System/Logging/Facade/0000755000000000000000000000000012561050170017326 5ustar0000000000000000logging-facade-0.1.0/src/System/Logging/Facade/Sink.hs0000644000000000000000000000240312561050170020565 0ustar0000000000000000module System.Logging.Facade.Sink ( LogSink , defaultLogSink , setLogSink , getLogSink ) where import Data.IORef import System.IO import System.IO.Unsafe (unsafePerformIO) import System.Logging.Facade.Types -- | A consumer for log records type LogSink = LogRecord -> IO () -- use the unsafePerformIO hack to share one sink across a process logSink :: IORef LogSink logSink = unsafePerformIO (newIORef defaultLogSink) {-# NOINLINE logSink #-} -- | Return the global log sink. getLogSink :: IO LogSink getLogSink = readIORef logSink -- | Set the global log sink. setLogSink :: LogSink -> IO () setLogSink = atomicWriteIORef logSink -- | A log sink that writes log messages to `stderr` defaultLogSink :: LogSink defaultLogSink record = hPutStrLn stderr output where level = logRecordLevel record mLocation = logRecordLocation record message = logRecordMessage record output = shows level . location . showString ": " . showString message $ "" location = maybe (showString "") ((showString " " .) . formatLocation) mLocation formatLocation :: Location -> ShowS formatLocation loc = showString (locationFile loc) . colon . shows (locationLine loc) . colon . shows (locationColumn loc) where colon = showString ":" logging-facade-0.1.0/src/System/Logging/Facade/Class.hs0000644000000000000000000000523212561050170020731 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} -- to suppress deprecation warning for ErrorT module System.Logging.Facade.Class where import Control.Monad.Trans.Class import Control.Monad.Trans.Cont import Control.Monad.Trans.Error import Control.Monad.Trans.Identity import Control.Monad.Trans.List import Control.Monad.Trans.Maybe import Control.Monad.Trans.RWS.Lazy import qualified Control.Monad.Trans.RWS.Strict as Strict import Control.Monad.Trans.Reader import Control.Monad.Trans.State.Lazy import qualified Control.Monad.Trans.State.Strict as Strict import Control.Monad.Trans.Writer.Lazy import qualified Control.Monad.Trans.Writer.Strict as Strict #if MIN_VERSION_transformers(0,4,0) import Control.Monad.Trans.Except #endif #if !MIN_VERSION_base(4,8,0) import Data.Monoid #endif import System.Logging.Facade.Sink import System.Logging.Facade.Types -- | A type class for monads with logging support class Monad m => Logging m where consumeLogRecord :: LogRecord -> m () -- | Log messages that are produced in the `IO` monad are consumed by the -- global `LogSink`. instance Logging IO where consumeLogRecord record = do sink <- getLogSink sink record instance (Logging m) => Logging (ContT r m) where consumeLogRecord = lift . consumeLogRecord instance (Error e, Logging m) => Logging (ErrorT e m) where consumeLogRecord = lift . consumeLogRecord instance (Logging m) => Logging (IdentityT m) where consumeLogRecord = lift . consumeLogRecord instance (Logging m) => Logging (ListT m) where consumeLogRecord = lift . consumeLogRecord instance (Logging m) => Logging (MaybeT m) where consumeLogRecord = lift . consumeLogRecord instance (Logging m) => Logging (ReaderT r m) where consumeLogRecord = lift . consumeLogRecord instance (Monoid w, Logging m) => Logging (RWST r w s m) where consumeLogRecord = lift . consumeLogRecord instance (Monoid w, Logging m) => Logging (Strict.RWST r w s m) where consumeLogRecord = lift . consumeLogRecord instance (Logging m) => Logging (StateT s m) where consumeLogRecord = lift . consumeLogRecord instance (Logging m) => Logging (Strict.StateT s m) where consumeLogRecord = lift . consumeLogRecord instance (Monoid w, Logging m) => Logging (WriterT w m) where consumeLogRecord = lift . consumeLogRecord instance (Monoid w, Logging m) => Logging (Strict.WriterT w m) where consumeLogRecord = lift . consumeLogRecord #if MIN_VERSION_transformers(0,4,0) instance (Logging m) => Logging (ExceptT e m) where consumeLogRecord = lift . consumeLogRecord #endif logging-facade-0.1.0/src/System/Logging/Facade/Types.hs0000644000000000000000000000071412561050170020770 0ustar0000000000000000module System.Logging.Facade.Types where data LogLevel = TRACE | DEBUG | INFO | WARN | ERROR deriving (Eq, Show, Ord, Bounded, Enum) data Location = Location { locationPackage :: String , locationModule :: String , locationFile :: String , locationLine :: Int , locationColumn :: Int } deriving (Eq, Show) data LogRecord = LogRecord { logRecordLevel :: LogLevel , logRecordLocation :: Maybe Location , logRecordMessage :: String } deriving (Eq, Show)