-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | A tiny abstraction layer over logging capability we use in @morley-client@.
--
-- We use the @co-log@ package and this module reduces direct
-- dependencies on @co-log@ making our code more resistant to logging
-- changes.

module Morley.Client.Logging
  ( ClientLogAction
  , WithClientLog
  , logDebug
  , logInfo
  , logWarning
  , logError
  , logException

  , logFlush
  ) where

import Colog
  (LogAction(..), Message, WithLog, logDebug, logError, logException, logInfo, logWarning)
import System.IO (hFlush)

-- | 'LogAction' with fixed message parameter.
type ClientLogAction m = LogAction m Message

-- | A specialization of 'WithLog' constraint to the 'Message' type.
-- If we want to use another message type we can change this constraint
-- and exported functions, presumably without breaking other code significantly.
type WithClientLog env m = WithLog env Message m

-- See <https://github.com/kowainik/co-log/pull/194>, hopefully we won't need it one day.
{- | This action can be used in combination with other actions to flush
   a handle every time you log anything.
-}
logFlush :: MonadIO m => Handle -> LogAction m a
logFlush :: Handle -> LogAction m a
logFlush Handle
handle = (a -> m ()) -> LogAction m a
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((a -> m ()) -> LogAction m a) -> (a -> m ()) -> LogAction m a
forall a b. (a -> b) -> a -> b
$ m () -> a -> m ()
forall a b. a -> b -> a
const (m () -> a -> m ()) -> m () -> a -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hFlush Handle
handle
{-# INLINE logFlush #-}
{-# SPECIALIZE logFlush :: Handle -> LogAction IO () #-}