git.iko.soy/typeable/katip
on master help sign in
Derive or implement `Show` and `Eq` instances

This commit adds `deriving` directives for `Show` and `Eq` to `LogStr`, `ScribeSettings` and `ColorStrategy` where applicable and adds a manual `Eq` instance for `Item a` (due to a missing `Eq` instance for `Loc` in old versions of `template-haskell`). Also add a basic test for the `Item a` `Eq` instance. Fixes: Soostone/katip#69 See: https://github.com/Soostone/katip/issues/69

commit7282343ab1eebccea514a4101e967bd3e0ee7a88 authorNicolas Trangez <ikke@nicolast.be> dateThu 28 Sep 2017, 00:23 (9 years ago) parent5b3f5d1
3 files changed+56−7
compare with master
unifiedsplit
katip/src/Katip/Core.hs+25−2 katip/src/Katip/Scribes/Handle.hs+1 katip/test/Katip/Tests.hs+30−5
katip/src/Katip/Core.hs+25−2
@@ -180,7 +180,7 @@ instance FromJSON Severity where
180180-------------------------------------------------------------------------------
181181-- | Log message with Builder underneath; use '<>' to concat in O(1).
182182newtype LogStr = LogStr { unLogStr :: B.Builder }
183− deriving (Generic, Show)
183+ deriving (Generic, Show, Eq)
184184
185185instance IsString LogStr where
186186 fromString = LogStr . B.fromString
@@ -247,6 +247,29 @@ data Item a = Item {
247247 } deriving (Generic, Functor)
248248makeLenses ''Item
249249
250+-- Manual instance because 'Loc' has no 'Eq' and 'Show' instances in old
251+-- versions of template-haskell (< 2.10)
252+instance Eq a => Eq (Item a) where
253+ a == b = FT.and [ _itemApp a == _itemApp b
254+ , _itemEnv a == _itemEnv b
255+ , _itemSeverity a == _itemSeverity b
256+ , _itemThread a == _itemThread b
257+ , _itemHost a == _itemHost b
258+ , _itemProcess a == _itemProcess b
259+ , _itemPayload a == _itemPayload b
260+ , _itemMessage a == _itemMessage b
261+ , _itemTime a == _itemTime b
262+ , _itemNamespace a == _itemNamespace b
263+ , case (_itemLoc a, _itemLoc b) of
264+ (Nothing, Nothing) -> True
265+ (Just l1, Just l2) -> FT.and [ loc_filename l1 == loc_filename l2
266+ , loc_package l1 == loc_package l2
267+ , loc_module l1 == loc_module l2
268+ , loc_start l1 == loc_start l2
269+ , loc_end l1 == loc_end l2
270+ ]
271+ _ -> False
272+ ]
250273
251274instance Show a => Show (Item a) where
252275 showsPrec d Item{..} = showParen (d >= 11) ( showString "Item {"
@@ -282,7 +305,6 @@ instance Show LocShow where
282305 field n v = showString n . showString " = " . shows v . showString ", "
283306
284307
285−
286308instance ToJSON a => ToJSON (Item a) where
287309 toJSON Item{..} = A.object
288310 [ "app" A..= _itemApp
@@ -638,6 +660,7 @@ spawnScribeWorker (Scribe write _) queue = Async.async go
638660data ScribeSettings = ScribeSettings {
639661 _scribeBufferSize :: Int
640662 }
663+ deriving (Show, Eq)
641664
642665makeLenses ''ScribeSettings
643666
katip/src/Katip/Scribes/Handle.hs+1
@@ -50,6 +50,7 @@ data ColorStrategy
5050 -- ^ Whether to use color control chars in log output
5151 | ColorIfTerminal
5252 -- ^ Color if output is a terminal
53+ deriving (Show, Eq)
5354
5455-------------------------------------------------------------------------------
5556-- | Logs to a file handle such as stdout, stderr, or a file. Contexts
katip/test/Katip/Tests.hs+30−5
@@ -25,6 +25,7 @@ import qualified Data.Text.Lazy.Builder as B
2525import Data.Time
2626import Data.Time.Clock.POSIX
2727import Language.Haskell.TH
28+import Lens.Micro (ASetter, (&), (.~))
2829import System.Posix.Types
2930import Test.QuickCheck.Instances ()
3031import Test.Tasty
@@ -41,6 +42,7 @@ tests = testGroup "Katip"
4142 [
4243 testProperty "JSON cycle Item" $ \(i :: Item ()) ->
4344 prop_json_cycle i
45+ , eqItemTests
4446 , testProperty "renderSeverity/textToSeverity cycle" $ \sev ->
4547 textToSeverity(renderSeverity sev) === Just sev
4648 , testProperty "processIDToText/textToProcessID cycle" $ \pid ->
@@ -245,11 +247,6 @@ deriving instance Arbitrary Namespace
245247deriving instance Arbitrary Environment
246248deriving instance Arbitrary ThreadIdText
247249deriving instance Arbitrary CPid
248−#if !MIN_VERSION_base(4, 8, 0)
249−deriving instance Eq Loc
250−#endif
251−deriving instance Eq LogStr
252−deriving instance (Eq a) => Eq (Item a)
253250
254251
255252-------------------------------------------------------------------------------
@@ -278,3 +275,31 @@ instance Arbitrary Severity where
278275-------------------------------------------------------------------------------
279276instance Arbitrary LogStr where
280277 arbitrary = LogStr . B.fromText <$> arbitrary
278+
279+-------------------------------------------------------------------------------
280+-- Somewhat test whether all fields are taken into account in `==`
281+
282+#if !MIN_VERSION_template_haskell(2, 10, 0)
283+-- `testProperty` requires these instances
284+deriving instance Eq Loc
285+deriving instance Show Loc
286+#endif
287+
288+eqItemTests :: TestTree
289+eqItemTests = testGroup "Eq Item"
290+ [ testProperty "itemApp" $ prop_field itemApp
291+ , testProperty "itemEnv" $ prop_field itemEnv
292+ , testProperty "itemSeverity" $ prop_field itemSeverity
293+ , testProperty "itemThread" $ prop_field itemThread
294+ , testProperty "itemHost" $ prop_field itemHost
295+ , testProperty "itemProcess" $ prop_field itemProcess
296+ , testProperty "itemPayload" $ prop_field itemPayload
297+ , testProperty "itemMessage" $ prop_field itemMessage
298+ , testProperty "itemTime" $ prop_field itemTime
299+ , testProperty "itemNamespace" $ prop_field itemNamespace
300+ , testProperty "itemLoc" $ prop_field itemLoc
301+ ]
302+ where
303+ prop_field :: Eq a => ASetter (Item ()) (Item ()) a a -> Item () -> a -> a -> Bool
304+ prop_field field item f1 f2 =
305+ ((item & field .~ f1) == (item & field .~ f2)) == (f1 == f2)