module Log.Data (
LogLevel(..)
, showLogLevel
, readLogLevel
, readLogLevelEither
, LogMessage(..)
, showLogMessage
, defaultLogLevel
) where
import Control.DeepSeq
import Control.Applicative
import Data.Aeson
import Data.Aeson.Encode.Pretty
import Data.Aeson.Types
import Data.ByteString.Lazy (toStrict)
import Data.Time
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Monoid as Monoid
data LogLevel = LogAttention | LogInfo | LogTrace
deriving (LogLevel
forall a. a -> a -> Bounded a
maxBound :: LogLevel
$cmaxBound :: LogLevel
minBound :: LogLevel
$cminBound :: LogLevel
Bounded, LogLevel -> LogLevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c== :: LogLevel -> LogLevel -> Bool
Eq, Eq LogLevel
LogLevel -> LogLevel -> Bool
LogLevel -> LogLevel -> Ordering
LogLevel -> LogLevel -> LogLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LogLevel -> LogLevel -> LogLevel
$cmin :: LogLevel -> LogLevel -> LogLevel
max :: LogLevel -> LogLevel -> LogLevel
$cmax :: LogLevel -> LogLevel -> LogLevel
>= :: LogLevel -> LogLevel -> Bool
$c>= :: LogLevel -> LogLevel -> Bool
> :: LogLevel -> LogLevel -> Bool
$c> :: LogLevel -> LogLevel -> Bool
<= :: LogLevel -> LogLevel -> Bool
$c<= :: LogLevel -> LogLevel -> Bool
< :: LogLevel -> LogLevel -> Bool
$c< :: LogLevel -> LogLevel -> Bool
compare :: LogLevel -> LogLevel -> Ordering
$ccompare :: LogLevel -> LogLevel -> Ordering
Ord, Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [LogLevel] -> ShowS
$cshowList :: [LogLevel] -> ShowS
show :: LogLevel -> [Char]
$cshow :: LogLevel -> [Char]
showsPrec :: Int -> LogLevel -> ShowS
$cshowsPrec :: Int -> LogLevel -> ShowS
Show)
readLogLevel :: T.Text -> LogLevel
readLogLevel :: Text -> LogLevel
readLogLevel = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => [Char] -> a
error forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] LogLevel
readLogLevelEither
readLogLevelEither :: T.Text -> Either String LogLevel
readLogLevelEither :: Text -> Either [Char] LogLevel
readLogLevelEither Text
"attention" = forall a b. b -> Either a b
Right LogLevel
LogAttention
readLogLevelEither Text
"info" = forall a b. b -> Either a b
Right LogLevel
LogInfo
readLogLevelEither Text
"trace" = forall a b. b -> Either a b
Right LogLevel
LogTrace
readLogLevelEither Text
level = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"readLogLevel: unknown level: "
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
level
showLogLevel :: LogLevel -> T.Text
showLogLevel :: LogLevel -> Text
showLogLevel LogLevel
LogAttention = Text
"attention"
showLogLevel LogLevel
LogInfo = Text
"info"
showLogLevel LogLevel
LogTrace = Text
"trace"
defaultLogLevel :: LogLevel
defaultLogLevel :: LogLevel
defaultLogLevel = LogLevel
LogInfo
instance ToJSON LogLevel where
toJSON :: LogLevel -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogLevel -> Text
showLogLevel
toEncoding :: LogLevel -> Encoding
toEncoding = forall a. ToJSON a => a -> Encoding
toEncoding forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogLevel -> Text
showLogLevel
instance FromJSON LogLevel where
parseJSON :: Value -> Parser LogLevel
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"LogLevel" forall a b. (a -> b) -> a -> b
$
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] LogLevel
readLogLevelEither
instance NFData LogLevel where
rnf :: LogLevel -> ()
rnf = (seq :: forall a b. a -> b -> b
`seq` ())
data LogMessage = LogMessage {
LogMessage -> Text
lmComponent :: !T.Text
, LogMessage -> [Text]
lmDomain :: ![T.Text]
, LogMessage -> UTCTime
lmTime :: !UTCTime
, LogMessage -> LogLevel
lmLevel :: !LogLevel
, LogMessage -> Text
lmMessage :: !T.Text
, LogMessage -> Value
lmData :: !Value
} deriving (LogMessage -> LogMessage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogMessage -> LogMessage -> Bool
$c/= :: LogMessage -> LogMessage -> Bool
== :: LogMessage -> LogMessage -> Bool
$c== :: LogMessage -> LogMessage -> Bool
Eq, Int -> LogMessage -> ShowS
[LogMessage] -> ShowS
LogMessage -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [LogMessage] -> ShowS
$cshowList :: [LogMessage] -> ShowS
show :: LogMessage -> [Char]
$cshow :: LogMessage -> [Char]
showsPrec :: Int -> LogMessage -> ShowS
$cshowsPrec :: Int -> LogMessage -> ShowS
Show)
showLogMessage :: Maybe UTCTime
-> LogMessage
-> T.Text
showLogMessage :: Maybe UTCTime -> LogMessage -> Text
showLogMessage Maybe UTCTime
mInsertionTime LogMessage{[Text]
UTCTime
Text
Value
LogLevel
lmData :: Value
lmMessage :: Text
lmLevel :: LogLevel
lmTime :: UTCTime
lmDomain :: [Text]
lmComponent :: Text
lmData :: LogMessage -> Value
lmMessage :: LogMessage -> Text
lmLevel :: LogMessage -> LogLevel
lmTime :: LogMessage -> UTCTime
lmDomain :: LogMessage -> [Text]
lmComponent :: LogMessage -> Text
..} = [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ [
[Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%Y-%m-%d %H:%M:%S" UTCTime
lmTime
, case Maybe UTCTime
mInsertionTime of
Maybe UTCTime
Nothing -> Text
" "
Just UTCTime
it -> [Char] -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
" (%H:%M:%S) " UTCTime
it
, Text -> Text
T.toUpper forall a b. (a -> b) -> a -> b
$ LogLevel -> Text
showLogLevel LogLevel
lmLevel
, Text
" "
, Text -> [Text] -> Text
T.intercalate Text
"/" forall a b. (a -> b) -> a -> b
$ Text
lmComponent forall a. a -> [a] -> [a]
: [Text]
lmDomain
, Text
": "
, Text
lmMessage
] forall a. [a] -> [a] -> [a]
++ if Value
lmData forall a. Eq a => a -> a -> Bool
== Value
emptyObject
then []
else [Text
" ", Value -> Text
textifyData Value
lmData]
where
textifyData :: Value -> T.Text
textifyData :: Value -> Text
textifyData = ByteString -> Text
T.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => Config -> a -> ByteString
encodePretty' Config
defConfig {
confIndent :: Indent
confIndent = Int -> Indent
Spaces Int
2
}
instance ToJSON LogMessage where
toJSON :: LogMessage -> Value
toJSON LogMessage{[Text]
UTCTime
Text
Value
LogLevel
lmData :: Value
lmMessage :: Text
lmLevel :: LogLevel
lmTime :: UTCTime
lmDomain :: [Text]
lmComponent :: Text
lmData :: LogMessage -> Value
lmMessage :: LogMessage -> Text
lmLevel :: LogMessage -> LogLevel
lmTime :: LogMessage -> UTCTime
lmDomain :: LogMessage -> [Text]
lmComponent :: LogMessage -> Text
..} = [Pair] -> Value
object [
Key
"component" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
lmComponent
, Key
"domain" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
lmDomain
, Key
"time" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UTCTime
lmTime
, Key
"level" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LogLevel
lmLevel
, Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
lmMessage
, Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
lmData
]
toEncoding :: LogMessage -> Encoding
toEncoding LogMessage{[Text]
UTCTime
Text
Value
LogLevel
lmData :: Value
lmMessage :: Text
lmLevel :: LogLevel
lmTime :: UTCTime
lmDomain :: [Text]
lmComponent :: Text
lmData :: LogMessage -> Value
lmMessage :: LogMessage -> Text
lmLevel :: LogMessage -> LogLevel
lmTime :: LogMessage -> UTCTime
lmDomain :: LogMessage -> [Text]
lmComponent :: LogMessage -> Text
..} = Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
Monoid.mconcat [
Key
"component" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
lmComponent
, Key
"domain" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
lmDomain
, Key
"time" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= UTCTime
lmTime
, Key
"level" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LogLevel
lmLevel
, Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
lmMessage
, Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
lmData
]
instance FromJSON LogMessage where
parseJSON :: Value -> Parser LogMessage
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"LogMessage" forall a b. (a -> b) -> a -> b
$ \Object
obj -> Text
-> [Text] -> UTCTime -> LogLevel -> Text -> Value -> LogMessage
LogMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Control.Applicative.<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"component"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"domain"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"time"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"level"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data"
instance NFData LogMessage where
rnf :: LogMessage -> ()
rnf LogMessage{[Text]
UTCTime
Text
Value
LogLevel
lmData :: Value
lmMessage :: Text
lmLevel :: LogLevel
lmTime :: UTCTime
lmDomain :: [Text]
lmComponent :: Text
lmData :: LogMessage -> Value
lmMessage :: LogMessage -> Text
lmLevel :: LogMessage -> LogLevel
lmTime :: LogMessage -> UTCTime
lmDomain :: LogMessage -> [Text]
lmComponent :: LogMessage -> Text
..} = forall a. NFData a => a -> ()
rnf Text
lmComponent
seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [Text]
lmDomain
seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf UTCTime
lmTime
seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf LogLevel
lmLevel
seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Text
lmMessage
seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Value
lmData