    -- | An internal Snap module for (optionally) printing debugging messages. To
    -- enable debug output, compile the library with the @debug@ flag (off by
    -- default) and set the environment variable @DEBUG@ to @1@. We use
    -- 'unsafePerformIO' to make sure that the call to 'getEnv' is only made once.
    --
    -- /N.B./ this is an internal interface, please don't write external code that
    -- depends on it.

    {-# LANGUAGE BangPatterns        #-}
    {-# LANGUAGE CPP                 #-}
    {-# LANGUAGE FlexibleContexts    #-}
    {-# LANGUAGE OverloadedStrings   #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# OPTIONS_GHC -fno-cse         #-}

    module Snap.Internal.Debug (debug, debugErrno) where

    ------------------------------------------------------------------------------
    import           Control.Monad.IO.Class (MonadIO (..))

    #ifndef NODEBUG
    import           Control.Concurrent     (MVar, myThreadId, newMVar, withMVar)
    import           Control.Exception      (SomeException, try)
    import           Data.Char              (toLower)
    import           Data.List              (stripPrefix)
    import           Data.Maybe             (fromMaybe)
    import           Foreign.C.Error        (errnoToIOError, getErrno)
    import           System.Environment     (getEnv)
    import           System.IO              (hFlush, hPutStrLn, stderr)
    import           System.IO.Unsafe       (unsafePerformIO)
    import           Text.Printf            (printf)
    #endif
    ------------------------------------------------------------------------------

    -- | Print out the provided debug message prefixed by the thread ID.
    --
    -- Example:
    --
    -- @
    -- ghci> debug "Some debug message"
    -- [     225] Some debug message
    -- @
    debug :: MonadIO m => String -> m ()

    -- | Print out the error message corresponding to the 'Foreign.C.Error.Errno'
    -- value returned by 'Foreign.C.Error.getErrno' together with any additional
    -- information provided by the user (usually the location where the error
    -- occurred).
    --
    -- Example:
    --
    -- @
    -- ghci> debugErrno "path/to/Source.hs:34"
    -- [     323] path/to/Source.hs:34: failed (Success)
    -- @
    debugErrno :: MonadIO m => String -> m ()

    #ifndef NODEBUG

    {-# NOINLINE debug #-}
    debug = let !x = unsafePerformIO $ do
                    !e <- try $ getEnv "DEBUG"

                    !f <- either (\(_::SomeException) -> return debugIgnore)
                                 (\y0 -> let y = map toLower y0
                                         in if y == "1" || y == "on"
                                           then return debugOn
                                           else if y == "testsuite"
                                                  then return debugSeq
                                                  else return debugIgnore)
                                 e
                    return $! f
            in x

    {-# NOINLINE debugErrno #-}
    debugErrno = let !x = unsafePerformIO $ do
                         e <- try $ getEnv "DEBUG"
                         !f <- either (\(_::SomeException) -> return debugErrnoIgnore)
                                      (\y0 -> let y = map toLower y0
                                              in if y == "1" || y == "on"
                                                then return debugErrnoOn
                                                else if y == "testsuite"
                                                       then return debugSeq
                                                       else return debugErrnoIgnore)
                                      e
                         return $! f
                 in x

    ------------------------------------------------------------------------------
    debugSeq :: (MonadIO m) => String -> m ()
    debugSeq !s = length s `seq` return $! ()
    {-# NOINLINE debugSeq #-}

    ------------------------------------------------------------------------------
    _debugMVar :: MVar ()
    _debugMVar = unsafePerformIO $ newMVar ()
    {-# NOINLINE _debugMVar #-}

    ------------------------------------------------------------------------------
    debugOn :: (MonadIO m) => String -> m ()
    debugOn s = liftIO $ withMVar _debugMVar $ \_ -> do
                    tid <- myThreadId
                    hPutStrLn stderr $ s' tid
                    hFlush stderr
      where
        chop x = let y = fromMaybe x $ stripPrefix "ThreadId " x
                 in printf "%8s" y

        s' t   = "[" ++ chop (show t) ++ "] " ++ s

    {-# NOINLINE debugOn #-}

    ------------------------------------------------------------------------------
    debugErrnoOn :: (MonadIO m) => String -> m ()
    debugErrnoOn loc = liftIO $ do
        err <- getErrno
        let ex = errnoToIOError loc err Nothing Nothing
        debug $ show ex
    ------------------------------------------------------------------------------

    #else

    debug :: forall (m :: * -> *). MonadIO m => String -> m ()
    debug      = String -> m ()
    forall (m :: * -> *). MonadIO m => String -> m ()
    debugIgnore
    {-# INLINE debug #-}

    debugErrno :: forall (m :: * -> *). MonadIO m => String -> m ()
    debugErrno = String -> m ()
    forall (m :: * -> *). MonadIO m => String -> m ()
    debugErrnoIgnore
    {-# INLINE debugErrno #-}

    #endif

    ------------------------------------------------------------------------------
    debugIgnore :: (MonadIO m) => String -> m ()
    debugIgnore :: forall (m :: * -> *). MonadIO m => String -> m ()
    debugIgnore String
    _ = () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    {-# INLINE debugIgnore #-}

    debugErrnoIgnore :: (MonadIO m) => String -> m ()
    debugErrnoIgnore :: forall (m :: * -> *). MonadIO m => String -> m ()
    debugErrnoIgnore String
    _ = () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    {-# INLINE debugErrnoIgnore #-}
    ------------------------------------------------------------------------------