{-# LANGUAGE ForeignFunctionInterface #-}

{-|
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.


= @logging.h@

== Types
* @cdio_log_level_t@                -> 'Foreign.Libcdio.Logging.LogLevel'

== Symbols
* @cdio_default_log_handler@        (removed; always handled through 'Foreign.Libcdio.Logging.readLog')
* @cdio_assert@                     -> @'Foreign.Libcdio.Logging.putLog' 'Forign.Libcdio.Logging.LogAssert'@
* @cdio_debug@                      -> @'Foreign.Libcdio.Logging.putLog' 'Forign.Libcdio.Logging.LogDebug'@
* @cdio_error@                      -> @'Foreign.Libcdio.Logging.putLog' 'Forign.Libcdio.Logging.LogError'@
* @cdio_info@                       -> @'Foreign.Libcdio.Logging.putLog' 'Forign.Libcdio.Logging.LogInfo'@
* @cdio_log@                        -> 'Foreign.Libcdio.Logging.putLog'
* @cdio_log_set_handler@            (removed; always handled through 'Foreign.Libcdio.Logging.readLog')
* @cdio_loglevel_default@           -> 'Foreign.Libcdio.Logging.logCutoff' and 'Foreign.Libcdio.Logging.setLogCutoff'
* @cdio_warn@                       -> @'Foreign.Libcdio.Logging.putLog' 'Forign.Libcdio.Logging.LogWarn'@


= "Sound.Libcdio.Logging"
Most functions have been re-contextulized as being provided through a
'Sound.Libcdio.Logging.LibcdioLogger' instance, but the interface is otherwise
unchanged.
-}
module Foreign.Libcdio.Logging
    ( -- * Types
      LogEntry ( .. )
    , LogLevel ( .. )
      -- * Message interaction
    , putLog
    , readLog
    , clearLog
      -- * Management
    , logCutoff
    , setLogCutoff
    , setupLogger
    ) where


import qualified Control.Monad as N

import qualified Data.Maybe as Y

import qualified Foreign.C.String as C
import qualified Foreign.C.Types as C
import qualified Foreign.Ptr as C

import qualified Foreign.Marshal.Array as M
import qualified Foreign.Marshal.Utils as M
import qualified Foreign.Storable as S

import Foreign.Libcdio.Marshal
import Foreign.Libcdio.Types.Enums
import Foreign.Libcdio.Types.Offsets


-- | Check the current minimum severity which will be recorded in the logs.
--
-- See 'setLogCutoff'.
logCutoff :: IO LogLevel
logCutoff :: IO LogLevel
logCutoff = Int -> LogLevel
forall a. Enum a => Int -> a
toEnum (Int -> LogLevel) -> (CLogLevel -> Int) -> CLogLevel -> LogLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLogLevel -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CLogLevel -> LogLevel) -> IO CLogLevel -> IO LogLevel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CLogLevel
logCutoff'

foreign import ccall safe "cdio/compat/logging.h get_cdio_log_level"
  logCutoff' :: IO CLogLevel


-- | Set the minimum severity required for a message to be recorded in the
-- logs.
--
-- See 'logCutoff'.
setLogCutoff :: LogLevel -> IO ()
setLogCutoff :: LogLevel -> IO ()
setLogCutoff = CLogLevel -> IO ()
setLogCutoff' (CLogLevel -> IO ())
-> (LogLevel -> CLogLevel) -> LogLevel -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CLogLevel
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CLogLevel) -> (LogLevel -> Int) -> LogLevel -> CLogLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogLevel -> Int
forall a. Enum a => a -> Int
fromEnum

foreign import ccall safe "cdio/compat/logging.h set_cdio_log_level"
  setLogCutoff' :: CLogLevel -> IO ()


-- | An unstructured message emitted from the library to let the user know
-- what's going on behind the scenes.
data LogEntry = LogEntry
    { LogEntry -> LogLevel
logLevel :: LogLevel
        -- ^ How critical it is that the user receive this particular message.
    , LogEntry -> String
logMessage :: String
        -- ^ The text of the message itself.
    }
  deriving ( LogEntry -> LogEntry -> Bool
(LogEntry -> LogEntry -> Bool)
-> (LogEntry -> LogEntry -> Bool) -> Eq LogEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogEntry -> LogEntry -> Bool
$c/= :: LogEntry -> LogEntry -> Bool
== :: LogEntry -> LogEntry -> Bool
$c== :: LogEntry -> LogEntry -> Bool
Eq, Int -> LogEntry -> ShowS
[LogEntry] -> ShowS
LogEntry -> String
(Int -> LogEntry -> ShowS)
-> (LogEntry -> String) -> ([LogEntry] -> ShowS) -> Show LogEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogEntry] -> ShowS
$cshowList :: [LogEntry] -> ShowS
show :: LogEntry -> String
$cshow :: LogEntry -> String
showsPrec :: Int -> LogEntry -> ShowS
$cshowsPrec :: Int -> LogEntry -> ShowS
Show, ReadPrec [LogEntry]
ReadPrec LogEntry
Int -> ReadS LogEntry
ReadS [LogEntry]
(Int -> ReadS LogEntry)
-> ReadS [LogEntry]
-> ReadPrec LogEntry
-> ReadPrec [LogEntry]
-> Read LogEntry
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LogEntry]
$creadListPrec :: ReadPrec [LogEntry]
readPrec :: ReadPrec LogEntry
$creadPrec :: ReadPrec LogEntry
readList :: ReadS [LogEntry]
$creadList :: ReadS [LogEntry]
readsPrec :: Int -> ReadS LogEntry
$creadsPrec :: Int -> ReadS LogEntry
Read )
instance S.Storable LogEntry where
    sizeOf :: LogEntry -> Int
