katip 0.5.0.3 → 0.5.0.4

raw patch · 5 files changed

+88/−26 lines, 5 filesdep ~Win32PVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: Win32

API changes (from Hackage documentation)

Files

• changelog.md +4/−0
• katip.cabal +2/−2
• src/Katip/Core.hs +51/−19
• src/Katip/Scribes/Handle.hs +1/−0
• test/Katip/Tests.hs +30/−5

@@ -1,3 +1,7 @@+0.5.0.4+=======+* Loosen Win32 upper bound to run with GHC 8.2 on Windows.+ 0.5.0.3 ======= * Add worked example of Katip/KatipContext to the haddocks.

@@ -1,5 +1,5 @@ name:                katip-version:             0.5.0.3+version:             0.5.0.4 synopsis:            A structured logging framework. description:   Katip is a structured logging framework. See README.md for more details.@@ -86,7 +86,7 @@   if flag(lib-Werror)     ghc-options: -Werror   if os(windows)-    build-depends: Win32 >=2.3 && <2.5+    build-depends: Win32 >=2.3 && <2.6     exposed-modules: Katip.Compat   else     build-depends: unix >= 2.5 && <2.8

@@ -180,7 +180,7 @@ ------------------------------------------------------------------------------- -- | Log message with Builder underneath; use '<>' to concat in O(1). newtype LogStr = LogStr { unLogStr :: B.Builder }-    deriving (Generic, Show)+    deriving (Generic, Show, Eq)  instance IsString LogStr where     fromString = LogStr . B.fromString@@ -247,31 +247,62 @@     } deriving (Generic, Functor) makeLenses ''Item +-- Manual instance because 'Loc' has no 'Eq' and 'Show' instances in old+-- versions of template-haskell (< 2.10)+instance Eq a => Eq (Item a) where+    a == b = FT.and [ _itemApp a == _itemApp b+                    , _itemEnv a == _itemEnv b+                    , _itemSeverity a == _itemSeverity b+                    , _itemThread a == _itemThread b+                    , _itemHost a == _itemHost b+                    , _itemProcess a == _itemProcess b+                    , _itemPayload a == _itemPayload b+                    , _itemMessage a == _itemMessage b+                    , _itemTime a == _itemTime b+                    , _itemNamespace a == _itemNamespace b+                    , case (_itemLoc a, _itemLoc b) of+                        (Nothing, Nothing) -> True+                        (Just l1, Just l2) -> FT.and [ loc_filename l1 == loc_filename l2+                                                     , loc_package l1 == loc_package l2+                                                     , loc_module l1 == loc_module l2+                                                     , loc_start l1 == loc_start l2+                                                     , loc_end l1 == loc_end l2+                                                     ]+                        _ -> False+                    ]  instance Show a => Show (Item a) where-    show Item{..} = "Item {_itemApp = " ++ show _itemApp ++ ", " ++-                          "_itemEnv = " ++ show _itemEnv ++ ", " ++-                          "_itemSeverity = " ++ show _itemSeverity ++ ", " ++-                          "_itemThread = " ++ show _itemThread ++ ", " ++-                          "_itemHost = " ++ show _itemHost ++ ", " ++-                          "_itemProcess = " ++ show _itemProcess ++ ", " ++-                          "_itemPayload = " ++ show _itemPayload ++ ", " ++-                          "_itemMessage = " ++ show _itemMessage ++ ", " ++-                          "_itemTime = " ++ show _itemTime ++ ", " ++-                          "_itemNamespace = " ++ show _itemNamespace ++ ", " ++-                          "_itemLoc = " ++ show (LocShow <$> _itemLoc) ++ "}"-+    showsPrec d Item{..} = showParen (d >= 11) ( showString "Item {"+                                               . field "_itemApp" _itemApp+                                               . field "_itemEnv" _itemEnv+                                               . field "_itemSeverity" _itemSeverity+                                               . field "_itemThread" _itemThread+                                               . field "_itemHost" _itemHost+                                               . field "_itemProcess" _itemProcess+                                               . field "_itemPayload" _itemPayload+                                               . field "_itemMessage" _itemMessage+                                               . field "_itemTime" _itemTime+                                               . field "_itemNamespace" _itemNamespace+                                               . showString "_itemLoc = " . shows (LocShow <$> _itemLoc)+                                               . showChar '}'+                                               )+      where+        field n v = showString n . showString " = " . shows v . showString ", "  newtype LocShow = LocShow Loc   instance Show LocShow where-    show (LocShow Loc{..}) =-      "Loc {loc_filename = " ++ show loc_filename ++ ", " ++-           "loc_package = " ++ show loc_package ++ ", " ++-           "loc_module = " ++ show loc_module ++ ", " ++-           "loc_start = " ++ show loc_start ++ ", " ++-           "loc_end = " ++ show loc_end ++ "}"+    showsPrec d (LocShow Loc{..}) = showParen (d >= 11) ( showString "Loc {"+                                                        . field "loc_filename" loc_filename+                                                        . field "loc_package" loc_package+                                                        . field "loc_module" loc_module+                                                        . field "loc_start" loc_start+                                                        . showString "loc_end = " . shows loc_end+                                                        . showChar '}'+                                                        )+      where+        field n v = showString n . showString " = " . shows v . showString ", "   instance ToJSON a => ToJSON (Item a) where@@ -629,6 +660,7 @@ data ScribeSettings = ScribeSettings {       _scribeBufferSize :: Int     }+  deriving (Show, Eq)  makeLenses ''ScribeSettings 

