packages feed

heavy-logger-instances (empty) → 0.1.0.0

raw patch · 7 files changed

+263/−0 lines, 7 filesdep +basedep +binarydep +exceptionssetup-changed

Dependencies added: base, binary, exceptions, heavy-logger, heavy-logger-instances, hsyslog, template-haskell, text, text-format-heavy

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for heavy-logger-instances++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2018++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 Author name here 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,4 @@+# heavy-logger-instances++This package contains some orphan instances for data types defined in heavy-logger package.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ heavy-logger-instances.cabal view
@@ -0,0 +1,65 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: b62e7d81b220f1d2169f712ba478c44f28f6adc244aec7872b75874f6a3a6a34++name:           heavy-logger-instances+version:        0.1.0.0+synopsis:       Orphan instances for data types in heavy-logger package+description:    Orphan instances for data types in heavy-logger package+category:       System+homepage:       https://github.com/portnov/heavy-logger#readme+bug-reports:    https://github.com/portnov/heavy-logger/issues+author:         Ilya Portnov+maintainer:     portnov84@rambler.ru+copyright:      2018 Ilya Portnov+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    ChangeLog.md+    README.md++source-repository head+  type: git+  location: https://github.com/portnov/heavy-logger++library+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , binary+    , exceptions+    , heavy-logger >=0.3.2.0+    , hsyslog >=5.0.1+    , template-haskell >=2.12+    , text >=1.2+    , text-format-heavy >=0.1.5.1+  exposed-modules:+      System.Log.Heavy.Instances.Binary+  other-modules:+      Paths_heavy_logger_instances+  default-language: Haskell2010++test-suite binary-test+  type: exitcode-stdio-1.0+  main-is: Binary.hs+  hs-source-dirs:+      tests+  build-depends:+      base >=4.7 && <5+    , binary+    , exceptions+    , heavy-logger >=0.3.2.0+    , heavy-logger-instances+    , hsyslog >=5.0.1+    , template-haskell >=2.12+    , text >=1.2+    , text-format-heavy >=0.1.5.1+  other-modules:+      Paths_heavy_logger_instances+  default-language: Haskell2010
+ src/System/Log/Heavy/Instances/Binary.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE RecordWildCards #-}+-- | This module contains instances of Binary type class for+-- data types defined in the heavy-logger package.+--+module System.Log.Heavy.Instances.Binary where++import Control.Applicative+import Control.Monad+import Data.Maybe+import Data.Binary+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as B+import Data.Text.Format.Heavy+import System.Log.Heavy+import System.Posix.Syslog+import Language.Haskell.TH.Syntax (Loc (..))++allVariables :: ClosedVarContainer c => c -> [(TL.Text, TL.Text)]+allVariables c = mapMaybe go (allVarNames c)+  where+    go name =+      case lookupVar name c of+        Nothing -> Nothing+        Just var -> case formatAnyVar Nothing var of+                      Left _ -> Nothing+                      Right val -> Just (name, B.toLazyText val)++getTextVariables :: Get [(TL.Text, TL.Text)]+getTextVariables = get++instance Binary Priority where+  put p = put (fromEnum p)++  get = toEnum <$> get++instance Binary Level where+  put l = do+    put (levelName l)+    put (levelInt l)+    put (levelToPriority l)++  get = Level+    <$> get+    <*> get+    <*> get++instance Binary Loc where+  put l = do+    put (loc_filename l)+    put (loc_package l)+    put (loc_module l)+    put (loc_start l)+    put (loc_end l)++  get = Loc+    <$> get+    <*> get+    <*> get+    <*> get+    <*> get++instance Binary LogContextFilter where+  put f = do+    put (setInclude f)+    put (setExclude f)++  get = LogContextFilter+    <$> get+    <*> get++-- | Serialize Variable with default format+putVariableNoformat :: Variable -> Put +putVariableNoformat var =+  case formatAnyVar Nothing var of+    Left err -> fail err+    Right val -> put (B.toLazyText val)++-- | Deserialize Variable with default format+getVariableNoformat :: Get Variable+getVariableNoformat = do+  text <- get+  return $ Variable (text :: TL.Text)++instance Binary LogContextFrame where+  put f  = do+    put (length $ lcfVariables f)+    forM_ (lcfVariables f) $ \(name, var) -> do+      put name+      putVariableNoformat var+    put (lcfFilter f)++  get = do+    n <- get :: Get Int+    vars <- replicateM n $ do+              name <- get+              val <- getVariableNoformat+              return (name, val)+    fltr <- get+    return (LogContextFrame vars fltr)++-- | Please note: this implementation is limited:+--+--  * It stores Variables as their Text representation+--+--  * It does not take care of correct storing/restoring variable formats+--+--  * When deserializing, it always uses @[(Text, Text)]@ as variables container.+--+instance Binary LogMessage where+  put (LogMessage {..}) = do+    put lmLevel+    put lmSource +    put lmLocation +    put lmFormatString +    put (allVariables lmFormatVars)+    put lmContext++  get = LogMessage+    <$> get+    <*> get+    <*> get+    <*> get+    <*> getTextVariables+    <*> get+
+ tests/Binary.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++import Data.Binary+import qualified Data.Text.Lazy as TL+import Data.Text.Format.Heavy+import System.Log.Heavy+import System.Log.Heavy.Instances.Binary+import Language.Haskell.TH.Syntax (Loc (..))++testMessage :: LogMessage+testMessage = LogMessage {+  lmLevel = debug_level,+  lmSource = [],+  lmLocation = Loc "<unknown>" "<unknown>" "<unknown>" (0,0) (0,0),+  lmFormatString = "hello, {}!",+  lmFormatVars = Single ("world" :: TL.Text),+  lmContext = []+}++printMessage :: LogMessage -> IO ()+printMessage (LogMessage {..}) = do+  print lmLevel+  print lmSource+  print lmLocation+  print lmFormatString+  -- print lmFormatVars+  --print (lmFormatVars :: [(TL.Text, TL.Text)])+  print lmContext++main = do+  let str = encode testMessage+  printMessage (decode str)+