logging-facade-0.3.1/0000755000000000000000000000000007346545000012533 5ustar0000000000000000logging-facade-0.3.1/LICENSE0000644000000000000000000000206707346545000013545 0ustar0000000000000000Copyright (c) 2014-2021 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.1/Setup.lhs0000644000000000000000000000011407346545000014337 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain logging-facade-0.3.1/logging-facade.cabal0000644000000000000000000000302107346545000016342 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.34.5. -- -- see: https://github.com/sol/hpack name: logging-facade version: 0.3.1 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-2021 Simon Hengel author: Simon Hengel maintainer: Simon Hengel build-type: Simple 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 build-tool-depends: hspec-discover:hspec-discover hs-source-dirs: test main-is: Spec.hs other-modules: Helper System.Logging.Facade.SinkSpec System.Logging.FacadeSpec Paths_logging_facade build-depends: base ==4.* , hspec ==2.* , logging-facade default-language: Haskell2010 logging-facade-0.3.1/src/System/Logging/0000755000000000000000000000000007346545000016174 5ustar0000000000000000logging-facade-0.3.1/src/System/Logging/Facade.hs0000644000000000000000000000276107346545000017701 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.1/src/System/Logging/Facade/0000755000000000000000000000000007346545000017337 5ustar0000000000000000logging-facade-0.3.1/src/System/Logging/Facade/Class.hs0000644000000000000000000000531007346545000020737 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.Identity 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 #if !MIN_VERSION_transformers(0,6,0) import Control.Monad.Trans.List import Control.Monad.Trans.Error instance (Logging m) => Logging (ListT m) where consumeLogRecord = lift . consumeLogRecord instance (Error e, Logging m) => Logging (ErrorT e m) where consumeLogRecord = lift . consumeLogRecord #endif -- | 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 (Logging m) => Logging (IdentityT 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.1/src/System/Logging/Facade/Sink.hs0000644000000000000000000000416207346545000020602 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.1/src/System/Logging/Facade/Types.hs0000644000000000000000000000072207346545000021000 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) logging-facade-0.3.1/test/0000755000000000000000000000000007346545000013512 5ustar0000000000000000logging-facade-0.3.1/test/Helper.hs0000644000000000000000000000063407346545000015270 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.1/test/Spec.hs0000644000000000000000000000005407346545000014737 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} logging-facade-0.3.1/test/System/Logging/Facade/0000755000000000000000000000000007346545000017527 5ustar0000000000000000logging-facade-0.3.1/test/System/Logging/Facade/SinkSpec.hs0000644000000000000000000000146307346545000021606 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.1/test/System/Logging/0000755000000000000000000000000007346545000016364 5ustar0000000000000000logging-facade-0.3.1/test/System/Logging/FacadeSpec.hs0000644000000000000000000000076707346545000020710 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"]