{-# LANGUAGE OverloadedStrings #-}

module Database.CQL.IO.Tinylog (mkLogger) where

import Data.ByteString.Builder
import Data.ByteString.Lazy (ByteString)
import Database.CQL.IO (Logger (..), LogLevel (..))
import Database.CQL.IO.Hexdump

import qualified Data.ByteString.Lazy as L
import qualified System.Logger        as Tiny

-- | Create a cql-io 'Logger' that delegates log messages to
-- the given tinylog 'Tiny.Logger'. Requests and responses are
-- logged on 'Tiny.Trace' level.
mkLogger :: Tiny.Logger -> Logger
mkLogger :: Logger -> Logger
mkLogger Logger
l = Logger
    { logMessage :: LogLevel -> Builder -> IO ()
logMessage  = Logger -> LogLevel -> Builder -> IO ()
tinylogMessage  Logger
l
    , logRequest :: ByteString -> IO ()
logRequest  = Logger -> ByteString -> IO ()
tinylogRequest  Logger
l
    , logResponse :: ByteString -> IO ()
logResponse = Logger -> ByteString -> IO ()
tinylogResponse Logger
l
    }

tinylogMessage :: Tiny.Logger -> LogLevel -> Builder -> IO ()
tinylogMessage :: Logger -> LogLevel -> Builder -> IO ()
tinylogMessage Logger
l LogLevel
lvl Builder
msg = Logger -> Level -> (Msg -> Msg) -> IO ()
forall (m :: * -> *).
MonadIO m =>
Logger -> Level -> (Msg -> Msg) -> m ()
Tiny.log Logger
l (LogLevel -> Level
level LogLevel
lvl) ((Msg -> Msg) -> IO ()) -> (Msg -> Msg) -> IO ()
forall a b. (a -> b) -> a -> b
$
    ByteString -> Msg -> Msg
forall a. ToBytes a => a -> Msg -> Msg
Tiny.msg (Builder -> ByteString
toLazyByteString Builder
msg)
  where
    level :: LogLevel -> Tiny.Level
    level :: LogLevel -> Level
level LogLevel
LogDebug = Level
Tiny.Debug
    level LogLevel
LogInfo  = Level
Tiny.Info
    level LogLevel
LogWarn  = Level
Tiny.Warn
    level LogLevel
LogError = Level
Tiny.Error

tinylogRequest :: Tiny.Logger -> ByteString -> IO ()
tinylogRequest :: Logger -> ByteString -> IO ()
tinylogRequest Logger
l ByteString
req = Logger -> Level -> (Msg -> Msg) -> IO ()
forall (m :: * -> *).
MonadIO m =>
Logger -> Level -> (Msg -> Msg) -> m ()
Tiny.log Logger
l Level
Tiny.Trace ((Msg -> Msg) -> IO ()) -> (Msg -> Msg) -> IO ()
forall a b. (a -> b) -> a -> b
$
    ByteString -> Msg -> Msg
forall a. ToBytes a => a -> Msg -> Msg
Tiny.msg (ByteString -> ByteString
hexdump (Int64 -> ByteString -> ByteString
L.take Int64
160 ByteString
req))

tinylogResponse :: Tiny.Logger -> ByteString -> IO ()
tinylogResponse :: Logger -> ByteString -> IO ()
tinylogResponse Logger
l ByteString
rsp = Logger -> Level -> (Msg -> Msg) -> IO ()
forall (m :: * -> *).
MonadIO m =>
Logger -> Level -> (Msg -> Msg) -> m ()
Tiny.log Logger
l Level
Tiny.Trace ((Msg -> Msg) -> IO ()) -> (Msg -> Msg) -> IO ()
forall a b. (a -> b) -> a -> b
$
    ByteString -> Msg -> Msg
forall a. ToBytes a => a -> Msg -> Msg
Tiny.msg (ByteString -> ByteString
hexdump (Int64 -> ByteString -> ByteString
L.take Int64
160 ByteString
rsp))