import Graylog.UDP
import System.Log.Logger (Logger, Priority(..))
import System.Log.Formatter (LogFormatter, simpleLogFormatter)
import System.Log.Handler (setFormatter)
import Control.Exception (handle)
-- A few imports might be left out here, so you might have to add some more

-- Here's the type that will hold the graylog connection and some other stuff
data GraylogHandler = GraylogHandler { glhMaybeConn :: Maybe Graylog
                                     , glhLevel     :: Priority
                                     , glhFormatter :: LogFormatter GraylogHandler
                                     , parentLogger :: Logger
                                     }

-- Note that making the graylog handler can fail, so I've had it require a logger from somewhere else
-- so that in case things go bad, we can at least log about it
makeGraylogHandler :: Logger -> Priority -> LogFormatter GraylogHandler -> String -> String -> IO GraylogHandler
makeGraylogHandler logger p f ip port = Control.Exception.handle handleGraylogFailure getAndReturnGraylog
    where
      h = GraylogHandler Nothing p f logger
      logMsg = logL logger INFO
      handleGraylogFailure = (\_ -> logMsg "Failed to connect to graylog" >> return h) :: SomeException -> IO GraylogHandler
      getAndReturnGraylog = openGraylog ip port defaultChunkSize
                            >>= \g -> logMsg ("Successfully connected to Graylog @ [" ++ ip ++ "], port [" ++ port ++ "]")
                                      >> either (\s -> putStrLn s >> return h) (\conn -> return h { glhMaybeConn=Just conn }) g

-- Instance that makes the GraylogHandler fit into System.Log.Logger's worldview
instance LogHandler GraylogHandler where
    setLevel glh l = glh { glhLevel=l }
    getLevel =  glhLevel

    setFormatter glh f = glh { glhFormatter=f }
    getFormatter = glhFormatter

    emit glh record _ = case (glhMaybeConn glh) of
                          Nothing -> logL (parentLogger glh) INFO $ "SENT TO GRAYLOG: " ++ (show record)
                          Just g -> sendLog g

-- Going to skip the import statements this time, you likely shouldn't be copying this code as it's pretty specific to my usecase/how I chose to set my app up.
-- Chunks of it are probably reusable though so knock yourself out

-- ... near some utility functions at the top of the file ...
defaultLoggerFormat :: LogFormatter a
defaultLoggerFormat = simpleLogFormatter "[$time : $loggername : $prio] $msg"

removeRootLogger :: IO ()
removeRootLogger = updateGlobalLogger rootLoggerName removeHandler

logLevelsWithHandles :: [(Priority, Handle)]
logLevelsWithHandles = [(DEBUG, stdout)]

-- This function just generates a bunch of default log handlers that have the default logger format) based on the `logLevelsWithHandles` value
defaultLogHandlers :: IO [GenericHandler Handle]
defaultLogHandlers = mapM (fmap (`setFormatter`defaultLoggerFormat) . makeHandler) logLevelsWithHandles
    where
      makeHandler (l, h) = fmap (\handler -> handler { formatter=defaultLoggerFormat }) (streamHandler h l)

-- This function builds a logger given a logger name and priority to operate at
buildLogger :: String -> Priority -> IO Logger
buildLogger loggerName p = defaultLogHandlers
                           >>= \hs -> (`fmap`getLogger loggerName) (setHandlers hs . setLevel p)

-- Given a MailerBackend (an large piece of code that handles emails whenever they need to be sent), and the overall AppConfig (needed to get the logging configuration, `lc`), and a logger to start with
-- this function creates the email log handler (remember, EmailLogHandlers require a logger so that if the EmailLogHandler can't start, it can tell *something* about the failure)
addEmailLogHandler :: MailerBackend -> AppConfig -> Logger -> Logger
addEmailLogHandler mailer c = addHandler (EmailLogHandler mailer p defaultLoggerFormat lc)
    where
      lc = appLoggerConfig c
      p = loggerEmailPriority lc

setupMailerLogger :: MailerConfig -> IO Logger
setupMailerLogger = buildLogger "App.Mailer" . mailLogLevel -- mailLogLevel gets the log level out of a `MailerConfig`

-- ... further down in the code, in the area of the code that sets up the app ...

-- Set up the mailer
mailerLogger <- setupMailerLogger mailCfg
mailer <- makeConnectedMailerBackend mailCfg (Just mailerLogger)

-- ... in another file dedicated to the `MailerBackend` (a big app component that handles emails whenever they need to happen) ...

data MailerCfg = MailerCfg MailerConfig (Maybe SMTPConnection)

data MailerBackend = LocalMailer (Maybe Logger) MailerCfg
                   | SMTPMailer (Maybe Logger) MailerCfg


makeConnectedMailerBackend :: MailerConfig -> Maybe Logger -> IO MailerBackend
makeConnectedMailerBackend c l = connectMailer $ (if host == "" then LocalMailer else SMTPMailer) l (MailerCfg c Nothing)
    where
      host = mailHostname c
      port = mailPortNumber c


-- ... lots more code: the instances for MailerBackend, functions like `connectMailer`, on and on  ...

------------------------
-- Email log handling --
------------------------

data EmailLogHandler = EmailLogHandler { mlhBackend   :: MailerBackend
                                       , mlhLevel     :: Priority
                                       , mlhFormatter :: LogFormatter EmailLogHandler
                                       , loggerConfig :: LoggerConfig
                                       }

instance SLH.LogHandler EmailLogHandler where
    setLevel mlh l = mlh { mlhLevel=l }
    getLevel =  mlhLevel

    setFormatter mlh f = mlh { mlhFormatter=f }
    getFormatter = mlhFormatter

    emit mlh (priority, msg) logName = simpleMail from to subject body body []
                                       >>= sendMail (mlhBackend mlh)
        where
          to = Nothing `Address` (loggerToEmailAddr . loggerConfig) mlh
          from = Nothing `Address` (loggerFromEmailAddr . loggerConfig) mlh
          subject = DT.pack $ logName ++ " - " ++ show priority
          body = DTL.pack $ "Log record:\n" ++ msg

-- ... inside an IO action that sets up the application (I included some lines for context) ...

-- Start the app
let appGlobals = ApplicationGlobals c backend mailer userContentStore appLogger
let app = makeApp appGlobals cookieMiddleware sessionKey

logL appLogger WARNING "Application starting up...."

-- Set the default application-wide on-exception handler
let appSettings = (setTimeout appTimeoutSeconds . setOnException (appOnExceptionHandler appLogger) . setPort port) defaultSettings

runSettings appSettings app

-- ... more code in between ...

appOnExceptionHandler :: Logger -> Maybe Request -> SomeException -> IO ()
appOnExceptionHandler logger _ e = logL logger ERROR (show e)
                                   >> when (defaultShouldDisplayException e) (TIO.hPutStrLn stderr packedErrStr)
    where
      packedErrStr = T.pack $ show e