{-|
Description:    Control over and access to library log output.

Copyright:      (c) 2020-2021 Sam May
License:        GPL-3.0-or-later
Maintainer:     ag@eitilt.life

Stability:      stable
Portability:    non-portable (requires libcdio)

The underlying library is rather loud in its error and warning messages,
potentially emitting a lot of impure terminal clutter even on some
otherwise-pure functions.  Very helpfully, it also provides a mechanism for
integrating the logs with whatever framework is in place for the larger
project; that mechanism can be leveraged to cache the logs in memory until
specifically asked for, at which point they can be packaged into Haskell types.
Some of the immediacy—and therefore user ability to match note to source—is
unfortunately lost, but the apparent purity is worth it.
-}
module Sound.Libcdio.Logging
    ( -- * Types
      LibcdioLogger ( .. )
    , Foreign.LogEntry ( .. )
    , Foreign.LogLevel ( .. )
      -- * Utility
    , isolateLogs
    , Foreign.setupLogger
    ) where


import qualified Foreign.Libcdio.Logging as Foreign


-- | An environment which integrates the libcdio logging interface; will almost
-- always be a 'Monad', but as an 'Applicative' might technically be able to
-- implement these, that constraint isn't enforced.
class LibcdioLogger m where
    logCutoff :: m Foreign.LogLevel
        -- ^ Check the current minimum severity which will be recorded in the
        -- logs.
    setLogCutoff :: Foreign.LogLevel -> m ()
        -- ^ Set the minimum severity required for a message to be recorded in
        -- the logs.
    readLog :: m [Foreign.LogEntry]
        -- ^ Retrieve all messages currently in the log for further processing.
        -- Note that this retains the contents of the log for future calls; to
        -- remove them, a separate call to 'clearLog' must be made.
        --
        -- >>> putLog $ LogEntry LogWarn "Testing log reading" >>= readLog
        -- [LogEntry LogWarn "Testing log reading"]
        --
        -- >>> clearLog >>= readLog
        -- []
    clearLog :: m ()
        -- ^ Empty all messages currently in the log.  There is no way to
        -- selectively remove only some messages; if that is desired, call
        -- 'readLog' first:
        --
        -- >>> setupLogger
        -- >>> msgs <- readLog
        -- >>> clearLog
        -- >>> mapM_ putLog $ filter p msgs
    putLog :: Foreign.LogEntry -> m ()
        -- ^ Append a message to the logs.

-- | The required initialization function 'Foreign.setupLogger' isn't called
-- automatically; /make sure/ to do so manually before using any of these.
instance LibcdioLogger IO where
    logCutoff :: IO LogLevel
logCutoff = IO LogLevel
Foreign.logCutoff
    setLogCutoff :: LogLevel -> IO ()
setLogCutoff = LogLevel -> IO ()
Foreign.setLogCutoff
    readLog :: IO [LogEntry]
readLog = IO [LogEntry]
Foreign.readLog
    clearLog :: IO ()
clearLog = IO ()
Foreign.clearLog
    putLog :: LogEntry -> IO ()
putLog = LogEntry -> IO ()
Foreign.putLog


-- | Keep the monad pure by preventing it from reading stale logs, but since
-- the outer IO might still care about them, restore the entire stack after.
--
-- Note that the logs are /not/ thread-safe; messages from other threads may be
-- interwoven with those from the passed computation even after this function
-- is called.
isolateLogs :: (Monad m, LibcdioLogger m) => m a -> m a
isolateLogs :: m a -> m a
isolateLogs m a
a' = do
    [LogEntry]
es <- m [LogEntry]
forall (m :: * -> *). LibcdioLogger m => m [LogEntry]
readLog
    m ()
forall (m :: * -> *). LibcdioLogger m => m ()
clearLog

    a
a <- m a
a'
    [LogEntry]
es' <- m [LogEntry]
forall (m :: * -> *). LibcdioLogger m => m [LogEntry]
readLog
    m ()
forall (m :: * -> *). LibcdioLogger m => m ()
clearLog

    (LogEntry -> m ()) -> [LogEntry] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LogEntry -> m ()
forall (m :: * -> *). LibcdioLogger m => LogEntry -> m ()
putLog ([LogEntry] -> m ()) -> [LogEntry] -> m ()
forall a b. (a -> b) -> a -> b
$ [LogEntry]
es [LogEntry] -> [LogEntry] -> [LogEntry]
forall a. [a] -> [a] -> [a]
++ [LogEntry]
es'
    a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a