logging-facade-0.3.0/0000755000000000000000000000000013114012603012516 5ustar0000000000000000logging-facade-0.3.0/logging-facade.cabal0000644000000000000000000000270413114012603016334 0ustar0000000000000000-- This file has been generated from package.yaml by hpack version 0.17.0. -- -- see: https://github.com/sol/hpack name: logging-facade version: 0.3.0 synopsis: Simple logging abstraction that allows multiple back-ends description: Simple logging abstraction that allows multiple back-ends homepage: https://github.com/sol/logging-facade#readme bug-reports: https://github.com/sol/logging-facade/issues license: MIT license-file: LICENSE copyright: (c) 2014-2017 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.Class System.Logging.Facade.Sink System.Logging.Facade.Types other-modules: Paths_logging_facade build-depends: base == 4.* , call-stack , transformers default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 ghc-options: -Wall hs-source-dirs: test main-is: Spec.hs other-modules: Helper System.Logging.Facade.SinkSpec System.Logging.FacadeSpec build-depends: base == 4.* , logging-facade , hspec == 2.* default-language: Haskell2010 logging-facade-0.3.0/LICENSE0000644000000000000000000000206713114012603013530 0ustar0000000000000000Copyright (c) 2014-2017 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.3.0/Setup.lhs0000644000000000000000000000011413114012603014322 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain logging-facade-0.3.0/test/0000755000000000000000000000000013114012603013475 5ustar0000000000000000logging-facade-0.3.0/test/Spec.hs0000644000000000000000000000005413114012603014722 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} logging-facade-0.3.0/test/Helper.hs0000644000000000000000000000063413114012603015253 0ustar0000000000000000module Helper ( module Test.Hspec , logSinkSpy ) where import Test.Hspec import Data.IORef import System.Logging.Facade.Types import System.Logging.Facade.Sink logSinkSpy :: IO (IO [LogRecord], LogSink) logSinkSpy = do ref <- newIORef [] let spy :: LogSink spy record = modifyIORef ref (record {logRecordLocation = Nothing} :) return (readIORef ref, spy) logging-facade-0.3.0/test/System/0000755000000000000000000000000013114012603014761 5ustar0000000000000000logging-facade-0.3.0/test/System/Logging/0000755000000000000000000000000013114012603016347 5ustar0000000000000000logging-facade-0.3.0/test/System/Logging/FacadeSpec.hs0000644000000000000000000000076713114012603020673 0ustar0000000000000000module System.Logging.FacadeSpec (main, spec) where import Helper 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 (logRecords, spy) <- logSinkSpy withLogSink spy (info "some log message") logRecords `shouldReturn` [LogRecord INFO Nothing "some log message"] logging-facade-0.3.0/test/System/Logging/Facade/0000755000000000000000000000000013114012603017512 5ustar0000000000000000logging-facade-0.3.0/test/System/Logging/Facade/SinkSpec.hs0000644000000000000000000000146313114012603021571 0ustar0000000000000000module System.Logging.Facade.SinkSpec (main, spec) where import Helper import System.Logging.Facade import System.Logging.Facade.Types import System.Logging.Facade.Sink main :: IO () main = hspec spec spec :: Spec spec = do describe "withLogSink" $ do it "sets the global log sink to specified value before running specified action" $ do (logRecords, spy) <- logSinkSpy withLogSink spy (info "some log message") logRecords `shouldReturn` [LogRecord INFO Nothing "some log message"] it "restores the original log sink when done" $ do (logRecords, spy) <- logSinkSpy setLogSink spy withLogSink (\_ -> return ()) (return ()) info "some log message" logRecords `shouldReturn` [LogRecord INFO Nothing "some log message"] logging-facade-0.3.0/src/0000755000000000000000000000000013114012603013305 5ustar0000000000000000logging-facade-0.3.0/src/System/0000755000000000000000000000000013114012603014571 5ustar0000000000000000logging-facade-0.3.0/src/System/Logging/0000755000000000000000000000000013114012603016157 5ustar0000000000000000logging-facade-0.3.0/src/System/Logging/Facade.hs0000644000000000000000000000276113114012603017664 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} -- | -- 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 Data.CallStack import System.Logging.Facade.Types import System.Logging.Facade.Class -- | Produce a log message with specified log level. log :: (HasCallStack, Logging m) => LogLevel -> String -> m () log level message = consumeLogRecord (LogRecord level location message) location :: HasCallStack => Maybe Location location = case reverse callStack of (_, loc) : _ -> Just $ Location (srcLocPackage loc) (srcLocModule loc) (srcLocFile loc) (srcLocStartLine loc) (srcLocStartCol loc) _ -> Nothing -- | Produce a log message with log level `TRACE`. trace :: (HasCallStack, Logging m) => String -> m () trace = log TRACE -- | Produce a log message with log level `DEBUG`. debug :: (HasCallStack, Logging m) => String -> m () debug = log DEBUG -- | Produce a log message with log level `INFO`. info :: (HasCallStack, Logging m) => String -> m () info = log INFO -- | Produce a log message with log level `WARN`. warn :: (HasCallStack, Logging m) => String -> m () warn = log WARN -- | Produce a log message with log level `ERROR`. error :: (HasCallStack, Logging m) => String -> m () error = log ERROR logging-facade-0.3.0/src/System/Logging/Facade/0000755000000000000000000000000013114012603017322 5ustar0000000000000000logging-facade-0.3.0/src/System/Logging/Facade/Sink.hs0000644000000000000000000000416213114012603020565 0ustar0000000000000000{-# LANGUAGE CPP #-} module System.Logging.Facade.Sink ( LogSink , defaultLogSink , getLogSink , setLogSink , swapLogSink , withLogSink ) where import Control.Concurrent import Data.IORef import System.IO import System.IO.Unsafe (unsafePerformIO) import Control.Exception 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 (defaultLogSink >>= newIORef) {-# NOINLINE logSink #-} -- | Return the global log sink. getLogSink :: IO LogSink getLogSink = readIORef logSink -- | Set the global log sink. setLogSink :: LogSink -> IO () setLogSink = atomicWriteIORef logSink -- | Return the global log sink and set it to a new value in one atomic -- operation. swapLogSink :: LogSink -> IO LogSink swapLogSink new = atomicModifyIORef logSink $ \old -> (new, old) -- | Set the global log sink to a specified value, run given action, and -- finally restore the global log sink to its previous value. withLogSink :: LogSink -> IO () -> IO () withLogSink sink action = bracket (swapLogSink sink) setLogSink (const action) -- | A thread-safe log sink that writes log messages to `stderr` defaultLogSink :: IO LogSink defaultLogSink = defaultLogSink_ `fmap` newMVar () defaultLogSink_ :: MVar () -> LogSink defaultLogSink_ mvar record = withMVar mvar (\() -> 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 ":" #if !MIN_VERSION_base(4,6,0) atomicWriteIORef :: IORef a -> a -> IO () atomicWriteIORef ref a = do x <- atomicModifyIORef ref (\_ -> (a, ())) x `seq` return () #endif logging-facade-0.3.0/src/System/Logging/Facade/Class.hs0000644000000000000000000000523213114012603020725 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.3.0/src/System/Logging/Facade/Types.hs0000644000000000000000000000072213114012603020763 0ustar0000000000000000module System.Logging.Facade.Types where data LogLevel = TRACE | DEBUG | INFO | WARN | ERROR deriving (Eq, Show, Read, 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)