logging-facade-0.1.1/0000755000000000000000000000000012662233635012536 5ustar0000000000000000logging-facade-0.1.1/logging-facade.cabal0000644000000000000000000000215112662233635016350 0ustar0000000000000000name: logging-facade version: 0.1.1 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.1/LICENSE0000644000000000000000000000206212662233635013543 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.1/Setup.lhs0000644000000000000000000000011412662233635014342 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain logging-facade-0.1.1/test/0000755000000000000000000000000012662233635013515 5ustar0000000000000000logging-facade-0.1.1/test/Spec.hs0000644000000000000000000000005412662233635014742 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} logging-facade-0.1.1/test/System/0000755000000000000000000000000012662233635015001 5ustar0000000000000000logging-facade-0.1.1/test/System/Logging/0000755000000000000000000000000012662233635016367 5ustar0000000000000000logging-facade-0.1.1/test/System/Logging/FacadeSpec.hs0000644000000000000000000000124312662233635020701 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.1/src/0000755000000000000000000000000012662233635013325 5ustar0000000000000000logging-facade-0.1.1/src/System/0000755000000000000000000000000012662233635014611 5ustar0000000000000000logging-facade-0.1.1/src/System/Logging/0000755000000000000000000000000012662233635016177 5ustar0000000000000000logging-facade-0.1.1/src/System/Logging/Facade.hs0000644000000000000000000000335112662233635017700 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 #if ! MIN_VERSION_base(4,9,0) import GHC.SrcLoc #endif 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.1/src/System/Logging/Facade/0000755000000000000000000000000012662233635017342 5ustar0000000000000000logging-facade-0.1.1/src/System/Logging/Facade/Sink.hs0000644000000000000000000000240312662233635020601 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.1/src/System/Logging/Facade/Class.hs0000644000000000000000000000523212662233635020745 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.1/src/System/Logging/Facade/Types.hs0000644000000000000000000000071412662233635021004 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)