simple-logger (empty) → 0.0.1
raw patch · 6 files changed
+266/−0 lines, 6 filesdep +basedep +fast-loggerdep +mtlsetup-changed
Dependencies added: base, fast-logger, mtl, text
Files
- LICENSE +30/−0
- README.md +17/−0
- Setup.hs +2/−0
- package.yaml +23/−0
- simple-logger.cabal +37/−0
- src/Control/Logger/Simple.hs +157/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Alexander Thiemann (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Alexander Thiemann nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,17 @@+# Control.Logger.Simple++A small and fast opinionated logging framework. Needs GHC >=7.10++## Example++```haskell+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.Logger.Simple++main :: IO ()+main =+ withGlobalLogging (LogConfig (Just "logfile.txt") True) $+ do logInfo "Hi!"+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ package.yaml view
@@ -0,0 +1,23 @@+name: simple-logger+version: 0.0.1+synopsis: A very simple but efficient logging framework+maintainer: Alexander Thiemann <mail@athiemann.net>+license: MIT+github: agrafix/simple-logger+extra-source-files:+ - README.md+ - package.yaml++ghc-options: -Wall++dependencies:+ - base >= 4.8 && < 5++library:+ source-dirs: src+ dependencies:+ - fast-logger+ - text+ - mtl+ exposed-modules:+ - Control.Logger.Simple
+ simple-logger.cabal view
@@ -0,0 +1,37 @@+-- This file has been generated from package.yaml by hpack version 0.14.0.+--+-- see: https://github.com/sol/hpack++name: simple-logger+version: 0.0.1+synopsis: A very simple but efficient logging framework+homepage: https://github.com/agrafix/simple-logger#readme+bug-reports: https://github.com/agrafix/simple-logger/issues+maintainer: Alexander Thiemann <mail@athiemann.net>+license: MIT+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10++extra-source-files:+ package.yaml+ README.md++source-repository head+ type: git+ location: https://github.com/agrafix/simple-logger++library+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ base >= 4.8 && < 5+ , fast-logger+ , text+ , mtl+ exposed-modules:+ Control.Logger.Simple+ other-modules:+ Paths_simple_logger+ default-language: Haskell2010
+ src/Control/Logger/Simple.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE ImplicitParams #-}+{-# LANGUAGE OverloadedStrings #-}+module Control.Logger.Simple+ ( withGlobalLogging, LogConfig(..)+ , setLogLevel, LogLevel(..)+ , logTrace, logDebug, logInfo, logNote, logWarn, logError+ , logFail+ , showText, (<>)+ )+where++import Control.Exception+import Control.Monad+import Control.Monad.Trans+import Data.IORef+import Data.Monoid+import System.IO.Unsafe+import System.Log.FastLogger+import qualified Data.Text as T+import qualified Data.Traversable as T+import qualified GHC.SrcLoc as GHC+import qualified GHC.Stack as GHC++data Loggers+ = Loggers+ { l_file :: Maybe (FastLogger, IO ())+ , l_stderr :: Maybe (FastLogger, IO ())+ , l_timeCache :: IO FormattedTime+ }++data LogConfig+ = LogConfig+ { lc_file :: Maybe FilePath+ , lc_stderr :: Bool+ }++data LogLevel+ = LogTrace+ | LogDebug+ | LogInfo+ | LogNote+ | LogWarn+ | LogError+ deriving (Eq, Show, Read, Ord)++showText :: Show a => a -> T.Text+showText = T.pack . show++logTrace :: (?callStack :: GHC.CallStack) => MonadIO m => T.Text -> m ()+logTrace = doLog LogTrace++logDebug :: (?callStack :: GHC.CallStack) => MonadIO m => T.Text -> m ()+logDebug = doLog LogDebug++logInfo :: (?callStack :: GHC.CallStack) => MonadIO m => T.Text -> m ()+logInfo = doLog LogInfo++logNote :: (?callStack :: GHC.CallStack) => MonadIO m => T.Text -> m ()+logNote = doLog LogNote++logWarn :: (?callStack :: GHC.CallStack) => MonadIO m => T.Text -> m ()+logWarn = doLog LogWarn++logError :: (?callStack :: GHC.CallStack) => MonadIO m => T.Text -> m ()+logError = doLog LogError++-- | Log on error level and calls 'fail'+logFail :: (?callStack :: GHC.CallStack) => MonadIO m => T.Text -> m a+logFail t =+ do doLog LogError t+ fail (T.unpack t)++doLog :: (?callStack :: GHC.CallStack) => MonadIO m => LogLevel -> T.Text -> m ()+doLog ll txt =+ liftIO $+ readIORef logLevel >>= \logLim ->+ when (ll >= logLim) $+ do lgrs <- readIORef loggers+ time <- l_timeCache lgrs+ let loc =+ case GHC.getCallStack ?callStack of+ ((_, l):_) ->+ GHC.srcLocFile l <> ":" <> show (GHC.srcLocStartLine l)+ _ -> "unknown"+ msg =+ "[" <> renderLevel <> " "+ <> toLogStr time+ <> " "+ <> toLogStr loc+ <> "] "+ <> toLogStr txt+ <> "\n"+ forM_ (l_stderr lgrs) $ \(writeLog, _) -> writeLog (renderColor <> msg <> resetColor)+ forM_ (l_file lgrs) $ \(writeLog, _) -> writeLog msg+ where+ renderLevel =+ case ll of+ LogTrace -> "TRACE"+ LogDebug -> "DEBUG"+ LogInfo -> "INFO"+ LogNote -> "NOTE"+ LogWarn -> "WARN"+ LogError -> "ERROR"+ resetColor =+ "\o33[0;0m"+ renderColor =+ case ll of+ LogTrace -> "\o33[0;30m"+ LogDebug -> "\o33[0;34m"+ LogInfo -> "\o33[0;34m"+ LogNote -> "\o33[1;32m"+ LogWarn -> "\o33[0;33m"+ LogError -> "\o33[1;31m"++loggers :: IORef Loggers+loggers =+ unsafePerformIO $+ do tc <- newTimeCache timeFormat+ newIORef (Loggers Nothing Nothing tc)+{-# NOINLINE loggers #-}++logLevel :: IORef LogLevel+logLevel = unsafePerformIO $ newIORef LogDebug+{-# NOINLINE logLevel #-}++-- | Set the verbosity level. Messages at our higher than this level are+-- displayed. It defaults to 'LogDebug'.+setLogLevel :: LogLevel -> IO ()+setLogLevel = atomicWriteIORef logLevel++-- | Setup global logging. Wrap your 'main' function with this.+withGlobalLogging :: LogConfig -> IO a -> IO a+withGlobalLogging lc f =+ bracket initLogger flushLogger (const f)+ where+ flushLogger (Loggers a b _) =+ do forM_ a $ \(_, flush) -> flush+ forM_ b $ \(_, flush) -> flush+ initLogger =+ do fileLogger <-+ flip T.mapM (lc_file lc) $ \fp ->+ do let spec =+ FileLogSpec+ { log_file = fp+ , log_file_size = 1024 * 1024 * 50+ , log_backup_number = 5+ }+ newFastLogger (LogFile spec defaultBufSize)+ stderrLogger <-+ if lc_stderr lc then Just <$> newFastLogger (LogStderr defaultBufSize) else pure Nothing+ tc <- newTimeCache timeFormat+ let lgrs = Loggers fileLogger stderrLogger tc+ writeIORef loggers lgrs+ pure lgrs++timeFormat :: TimeFormat+timeFormat = "%Y-%m-%d %T %z"