@@ -50,6 +50,7 @@     -- ^ Whether to use color control chars in log output     | ColorIfTerminal     -- ^ Color if output is a terminal+  deriving (Show, Eq)  ------------------------------------------------------------------------------- -- | Logs to a file handle such as stdout, stderr, or a file. Contexts

@@ -25,6 +25,7 @@ import           Data.Time import           Data.Time.Clock.POSIX import           Language.Haskell.TH+import           Lens.Micro                (ASetter, (&), (.~)) import           System.Posix.Types import           Test.QuickCheck.Instances () import           Test.Tasty@@ -41,6 +42,7 @@   [     testProperty "JSON cycle Item" $ \(i :: Item ()) ->       prop_json_cycle i+  , eqItemTests   , testProperty "renderSeverity/textToSeverity cycle" $ \sev ->       textToSeverity(renderSeverity sev) === Just sev   , testProperty "processIDToText/textToProcessID cycle" $ \pid ->@@ -245,11 +247,6 @@ deriving instance Arbitrary Environment deriving instance Arbitrary ThreadIdText deriving instance Arbitrary CPid-#if !MIN_VERSION_base(4, 8, 0)-deriving instance Eq Loc-#endif-deriving instance Eq LogStr-deriving instance (Eq a) => Eq (Item a)   -------------------------------------------------------------------------------@@ -278,3 +275,31 @@ ------------------------------------------------------------------------------- instance Arbitrary LogStr where     arbitrary = LogStr . B.fromText <$> arbitrary++-------------------------------------------------------------------------------+-- Somewhat test whether all fields are taken into account in `==`++#if !MIN_VERSION_template_haskell(2, 10, 0)+-- `testProperty` requires these instances+deriving instance Eq Loc+deriving instance Show Loc+#endif++eqItemTests :: TestTree+eqItemTests = testGroup "Eq Item"+  [ testProperty "itemApp" $ prop_field itemApp+  , testProperty "itemEnv" $ prop_field itemEnv+  , testProperty "itemSeverity" $ prop_field itemSeverity+  , testProperty "itemThread" $ prop_field itemThread+  , testProperty "itemHost" $ prop_field itemHost+  , testProperty "itemProcess" $ prop_field itemProcess+  , testProperty "itemPayload" $ prop_field itemPayload+  , testProperty "itemMessage" $ prop_field itemMessage+  , testProperty "itemTime" $ prop_field itemTime+  , testProperty "itemNamespace" $ prop_field itemNamespace+  , testProperty "itemLoc" $ prop_field itemLoc+  ]+  where+    prop_field :: Eq a => ASetter (Item ()) (Item ()) a a -> Item () -> a -> a -> Bool+    prop_field field item f1 f2 =+        ((item & field .~ f1) == (item & field .~ f2)) == (f1 == f2)