log-effect-syslog (empty) → 0.1.0
raw patch · 5 files changed
+240/−0 lines, 5 filesdep +basedep +bytestringdep +extensible-effectssetup-changed
Dependencies added: base, bytestring, extensible-effects, hsyslog, log-effect, monad-control, transformers-base
Files
- LICENSE +30/−0
- README.md +27/−0
- Setup.hs +2/−0
- log-effect-syslog.cabal +34/−0
- src/Control/Eff/Log/Syslog.hs +147/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2018, Lana Black++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 Lana Black 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,27 @@+# log-effect-syslog++This package contains a set of utility functions that provide ability to log to+syslog using+(extensible-effects)[https://hackage.haskell.org/package/extensible-effects]+and (log-effect)[https://hackage.haskell.org/package/log-effect].++## Example++```haskell+import Control.Eff+import Control.Eff.Lift+import Control.Eff.Log+import Control.Eff.Log.Syslog++someComp :: ( [LogM IO SyslogMsg] <:: r+ , Lifted IO r+ ) => Eff r ()+someComp = do logInfo "Doing something"+ logDebug "Doing something else"+ {- ... -}+ logInfo "Ok, we're done"++main :: IO ()+main = runLift $ runSyslog "MyProgram" [LogPID] User+ $ someComp+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ log-effect-syslog.cabal view
@@ -0,0 +1,34 @@+-- Initial log-effect-syslog.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: log-effect-syslog+version: 0.1.0+synopsis: Syslog functions for log-effect+description: Utility functions for combining log-effect and syslog+homepage: https://github.com/greydot/log-effect-syslog+license: BSD3+license-file: LICENSE+author: Lana Black+maintainer: lanablack@amok.cc+-- copyright: +category: Control, Effect, Logging, Syslog+build-type: Simple+cabal-version: >=1.10+extra-source-files: README.md++library+ exposed-modules: Control.Eff.Log.Syslog+ build-depends: base >=4.9 && <5.0,+ bytestring >= 0.10,+ extensible-effects >= 2.6.0.0,+ hsyslog == 5.*,+ log-effect >= 1.0.0,+ monad-control >= 1.0,+ transformers-base+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall -Wno-simplifiable-class-constraints++source-repository head+ type: git+ location: https://github.com/greydot/log-effect-syslog
+ src/Control/Eff/Log/Syslog.hs view
@@ -0,0 +1,147 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+module Control.Eff.Log.Syslog ( SyslogMsg(..)+ , syslogLogger+ , runSyslog+ , getLogMask+ , setLogMask+ , logSyslog+ , logDebug+ , logInfo+ , logNotice+ , logWarning+ , logError+ , logCritical+ , logAlert+ , logEmergency+ -- Re-exports from hsyslog+ , Priority(..)+ , Option(..)+ , Facility(..)+ ) where++import Control.Eff+import Control.Eff.Lift+import Control.Eff.Log+import Control.Monad (void)+import Control.Monad.Base (MonadBase,liftBase)+import Control.Monad.Trans.Control (MonadBaseControl, liftBaseOp_)+import Data.ByteString (ByteString)+import Data.ByteString.Char8 (pack)+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Data.Char (toLower)+import Data.Monoid (mconcat)+import System.Posix.Syslog (Priority(..), Option(..), Facility(..), syslog, withSyslog, setlogmask)++-- | Message type that contains priority and message text.+data SyslogMsg = SyslogMsg Priority ByteString++instance LogMessage SyslogMsg where+ -- Format:+ -- [priority] message+ toMsg (SyslogMsg p s) = mconcat [ "["+ , pack $ map toLower $ show p+ , "] "+ , s+ ]++-- | Syslog Logger+syslogLogger :: MonadBase IO m => Logger m SyslogMsg+syslogLogger (SyslogMsg p s) = liftBase $ unsafeUseAsCStringLen s $ syslog Nothing p++-- | Wrapper around 'runLogM' and 'withSyslog'+runSyslog :: ( MonadBase IO m+ , MonadBaseControl IO (Eff r)+ , Lifted m r+ ) => String -- ^ Syslog ident+ -> [Option] -- ^ Syslog options+ -> Facility -- ^ Syslog facility+ -> Eff (LogM m SyslogMsg ': r) a -> Eff r a+runSyslog idn opts fac = w . runLogM syslogLogger+ where+ w = liftBaseOp_ (withSyslog idn opts fac)++-- | Get syslog log mask.+-- Implemented as a wrapper around hsyslog's 'setlogmask'+getLogMask :: MonadBase IO m => m [Priority]+getLogMask = liftBase $ setlogmask []++-- | Set syslog log mask+-- Implemented as a wrapper around hsyslog's 'setlogmask'+setLogMask :: MonadBase IO m => [Priority] -> m ()+setLogMask = liftBase . void . setlogmask++-- | Log some text to syslog+logSyslog :: ( LogMessage l+ , MonadBase IO m+ , Member (LogM m SyslogMsg) r+ , Lifted m r)+ => Priority -> l -> Eff r ()+logSyslog p l = logM (SyslogMsg p $ toMsg l)+{-# INLINE logSyslog #-}++logDebug :: ( LogMessage l+ , MonadBase IO m+ , Member (LogM m SyslogMsg) r+ , Lifted m r)+ => l -> Eff r ()+logDebug = logSyslog Debug+{-# INLINE logDebug #-}++logInfo :: ( LogMessage l+ , MonadBase IO m+ , Member (LogM m SyslogMsg) r+ , Lifted m r)+ => l -> Eff r ()+logInfo = logSyslog Info+{-# INLINE logInfo #-}++logNotice :: ( LogMessage l+ , MonadBase IO m+ , Member (LogM m SyslogMsg) r+ , Lifted m r)+ => l -> Eff r ()+logNotice = logSyslog Notice+{-# INLINE logNotice #-}++logWarning :: ( LogMessage l+ , MonadBase IO m+ , Member (LogM m SyslogMsg) r+ , Lifted m r)+ => l -> Eff r ()+logWarning = logSyslog Warning+{-# INLINE logWarning #-}++logError :: ( LogMessage l+ , MonadBase IO m+ , Member (LogM m SyslogMsg) r+ , Lifted m r)+ => l -> Eff r ()+logError = logSyslog Error+{-# INLINE logError #-}++logCritical :: ( LogMessage l+ , MonadBase IO m+ , Member (LogM m SyslogMsg) r+ , Lifted m r)+ => l -> Eff r ()+logCritical = logSyslog Critical+{-# INLINE logCritical #-}++logAlert :: ( LogMessage l+ , MonadBase IO m+ , Member (LogM m SyslogMsg) r+ , Lifted m r)+ => l -> Eff r ()+logAlert = logSyslog Alert+{-# INLINE logAlert #-}++logEmergency :: ( LogMessage l+ , MonadBase IO m+ , Member (LogM m SyslogMsg) r+ , Lifted m r)+ => l -> Eff r ()+logEmergency = logSyslog Emergency+{-# INLINE logEmergency #-}