module Hoogle.Cabal.Logger
  ( Logger,
    cmapLogger,
    stdoutLogger,
    logWith,
    module Colog.Core,
  )
where

import Colog.Core
import Data.Time (getCurrentTime)
import Control.Monad.IO.Class

type Logger msg = LogAction IO (WithSeverity msg)

cmapLogger :: (a -> b) -> Logger b -> Logger a
cmapLogger :: forall a b. (a -> b) -> Logger b -> Logger a
cmapLogger a -> b
f = (WithSeverity a -> WithSeverity b)
-> LogAction IO (WithSeverity b) -> LogAction IO (WithSeverity a)
forall a b (m :: * -> *).
(a -> b) -> LogAction m b -> LogAction m a
cmap ((a -> b) -> WithSeverity a -> WithSeverity b
forall a b. (a -> b) -> WithSeverity a -> WithSeverity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)

stdoutLogger :: Show msg => Logger msg
stdoutLogger :: forall msg. Show msg => Logger msg
stdoutLogger = (WithSeverity msg -> IO ()) -> LogAction IO (WithSeverity msg)
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((WithSeverity msg -> IO ()) -> LogAction IO (WithSeverity msg))
-> (WithSeverity msg -> IO ()) -> LogAction IO (WithSeverity msg)
forall a b. (a -> b) -> a -> b
$ \WithSeverity msg
msg -> do
  -- cmap showMsg logStringStdout
  UTCTime
now <- IO UTCTime
getCurrentTime
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ UTCTime -> WithSeverity msg -> String
forall {a} {a}. (Show a, Show a) => a -> WithSeverity a -> String
showMsg UTCTime
now WithSeverity msg
msg
  where
    showMsg :: a -> WithSeverity a -> String
showMsg a
time (WithSeverity a
msg Severity
severity) =
      String
"["
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ Severity -> String
forall a. Show a => a -> String
show Severity
severity
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]["
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
time
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] "
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
msg

logWith :: MonadIO m => Logger msg -> Severity -> msg -> m ()
logWith :: forall (m :: * -> *) msg.
MonadIO m =>
Logger msg -> Severity -> msg -> m ()
logWith Logger msg
logger Severity
severity msg
msg = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Logger msg -> WithSeverity msg -> IO ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
unLogAction Logger msg
logger (msg -> Severity -> WithSeverity msg
forall msg. msg -> Severity -> WithSeverity msg
WithSeverity msg
msg Severity
severity)