module Ribosome.Log where

import qualified Data.ByteString.UTF8 as ByteString (toString)
import qualified Data.Text as Text (unpack)
import System.Log.Logger (Priority(DEBUG, ERROR, INFO), logM)

import Ribosome.Control.Monad.Ribo (MonadRibo, pluginName)

class Loggable a where
  logLines :: a -> [String]

instance {-# OVERLAPPABLE #-} Loggable a => Loggable [a] where
  logLines :: [a] -> [String]
logLines =
    ([a] -> (a -> [String]) -> [String]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> [String]
forall a. Loggable a => a -> [String]
logLines)

instance {-# OVERLAPPING #-} Loggable String where
  logLines :: String -> [String]
logLines = String -> [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance Loggable ByteString where
  logLines :: ByteString -> [String]
logLines = String -> [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String])
-> (ByteString -> String) -> ByteString -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
ByteString.toString

instance Loggable Text where
  logLines :: Text -> [String]
logLines = String -> [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String]) -> (Text -> String) -> Text -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

logAs ::
  Loggable a =>
  MonadIO m =>
  Priority ->
  Text ->
  a ->
  m ()
logAs :: Priority -> Text -> a -> m ()
logAs Priority
prio Text
name = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (String -> Priority -> String -> IO ()
logM (Text -> String
forall a. ToString a => a -> String
toString Text
name) Priority
prio) ([String] -> IO ()) -> (a -> [String]) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [String]
forall a. Loggable a => a -> [String]
logLines

debugAs ::
  Loggable a =>
  MonadIO m =>
  Text ->
  a ->
  m ()
debugAs :: Text -> a -> m ()
debugAs =
  Priority -> Text -> a -> m ()
forall a (m :: * -> *).
(Loggable a, MonadIO m) =>
Priority -> Text -> a -> m ()
logAs Priority
DEBUG

infoAs ::
  Loggable a =>
  MonadIO m =>
  Text ->
  a ->
  m ()
infoAs :: Text -> a -> m ()
infoAs =
  Priority -> Text -> a -> m ()
forall a (m :: * -> *).
(Loggable a, MonadIO m) =>
Priority -> Text -> a -> m ()
logAs Priority
INFO

errAs ::
  Loggable a =>
  MonadIO m =>
  Text ->
  a ->
  m ()
errAs :: Text -> a -> m ()
errAs =
  Priority -> Text -> a -> m ()
forall a (m :: * -> *).
(Loggable a, MonadIO m) =>
Priority -> Text -> a -> m ()
logAs Priority
ERROR

prefixed :: (MonadIO m, Show a) => Text -> a -> m ()
prefixed :: Text -> a -> m ()
prefixed Text
prefix a
a = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Text -> IO ()) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (String -> IO ()) -> (Text -> String) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall b a. (Show a, IsString b) => a -> b
show a
a

logR ::
  Loggable a =>
  MonadRibo m =>
  Priority ->
  a ->
  m ()
logR :: Priority -> a -> m ()
logR Priority
prio a
message = do
  Text
n <- m Text
forall (m :: * -> *). MonadRibo m => m Text
pluginName
  Priority -> Text -> a -> m ()
forall a (m :: * -> *).
(Loggable a, MonadIO m) =>
Priority -> Text -> a -> m ()
logAs Priority
prio Text
n a
message

debug ::
  Loggable a =>
  MonadRibo m =>
  a ->
  m ()
debug :: a -> m ()
debug =
  Priority -> a -> m ()
forall a (m :: * -> *).
(Loggable a, MonadRibo m) =>
Priority -> a -> m ()
logR Priority
DEBUG

logDebug ::
  Loggable a =>
  MonadRibo m =>
  a ->
  m ()
logDebug :: a -> m ()
logDebug = a -> m ()
forall a (m :: * -> *). (Loggable a, MonadRibo m) => a -> m ()
debug

showDebug ::
  Show a =>
  MonadRibo m =>
  Text ->
  a ->
  m ()
showDebug :: Text -> a -> m ()
showDebug Text
prefix a
a =
  Text -> m ()
forall a (m :: * -> *). (Loggable a, MonadRibo m) => a -> m ()
logDebug @Text (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall b a. (Show a, IsString b) => a -> b
show a
a)

showDebugM ::
  Show a =>
  MonadRibo m =>
  Text ->
  m a ->
  m a
showDebugM :: Text -> m a -> m a
showDebugM Text
prefix m a
ma = do
  a
a <- m a
ma
  Text -> m ()
forall a (m :: * -> *). (Loggable a, MonadRibo m) => a -> m ()
logDebug @Text (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall b a. (Show a, IsString b) => a -> b
show a
a)
  return a
a

info ::
  Loggable a =>
  MonadRibo m =>
  a ->
  m ()
info :: a -> m ()
info =
  Priority -> a -> m ()
forall a (m :: * -> *).
(Loggable a, MonadRibo m) =>
Priority -> a -> m ()
logR Priority
INFO

logInfo ::
  Loggable a =>
  MonadRibo m =>
  a ->
  m ()
logInfo :: a -> m ()
logInfo = a -> m ()
forall a (m :: * -> *). (Loggable a, MonadRibo m) => a -> m ()
info

err ::
  Loggable a =>
  MonadRibo m =>
  a ->
  m ()
err :: a -> m ()
err =
  Priority -> a -> m ()
forall a (m :: * -> *).
(Loggable a, MonadRibo m) =>
Priority -> a -> m ()
logR Priority
ERROR

logError ::
  Loggable a =>
  MonadRibo m =>
  a ->
  m ()
logError :: a -> m ()
logError = a -> m ()
forall a (m :: * -> *). (Loggable a, MonadRibo m) => a -> m ()
err

showError ::
  Show a =>
  MonadRibo m =>
  Text ->
  a ->
  m ()
showError :: Text -> a -> m ()
showError Text
prefix a
a =
  Text -> m ()
forall a (m :: * -> *). (Loggable a, MonadRibo m) => a -> m ()
logError @Text (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall b a. (Show a, IsString b) => a -> b
show a
a)