log-effect (empty) → 0.2.0.1
raw patch · 5 files changed
+211/−0 lines, 5 filesdep +basedep +bytestringdep +extensible-effectssetup-changed
Dependencies added: base, bytestring, extensible-effects, fast-logger, time
Files
- LICENSE +22/−0
- Setup.hs +2/−0
- log-effect.cabal +30/−0
- src/Control/Eff/Log.hs +94/−0
- src/Control/Eff/Log/Simple.hs +63/−0
+ LICENSE view
@@ -0,0 +1,22 @@+The MIT License (MIT)++Copyright (c) 2013, 2014 Tobias Florek (me@ibotty.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.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ log-effect.cabal view
@@ -0,0 +1,30 @@+-- Initial log-effect.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: log-effect+version: 0.2.0.1+synopsis: An extensible log effect using extensible-effects+description: Any help (especially documentation) is very welcome,+homepage: https://github.com/ibotty/log-effect+license: MIT+license-file: LICENSE+author: Tobias Florek+maintainer: tob@butter.sh+-- copyright: +category: Control, Effect, Logging+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++library+ exposed-modules: Control.Eff.Log+ , Control.Eff.Log.Simple+ -- other-modules: + -- other-extensions: + build-depends: base >=4.6 && <4.7+ , bytestring >=0.10.2 && <0.11+ , extensible-effects >=1.2 && <1.3+ , fast-logger >=2.1 && <2.2+ , time >=1.4 && <1.5+ hs-source-dirs: src+ default-language: Haskell2010
+ src/Control/Eff/Log.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}+module Control.Eff.Log+ ( Log(Log)+ , ShowLog+ , showLog+ , logLine+ , logE+ , filterLog+ , runLogPure+ , runLogStdErr+ , runLogFile+ , runLog+ ) where++import Control.Applicative ((<$>))+import Control.Eff ( Eff, SetMember, VE(..), (:>)+ , admin, handleRelay, inj, interpose, send)+import Control.Eff.Lift (Lift, lift)+import Data.Typeable (Typeable, Typeable1)+import System.IO (stderr)+import System.Log.FastLogger (LoggerSet, LogStr, defaultBufSize, fromLogStr, newLoggerSet, pushLogStr, toLogStr)+import qualified Data.ByteString.Char8 as B8++data Log a v = Log+ { logLine :: a+ , logNext :: v+ } deriving (Typeable, Functor)++instance SetMember Log (Log m) (Log m :> a)++class ShowLog l where+ showLog :: l -> LogStr++instance ShowLog String where+ showLog = toLogStr++-- | a monadic action that does the real logging+type Logger m l = forall v. Log l v -> m ()++logE :: (Typeable l, SetMember Log (Log l) r)+ => l -> Eff r ()+logE line = send $ \next -> inj (Log line (next ()))++runLogPure :: (Typeable l)+ => Eff (Log l :> r) a+ -> Eff r (a, [l])+runLogPure = go . admin+ where go (Val v) = return (v, [])+ go (E req) = handleRelay req go performLog+ performLog l = fmap (prefixLogWith l) (go (logNext l))+ prefixLogWith log' (v, l) = (v, logLine log' : l)++runLog :: (Typeable l, Typeable1 m, SetMember Lift (Lift m) r)+ => Logger m l -> Eff (Log l :> r) a -> Eff r a+runLog logger = go . admin+ where go (Val v) = return v+ go (E req) = handleRelay req go performLog+ performLog l = lift (logger l) >> go (logNext l)++filterLog :: (Typeable l, SetMember Log (Log l) r)+ => (l -> Bool) -> Eff r a -> Eff r a+filterLog f = go . admin+ where go (Val v) = return v+ go (E req) = interpose req go filter'+ where filter' (Log l v) = if f l then send (<$> req) >>= go+ else go v+runLogStdErr :: (Typeable l, ShowLog l, SetMember Lift (Lift IO) r)+ => Eff (Log l :> r) a -> Eff r a+runLogStdErr = runLog stdErrLogger++stdErrLogger :: ShowLog l => Logger IO l+stdErrLogger = B8.hPutStrLn stderr . fromLogStr . showLog . logLine++-- | Log to file.+runLogFile :: (Typeable l, ShowLog l, SetMember Lift (Lift IO) r)+ => FilePath -> Eff (Log l :> r) a -> Eff r a+runLogFile f eff = do+ s <- lift (newLoggerSet defaultBufSize (Just f))+ runLogWithLoggerSet s eff++-- | Log to a file using a 'LoggerSet'.+runLogWithLoggerSet :: (Typeable l, ShowLog l, SetMember Lift (Lift IO) r)+ => LoggerSet -> Eff (Log l :> r) a -> Eff r a+runLogWithLoggerSet s = runLog (fileLogger s)++fileLogger :: ShowLog l => LoggerSet -> Logger IO l+fileLogger loggerSet = pushLogStr loggerSet . showLog . logLine
+ src/Control/Eff/Log/Simple.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverloadedStrings #-}+module Control.Eff.Log.Simple+ ( SimpleLog+ , Severity(..)+ , logTo+ , debug+ , info+ , notice+ , warning+ , error+ , critical+ , alert+ , panic+ ) where++import Prelude hiding (error)+import Control.Eff (Eff, SetMember)+import Control.Eff.Log+import Data.Monoid ((<>))+import Data.Typeable (Typeable)+import System.Log.FastLogger (toLogStr)++data Severity = DEBUG | INFO | NOTICE | WARNING | ERROR | CRITICAL | ALERT | PANIC+ deriving (Bounded, Enum, Eq, Ord, Read, Show, Typeable)++logTo :: (Typeable l, SetMember Log (Log (Severity, l)) r)+ => Severity -> l -> Eff r ()+logTo sev line = logE (sev, line)++debug :: (Typeable l, SetMember Log (Log (Severity, l)) r) => l -> Eff r ()+debug = logTo DEBUG++info :: (Typeable l, SetMember Log (Log (Severity, l)) r) => l -> Eff r ()+info = logTo INFO++notice :: (Typeable l, SetMember Log (Log (Severity, l)) r) => l -> Eff r ()+notice = logTo NOTICE++warning :: (Typeable l, SetMember Log (Log (Severity, l)) r) => l -> Eff r ()+warning = logTo WARNING++error :: (Typeable l, SetMember Log (Log (Severity, l)) r) => l -> Eff r ()+error = logTo ERROR++critical :: (Typeable l, SetMember Log (Log (Severity, l)) r) => l -> Eff r ()+critical = logTo CRITICAL++alert :: (Typeable l, SetMember Log (Log (Severity, l)) r) => l -> Eff r ()+alert = logTo ALERT++panic :: (Typeable l, SetMember Log (Log (Severity, l)) r) => l -> Eff r ()+panic = logTo PANIC++type SimpleLog a = Log (Severity, a)++instance ShowLog a => ShowLog (Severity, a) where+ showLog (sev, line) = "[" <> toLogStr (show sev) <> "] " <> showLog line