git.iko.soy/typeable/katip
on master help sign in
Merge pull request #35 from sopvop/master

Move ToJSON to default signature in ToObject class

commit021f8f261f465ff55811c1f38199b53112a0b0e9 authorMichael Xavier <michael@michaelxavier.net> dateThu 21 Jul 2016, 14:38 (10 years ago) parent8df79e31100030
3 files changed+42−25
compare with master
unifiedsplit
katip-elasticsearch/src/Katip/Scribes/ElasticSearch/Annotations.hs+2−1 katip-elasticsearch/test/Main.hs+37−23 katip/src/Katip/Core.hs+3−1
katip-elasticsearch/src/Katip/Scribes/ElasticSearch/Annotations.hs+2−1
@@ -31,7 +31,8 @@ instance ToJSON a => ToJSON (TypeAnnotated a) where
3131 toJSON = annotateValue . toJSON . typeAnnotatedValue
3232
3333
34−instance ToObject a => ToObject (TypeAnnotated a)
34+instance ToObject a => ToObject (TypeAnnotated a) where
35+ toObject = annotateKeys . toObject . typeAnnotatedValue
3536
3637
3738instance FromJSON a => FromJSON (TypeAnnotated a) where
katip-elasticsearch/test/Main.hs+37−23
@@ -163,12 +163,18 @@ instance LogItem ExampleCtx where
163163typeAnnotatedTests :: TestTree
164164typeAnnotatedTests = testGroup "TypeAnnotated"
165165 [
166− testCase "annotates values on toJSON" $ do
166+ testCase "annotates values on toJSON" $
167167 toJSON (TypeAnnotated exampleValue) @?= annotatedExampleValue
168− , testCase "deannotates on parseJSON" $ do
168+
169+ , testCase "annotates values on toObject" $
170+ toObject (TypeAnnotated exampleObject) @?= annotatedExampleObject
171+
172+ , testCase "deannotates on parseJSON" $
169173 parseEither parseJSON (toJSON exampleValue) @?= Right exampleValue
174+
170175 , testProperty "roundtrips the same as raw" $ \(v :: Value) ->
171− let res = typeAnnotatedValue <$> (parseEither parseJSON (toJSON (TypeAnnotated v)))
176+ let res = typeAnnotatedValue
177+ <$> parseEither parseJSON (toJSON (TypeAnnotated v))
172178 in res === Right v
173179 ]
174180
@@ -187,33 +193,41 @@ roundToSundayTests = testGroup "roundToSunday"
187193 where
188194 getDOW = view _3 . toWeekDate
189195
196+
197+-------------------------------------------------------------------------------
198+exampleObject :: Object
199+exampleObject = HM.fromList
200+ [ ("a bool", Bool False)
201+ , ("a long", Number 24)
202+ , ("a double", Number 52.3)
203+ , ("a string", String "s")
204+ , ("a null", Null)
205+ , ("a map", Object (HM.singleton "baz" (Bool True)))
206+ ]
207+
208+
209+-------------------------------------------------------------------------------
210+annotatedExampleObject :: Object
211+annotatedExampleObject = HM.fromList
212+ [ ("a map",Object $ HM.fromList [("baz::b", Bool True)])
213+ , ("a bool::b", Bool False)
214+ , ("a null::n", Null)
215+ , ("a string::s", String "s")
216+ , ("a double::d", Number 52.3)
217+ , ("a long::l", Number 24.0)
218+ ]
219+
220+
190221-------------------------------------------------------------------------------
191222exampleValue :: Value
192−exampleValue = Array $ V.fromList [Null, Object ob]
193− where
194− ob = HM.fromList [ ("a bool", Bool False)
195− , ("a long", Number 24)
196− , ("a double", Number 52.3)
197− , ("a string", String "s")
198− , ("a null", Null)
199− , ("a map", Object (HM.singleton "baz" (Bool True)))
200− ]
223+exampleValue = Array $ V.fromList [Null, Object exampleObject]
201224
202225
203226-------------------------------------------------------------------------------
204227annotatedExampleValue :: Value
205228annotatedExampleValue = Array $ V.fromList
206− [
207− Null
208− , Object $ HM.fromList
209− [
210− ("a map",Object $ HM.fromList [("baz::b", Bool True)])
211− , ("a bool::b", Bool False)
212− , ("a null::n", Null)
213− , ("a string::s", String "s")
214− , ("a double::d", Number 52.3)
215− , ("a long::l", Number 24.0)
216− ]
229+ [ Null
230+ , Object annotatedExampleObject
217231 ]
218232
219233
katip/src/Katip/Core.hs+3−1
@@ -1,4 +1,5 @@
11{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DefaultSignatures #-}
23{-# LANGUAGE DeriveFunctor #-}
34{-# LANGUAGE DeriveGeneric #-}
45{-# LANGUAGE ExistentialQuantification #-}
@@ -367,8 +368,9 @@ instance Monoid PayloadSelection where
367368-- a ToJSON instance like:
368369--
369370-- > instance ToObject Foo
370−class ToJSON a => ToObject a where
371+class ToObject a where
371372 toObject :: a -> A.Object
373+ default toObject :: ToJSON a => a -> A.Object
372374 toObject v = case toJSON v of
373375 A.Object o -> o
374376 _ -> mempty