module Graflog.Logger
( Logger(..)
, Event(..)
, CorrelationId(..)
, EventId(..)
, Action(..)
, logJSON'
, jsonEncode
, ToLog(..)
, Log(..)
, numToLog
, dictionary
, pair
) where
import Data.Aeson
import Data.Aeson.TH (deriveJSON, defaultOptions, fieldLabelModifier)
import Data.ByteString (ByteString)
import Data.ByteString.Lazy (toStrict)
import Data.Maybe (fromJust)
import Data.Map (Map(..))
import qualified Data.Map as Map
import Data.String (IsString(..))
import Data.Text (Text(..))
import Data.Text.Conversions (decodeConvertText, UTF8(..), toText)
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.Writer
import Control.Monad.State
import Graflog.Console
data Log
= Dictionary (Map Text Log)
| Variant Text [Log]
| List [Log]
| Message Text
| Redacted
deriving (Eq, Show)
instance IsString Log where
fromString = Message . toText
class ToLog a where
toLog :: a -> Log
instance ToLog Log where
toLog = id
instance ToLog Text where
toLog = Message
instance ToLog a => ToLog [a] where
toLog = List . fmap toLog
numToLog :: (Show a, Num a) => a -> Log
numToLog = Message . toText . show
instance ToLog Int where
toLog = numToLog
instance ToLog Integer where
toLog = numToLog
instance ToLog Float where
toLog = numToLog
instance ToLog Double where
toLog = numToLog
instance ToLog a => ToLog (Map Text a) where
toLog = Dictionary . fmap toLog
instance (ToLog a, ToLog b) => ToLog (Either a b) where
toLog (Left l) = Variant "left" [toLog l]
toLog (Right r) = Variant "right" [toLog r]
instance ToLog a => ToLog (Maybe a) where
toLog (Just a) = Variant "some" [toLog a]
toLog Nothing = Variant "none" []
dictionary :: [(Text, Log)] -> Log
dictionary = Dictionary . Map.fromList
pair :: ToLog a => Text -> a -> (Text, Log)
pair key value = (key, toLog value)
redacted :: Text
redacted = "(REDACTED)"
instance ToJSON Log where
toJSON (Message a) = String a
toJSON (List a) = toJSON a
toJSON (Dictionary a) = toJSON a
toJSON (Variant tag values) = toJSON $ Map.fromList [(tag, map toJSON values)]
toJSON Redacted = String redacted
class Monad m => Logger m where
logJSON :: Event -> m ()
newtype CorrelationId = CorrelationId Integer
deriving (Eq, Show, Num, FromJSON, ToJSON)
newtype EventId = EventId Integer
deriving (Eq, Show, Num, FromJSON, ToJSON)
newtype Action = Action Text
deriving (Eq, Show, IsString, FromJSON, ToJSON)
data Event = Event
{ _correlationId :: CorrelationId
, _eventId :: EventId
, _action :: Action
, _message :: Log
} deriving (Eq, Show)
instance ToJSON Event where
toJSON Event{_correlationId, _eventId, _action, _message} =
object
[ "correlationId" .= _correlationId
, "eventId" .= _eventId
, "action" .= _action
, "message" .= _message
]
logJSON' :: Console m => Event -> m ()
logJSON' = writeStdout . jsonEncode
jsonEncode :: ToJSON a => a -> Text
jsonEncode = byteStringToText . toStrict . encode
where byteStringToText :: ByteString -> Text
byteStringToText bs = fromJust $ decodeConvertText (UTF8 (bs :: ByteString))
instance Logger IO where
logJSON = logJSON'
instance (Logger m) => Logger (ExceptT e m) where
logJSON = lift . logJSON
instance (Logger m) => Logger (ReaderT r m) where
logJSON = lift . logJSON
instance (Logger m, Monoid w) => Logger (WriterT w m) where
logJSON = lift . logJSON
instance (Logger m) => Logger (StateT s m) where
logJSON = lift . logJSON