021f8f2 · typeable/katip

git.iko.soy/typeable/katip

on master help sign in

Merge pull request #35 from sopvop/master

021f8f2Michael Xavier10 years ago

katip-elasticsearch/src/Katip/Scribes/ElasticSearch/Annotations.hs+2−1

compare with master

unifiedsplit

@@ -31,7 +31,8 @@ instance ToJSON a => ToJSON (TypeAnnotated a) where

31 toJSON = annotateValue . toJSON . typeAnnotatedValue

34−instance ToObject a => ToObject (TypeAnnotated a)

34+instance ToObject a => ToObject (TypeAnnotated a) where

35+ toObject = annotateKeys . toObject . typeAnnotatedValue

37instance FromJSON a => FromJSON (TypeAnnotated a) where

38instance FromJSON a => FromJSON (TypeAnnotated a) where

katip-elasticsearch/test/Main.hs+37−23

@@ -163,12 +163,18 @@ instance LogItem ExampleCtx where

163typeAnnotatedTests :: TestTree

164typeAnnotatedTests = testGroup "TypeAnnotated"

165 [

166− testCase "annotates values on toJSON" $ do

166+ testCase "annotates values on toJSON" $

167 toJSON (TypeAnnotated exampleValue) @?= annotatedExampleValue

168+

169+ , testCase "annotates values on toObject" $

170+ toObject (TypeAnnotated exampleObject) @?= annotatedExampleObject

171+

168− , testCase "deannotates on parseJSON" $ do

172+ , testCase "deannotates on parseJSON" $

169 parseEither parseJSON (toJSON exampleValue) @?= Right exampleValue

173 parseEither parseJSON (toJSON exampleValue) @?= Right exampleValue

174+

170 , testProperty "roundtrips the same as raw" $ \(v :: Value) ->

175 , testProperty "roundtrips the same as raw" $ \(v :: Value) ->

176+ let res = typeAnnotatedValue

171− let res = typeAnnotatedValue <$> (parseEither parseJSON (toJSON (TypeAnnotated v)))

177+ <$> parseEither parseJSON (toJSON (TypeAnnotated v))

172 in res === Right v

178 in res === Right v

173 ]

179 ]

174

180

@@ -187,33 +193,41 @@ roundToSundayTests = testGroup "roundToSunday"

187 where

193 where

188 getDOW = view _3 . toWeekDate

194 getDOW = view _3 . toWeekDate

189

195

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+

190-------------------------------------------------------------------------------

221-------------------------------------------------------------------------------

191exampleValue :: Value

222exampleValue :: Value

192−exampleValue = Array $ V.fromList [Null, Object ob]

223+exampleValue = Array $ V.fromList [Null, Object exampleObject]

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− ]

201

224

202

225

203-------------------------------------------------------------------------------

226-------------------------------------------------------------------------------

204annotatedExampleValue :: Value

227annotatedExampleValue :: Value

205annotatedExampleValue = Array $ V.fromList

228annotatedExampleValue = Array $ V.fromList

206− [

207− Null

229+ [ Null

208− , Object $ HM.fromList

230+ , Object annotatedExampleObject

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− ]

217 ]

231 ]

218

232

219

233

katip/src/Katip/Core.hs+3−1

@@ -1,4 +1,5 @@

1{-# LANGUAGE CPP #-}

2+{-# LANGUAGE DefaultSignatures #-}

2{-# LANGUAGE DeriveFunctor #-}

3{-# LANGUAGE DeriveFunctor #-}

3{-# LANGUAGE DeriveGeneric #-}

4{-# LANGUAGE DeriveGeneric #-}

4{-# LANGUAGE ExistentialQuantification #-}

5{-# LANGUAGE ExistentialQuantification #-}

@@ -367,8 +368,9 @@ instance Monoid PayloadSelection where

367-- a ToJSON instance like:

368-- a ToJSON instance like:

368--

369--

369-- > instance ToObject Foo

370-- > instance ToObject Foo

370−class ToJSON a => ToObject a where

371+class ToObject a where

371 toObject :: a -> A.Object

372 toObject :: a -> A.Object

373+ default toObject :: ToJSON a => a -> A.Object

372 toObject v = case toJSON v of

374 toObject v = case toJSON v of

373 A.Object o -> o

375 A.Object o -> o

374 _ -> mempty

376 _ -> mempty