packages feed

apiary-logger (empty) → 0.8.0.0

raw patch · 5 files changed

+172/−0 lines, 5 filesdep +apiarydep +basedep +data-default-classsetup-changed

Dependencies added: apiary, base, data-default-class, fast-logger, monad-control, monad-logger, mtl, reflection, transformers-base

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2014 Hirotomo Moriwaki++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
+ apiary-logger.cabal view
@@ -0,0 +1,37 @@+name:                apiary-logger+version:             0.8.0.0+synopsis:            fast-logger support for apiary web framework.+description:+  example: <https://github.com/philopon/apiary/blob/master/examples/persistent.hs>+license:             MIT+license-file:        LICENSE+author:              HirotomoMoriwaki<philopon.dependence@gmail.com>+maintainer:          HirotomoMoriwaki<philopon.dependence@gmail.com>+Homepage:            https://github.com/philopon/apiary+Bug-reports:         https://github.com/philopon/apiary/issues+copyright:           (c) 2014 Hirotomo Moriwaki+category:            Web+build-type:          Simple+stability:           experimental+-- extra-source-files:  +cabal-version:       >=1.10++library+  exposed-modules:     Web.Apiary.Logger+  other-modules:       Web.Apiary.Logger.Internal+  build-depends:       base               >=4.6   && <4.8+                     , apiary             >=0.8   && <0.9+                     , fast-logger        >=2.1   && <2.2+                     , monad-logger       >=0.3   && <0.4+                     , reflection         >=1.4   && <1.5+                     , data-default-class >=0.0   && <0.1+                     , monad-control      >=0.3   && <0.4+                     , mtl                >=2.1   && <2.2+                     , transformers-base  >=0.4   && <0.5+  hs-source-dirs:      src+  ghc-options:         -O2 -Wall+  default-language:    Haskell2010++source-repository head+  type:     git+  location: git://github.com/philopon/apiary.git
+ src/Web/Apiary/Logger.hs view
@@ -0,0 +1,17 @@+module Web.Apiary.Logger (+    -- * configuration+    LogDest(..), LogConfig(..), HasLogger+    -- * initialize+    , withLogger+    , withLogger'+    -- * action+    , logging+    -- * wrapper+    , GivenLoggerT(..)++    -- * reexports+    , module Data.Default.Class+    ) where++import Web.Apiary.Logger.Internal+import Data.Default.Class
+ src/Web/Apiary/Logger/Internal.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ImplicitParams #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}++module Web.Apiary.Logger.Internal where++import Control.Applicative+import Web.Apiary hiding (Default(..))+import System.Log.FastLogger+import Control.Monad+import Control.Monad.Base+import Control.Monad.Trans+import Control.Monad.Logger+import Control.Monad.Trans.Control+import Control.Exception+import Data.Reflection+import Data.Default.Class++data LogDest+    = File FilePath+    | Stdout+    | Stderr+    | Null++data LogConfig = LogConfig+    { bufferSize :: BufSize+    , logDest    :: LogDest+    }++data Logger = Logger+    { pushLog  :: LogStr -> IO ()+    , closeLog :: IO ()+    }++instance Default LogConfig where+    def = LogConfig defaultBufSize Stderr++type HasLogger = Given Logger++newLogger :: BufSize -> LogDest -> IO Logger+newLogger s (File p) = newFileLoggerSet s p >>= \l -> +    return $ Logger (pushLogStr l) (flushLogStr l)+newLogger s Stdout = newStdoutLoggerSet s >>= \l -> +    return $ Logger (pushLogStr l) (flushLogStr l)+newLogger s Stderr = newStderrLoggerSet s >>= \l -> +    return $ Logger (pushLogStr l) (flushLogStr l)+newLogger _ Null = return $ Logger (\_ -> return ()) (return ())++withLogger :: LogConfig -> (HasLogger => IO a) -> IO a+withLogger LogConfig{..} m = bracket+    (newLogger bufferSize logDest)+    closeLog+    (\l -> give l m)++withLogger' :: LogConfig+            -> ((forall r. (HasLogger => r) -> r) -> IO a) -> IO a+withLogger' LogConfig{..} m = bracket+    (newLogger bufferSize logDest)+    closeLog+    (\l -> m (give l))++logging :: (MonadIO m, HasLogger) => LogStr -> ActionT m ()+logging msg = liftIO $ pushLog given msg++newtype GivenLoggerT m a = GivenLoggerT { runGivenLoggerT :: m a }+    deriving(Functor, Applicative, Monad, MonadIO)++instance MonadBase b m => MonadBase b (GivenLoggerT m) where+    liftBase = GivenLoggerT . liftBase++instance MonadTrans GivenLoggerT where+    lift = GivenLoggerT++instance MonadBaseControl b m => MonadBaseControl b (GivenLoggerT m) where+    newtype StM (GivenLoggerT m) a = StMGivenLogger { unStMGivenLogger :: ComposeSt GivenLoggerT m a }+    liftBaseWith = defaultLiftBaseWith StMGivenLogger+    restoreM     = defaultRestoreM   unStMGivenLogger++instance MonadTransControl GivenLoggerT where+    newtype StT GivenLoggerT a = StGivenLogger { unStGivenLogger :: a }+    liftWith f = GivenLoggerT $ f $ liftM StGivenLogger . runGivenLoggerT+    restoreT   = GivenLoggerT . liftM unStGivenLogger++instance (MonadIO m, HasLogger) => MonadLogger (GivenLoggerT m) where+    monadLoggerLog loc src lv msg = GivenLoggerT . liftIO $+        pushLog given (defaultLogStr loc src lv (toLogStr msg))++instance (MonadIO m, HasLogger) => MonadLogger (ActionT m) where+    monadLoggerLog loc src lv msg =+        logging $ defaultLogStr loc src lv (toLogStr msg)