Internal.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

module Logging.Global.Internal
  ( log
  , run
  ) where


import           Control.Exception
import           Control.Monad
import           Control.Monad.IO.Class
import           Data.Aeson
import           Data.IORef
import           Prelude                hiding (log)
import           System.IO.Unsafe

import           Logging.Class
import           Logging.Level
import           Logging.Logger
import           Logging.Manager
import qualified Logging.Monad.Internal as M

{-# NOINLINE ref #-}
ref :: IORef Manager
ref = unsafePerformIO $ newIORef $
  error "Global logging manager is not set, see Logging.Global.run"


log :: (MonadIO m, IsMessage s, ToJSON c)
    => Logger -> Level -> s -> c -> (String, String, String, Int) -> m ()
log logger level msg ctx location = liftIO $ do
  manager <- readIORef ref
  M.runLoggingT (M.log logger level msg ctx location) manager

{-| Run the global logging environment.

Run you application in the global logging environment.

  @
    main :: IO ()
    main = run manager app

    app :: IO ()
    app = do
      $(info) \"App\" "..."
      ...
  @

Never run multiple global logging environments concurrently.

  @
    -- bad useage
    main :: IO ()
    main = do
      forkIO $ run manager1 app1
      forkIO $ run manager2 app2
      ...

    -- correct useage
    main :: IO ()
    main = run manager $ do
      forkIO app1
      forkIO app2
      ...
  @

Note: If there is an unhandled 'Exception' in your application, it will be
logged into the __root__ 'Sink', and then rethrown.
-}
run :: Manager -> IO a -> IO a
run manager@Manager{..} io = do
    bracket_ (initialize manager >> atomicWriteIORef ref manager)
             (terminate manager)
             (catch io logThrow)
  where
    unknownLoc = ("unknown file", "unknown package", "unknown module", 0)

    logThrow :: SomeException -> IO a
    logThrow e | Just UserInterrupt <- fromException e = throw e
    logThrow e = log "" "ERROR" e Null unknownLoc >> throw e