-- | Basic data types used throughout the package.
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

-- | Available log levels.
-- Note that ordering in this definintion determines what the maximum log level is.
-- See 'Log.Monad.leMaxLogLevel'.
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)

-- | This function is partial.
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"

-- | The default log level. Returns `LogInfo`.
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` ())

-- | Represents message to be logged.
data LogMessage = LogMessage {
  -- | Component of an application.
  LogMessage -> Text
lmComponent :: !T.Text
  -- | Application log domain.
, LogMessage -> [Text]
lmDomain    :: ![T.Text]
  -- | Time of the logged event.
, LogMessage -> UTCTime
lmTime      :: !UTCTime
  -- | Log level.
, LogMessage -> LogLevel
lmLevel     :: !LogLevel
  -- | Message to be logged.
, LogMessage -> Text
lmMessage   :: !T.Text
  -- | Additional data associated with the message.
, 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)

-- | Render a 'LogMessage' to 'Text'.
showLogMessage :: Maybe UTCTime -- ^ The time that message was added to the log.
               -> LogMessage    -- ^ The actual message.
               -> 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
    -- to suppress warnings
    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