sizeOf LogEntry
_    = Int
leSizeOf
    alignment :: LogEntry -> Int
alignment LogEntry
_ = Int
leAlign
    peek :: Ptr LogEntry -> IO LogEntry
peek Ptr LogEntry
c = do
        CLogLevel
l <- Ptr LogEntry -> Int -> IO CLogLevel
forall a b. Storable a => Ptr b -> Int -> IO a
S.peekByteOff Ptr LogEntry
c Int
leLevel :: IO CLogLevel
        Ptr CChar
m' <- Ptr LogEntry -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
S.peekByteOff Ptr LogEntry
c Int
leMessage
        String
m <- if Ptr CChar
m' Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
C.nullPtr
            then String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
            else Ptr CChar -> IO String
C.peekCString Ptr CChar
m'
        LogEntry -> IO LogEntry
forall (m :: * -> *) a. Monad m => a -> m a
return (LogEntry -> IO LogEntry) -> LogEntry -> IO LogEntry
forall a b. (a -> b) -> a -> b
$ LogEntry :: LogLevel -> String -> LogEntry
LogEntry
            { logLevel :: LogLevel
logLevel = Int -> LogLevel
forall a. Enum a => Int -> a
toEnum (Int -> LogLevel) -> Int -> LogLevel
forall a b. (a -> b) -> a -> b
$ CLogLevel -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLogLevel
l
            , logMessage :: String
logMessage = String
m
            }
    poke :: Ptr LogEntry -> LogEntry -> IO ()
poke Ptr LogEntry
c LogEntry
hs = do
        Ptr LogEntry -> Int -> CLogLevel -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
S.pokeByteOff Ptr LogEntry
c Int
leLevel (Int -> CLogLevel
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CLogLevel) -> (LogLevel -> Int) -> LogLevel -> CLogLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogLevel -> Int
forall a. Enum a => a -> Int
fromEnum (LogLevel -> CLogLevel) -> LogLevel -> CLogLevel
forall a b. (a -> b) -> a -> b
$ LogEntry -> LogLevel
logLevel LogEntry
hs :: CLogLevel)
        Ptr CChar
m <- String -> IO (Ptr CChar)
C.newCString (String -> IO (Ptr CChar)) -> String -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ LogEntry -> String
logMessage LogEntry
hs
        Ptr LogEntry -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
S.pokeByteOff Ptr LogEntry
c Int
leMessage Ptr CChar
m
        Ptr LogEntry -> Int -> Ptr Any -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
S.pokeByteOff Ptr LogEntry
c Int
lePrevious Ptr Any
forall a. Ptr a
C.nullPtr


-- | 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.
--
-- >>> setupLogger
-- >>> putLog $ LogEntry LogWarn "Testing log reading"
-- >>> readLog
-- [LogEntry LogWarn "Testing log reading"]
-- >>> readLog
-- [LogEntry LogWarn "Testing log reading"]
-- >>> clearLog
-- >>> readLog
-- []
readLog :: IO [LogEntry]
readLog :: IO [LogEntry]
readLog = do
    Ptr (Ptr LogEntry)
es' <- IO (Ptr (Ptr LogEntry))
readLog'
    [Ptr LogEntry]
es <- [Ptr LogEntry] -> Maybe [Ptr LogEntry] -> [Ptr LogEntry]
forall a. a -> Maybe a -> a
Y.fromMaybe [] (Maybe [Ptr LogEntry] -> [Ptr LogEntry])
-> IO (Maybe [Ptr LogEntry]) -> IO [Ptr LogEntry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr (Ptr LogEntry) -> IO [Ptr LogEntry])
-> Ptr (Ptr LogEntry) -> IO (Maybe [Ptr LogEntry])
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
M.maybePeek (Ptr LogEntry -> Ptr (Ptr LogEntry) -> IO [Ptr LogEntry]
forall a. (Storable a, Eq a) => a -> Ptr a -> IO [a]
M.peekArray0 Ptr LogEntry
forall a. Ptr a
C.nullPtr) Ptr (Ptr LogEntry)
es'
    [Ptr LogEntry] -> (Ptr LogEntry -> IO LogEntry) -> IO [LogEntry]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
N.forM [Ptr LogEntry]
es Ptr LogEntry -> IO LogEntry
forall a. Storable a => Ptr a -> IO a
S.peek

foreign import ccall safe "cdio/compat/logging.h read_cdio_log"
  readLog' :: IO (C.Ptr (C.Ptr LogEntry))


-- | 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
foreign import ccall safe "cdio/compat/logging.h free_cdio_log"
  clearLog :: IO ()


-- | Append a message to the logs.
putLog :: LogEntry -> IO ()
putLog :: LogEntry -> IO ()
putLog LogEntry
e = String -> (Ptr CChar -> IO ()) -> IO ()
forall a. String -> (Ptr CChar -> IO a) -> IO a
C.withCString (LogEntry -> String
logMessage LogEntry
e) ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ CLogLevel -> Ptr CChar -> IO ()
putLog' (Int -> CLogLevel
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CLogLevel) -> (LogLevel -> Int) -> LogLevel -> CLogLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogLevel -> Int
forall a. Enum a => a -> Int
fromEnum (LogLevel -> CLogLevel) -> LogLevel -> CLogLevel
forall a b. (a -> b) -> a -> b
$ LogEntry -> LogLevel
logLevel LogEntry
e)

foreign import ccall safe "cdio/compat/logging.h cdio_log"
  putLog' :: CLogLevel -> C.CString -> IO ()