From 4b6637800bf7813570cf7a628794a0351835711b Mon Sep 17 00:00:00 2001
From: Thomas Crevoisier <thomas.crevoisier@fretlink.com>
Date: Fri, 30 Nov 2018 17:01:18 +0100
Subject: Allow sending numbers in additional fields

---
 src/Graylog/Gelf.hs | 33 +++++++++++++++++++++++++++++----
 1 file changed, 29 insertions(+), 4 deletions(-)

(limited to 'src/Graylog')

diff --git a/src/Graylog/Gelf.hs b/src/Graylog/Gelf.hs
index b6e7ec0..8ffe24f 100644
--- a/src/Graylog/Gelf.hs
+++ b/src/Graylog/Gelf.hs
@@ -7,9 +7,10 @@
 -- see http://docs.graylog.org/en/latest/pages/gelf.html
 module Graylog.Gelf where
 
-import           Data.Aeson          (ToJSON (..), Value (..), object,
-                                      toJSON, (.=))
+import           Data.Aeson          (ToJSON (..), Value (..), object, toJSON,
+                                      (.=))
 import           Data.HashMap.Strict (HashMap)
+import           Data.Scientific     (Scientific)
 import           Data.Semigroup      ((<>))
 import           Data.Text           (Text)
 import           Data.Time
@@ -27,10 +28,34 @@ data GELF
       , _gelfLevel        :: Maybe SyslogLevel
       , _gelfLine         :: Maybe Word
       , _gelfFile         :: Maybe Text
-      , _gelfMeta         :: HashMap Text Text
+      , _gelfMeta         :: HashMap Text MetaValue
       }
    deriving (Show, Typeable, Generic)
 
+data MetaValue
+  = TextValue Text
+  | NumberValue Scientific
+  deriving (Show)
+
+instance ToJSON MetaValue where
+  toJSON (TextValue txt) = toJSON txt
+  toJSON (NumberValue n) = toJSON n
+
+class ToMeta a where
+  toMeta :: a -> MetaValue
+
+instance ToMeta Text where
+  toMeta = TextValue
+
+instance ToMeta Scientific where
+  toMeta = NumberValue
+
+instance ToMeta Integer where
+  toMeta = NumberValue . fromInteger
+
+instance ToMeta Int where
+  toMeta = toMeta . toInteger
+
 instance ToJSON GELF where
   toJSON GELF{..} = object $ [ "version"        .= _gelfVersion
                              , "host"           .= _gelfHost
@@ -40,7 +65,7 @@ instance ToJSON GELF where
                              , "level"          .= _gelfLevel
                              , "line"           .= _gelfLine
                              , "file"           .= _gelfFile
-                             ] <> toList (String <$> _gelfMeta)
+                             ] <> toList (toJSON <$> _gelfMeta)
 
 --
 
-- 
cgit v1.2.3