logging-facade (empty) → 0.0.0

raw patch · 10 files changed

+351/−0 lines, 10 filesdep +basedep +hspecdep +logging-facadesetup-changed

Dependencies added: base, hspec, logging-facade, template-haskell, transformers

Files

• LICENSE +19/−0
• Setup.lhs +3/−0
• logging-facade.cabal +44/−0
• src/System/Logging/Facade.hs +46/−0
• src/System/Logging/Facade/Class.hs +77/−0
• src/System/Logging/Facade/Sink.hs +42/−0
• src/System/Logging/Facade/TH.hs +79/−0
• src/System/Logging/Facade/Types.hs +18/−0
• test/Spec.hs +1/−0
• test/System/Logging/FacadeSpec.hs +22/−0

@@ -0,0 +1,19 @@+Copyright (c) 2014 Simon Hengel <sol@typeful.net>++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.

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,44 @@+name:             logging-facade+version:          0.0.0+synopsis:         Simple logging abstraction that allows multiple backends+description:      Simple logging abstraction that allows multiple backends+license:          MIT+license-file:     LICENSE+copyright:        (c) 2014 Simon Hengel+author:           Simon Hengel <sol@typeful.net>+maintainer:       Simon Hengel <sol@typeful.net>+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.TH+      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

@@ -0,0 +1,46 @@+-- |+-- 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++-- | Produce a log message with specified log level.+log :: Logging m => LogLevel -> String -> m ()+log level message = consumeLogRecord (LogRecord level Nothing message)++-- | Produce a log message with log level `TRACE`.+trace :: Logging m => String -> m ()+trace = log TRACE++-- | Produce a log message with log level `DEBUG`.+debug :: Logging m => String -> m ()+debug = log DEBUG++-- | Produce a log message with log level `INFO`.+info :: Logging m => String -> m ()+info = log INFO++-- | Produce a log message with log level `WARN`.+warn :: Logging m => String -> m ()+warn = log WARN++-- | Produce a log message with log level `ERROR`.+error :: Logging m => String -> m ()+error = log ERROR

@@ -0,0 +1,77 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-deprecations #-} -- to suppress deprecation warning for ErrorT+module System.Logging.Facade.Class where++import           Data.Monoid+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.Reader+import           Control.Monad.Trans.RWS.Lazy+import qualified Control.Monad.Trans.RWS.Strict as Strict+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++import           System.Logging.Facade.Types+import           System.Logging.Facade.Sink++-- | 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

@@ -0,0 +1,42 @@+module 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 ":"

@@ -0,0 +1,79 @@+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- This module is intended to be imported qualified:+--+-- > import qualified System.Logging.Facade.TH as Log+module System.Logging.Facade.TH (+-- * Producing log messages+  log+, trace+, debug+, info+, warn+, error++-- * Types+, Logging+, LogLevel(..)+) where++import           Prelude hiding (mod, log, error)+import           Language.Haskell.TH+import           Language.Haskell.TH.Syntax++import           System.Logging.Facade.Types+import           System.Logging.Facade.Class++-- |+-- A Template Haskell version of `System.Logging.Facade.log` that adds a+-- source location to the produced log record.+log :: ExpQ+log = [|\level -> consumeLogRecord . LogRecord level $(mkLocation)|]++-- |+-- A Template Haskell version of `System.Logging.Facade.trace` that adds a+-- source location to the produced log record.+trace :: ExpQ+trace = [|$(log) TRACE|]++-- |+-- A Template Haskell version of `System.Logging.Facade.debug` that adds a+-- source location to the produced log record.+debug :: ExpQ+debug = [|$(log) DEBUG|]++-- |+-- A Template Haskell version of `System.Logging.Facade.info` that adds a+-- source location to the produced log record.+info :: ExpQ+info = [|$(log) INFO|]++-- |+-- A Template Haskell version of `System.Logging.Facade.warn` that adds a+-- source location to the produced log record.+warn :: ExpQ+warn = [|$(log) WARN|]++-- |+-- A Template Haskell version of `System.Logging.Facade.error` that adds a+-- source location to the produced log record.+error :: ExpQ+error = [|$(log) ERROR|]++instance Lift LogLevel where+  lift level = case level of+    TRACE -> [|TRACE|]+    DEBUG -> [|DEBUG|]+    INFO -> [|INFO|]+    WARN -> [|WARN|]+    ERROR -> [|ERROR|]++mkLocation :: ExpQ+mkLocation = do+  loc <- location+  let file = loc_filename loc+      package = loc_package loc+      mod = loc_module loc+      (line, column) = loc_start loc+  [|Just (Location {locationPackage = package, locationModule = mod, locationFile = file, locationLine = line, locationColumn = column})|]

@@ -0,0 +1,18 @@+module 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)

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -0,0 +1,22 @@+module 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 :)+      setLogSink captureLogMessage+      info "some log message"+      readIORef ref `shouldReturn` [LogRecord INFO Nothing "some log message"]