riak-haskell-client / src / Network / Riak / Debug.hs

{-# LANGUAGE CPP, ScopedTypeVariables #-}

-- |
-- Module:      Network.Riak.Debug
-- Copyright:   (c) 2011 MailRank, Inc.
-- License:     Apache
-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>
-- Stability:   experimental
-- Portability: portable
--
-- Support for debug logging.  The code in this package only works if
-- the package was built with the @-fdebug@ flag.  Otherwise, they are
-- all no-ops.

module Network.Riak.Debug
    (
      level
    , debug
    , setHandle
    , showM
    ) where

import Control.Exception hiding (handle)
import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, withMVar)
import Network.Riak.Types.Internal
import System.Environment (getEnv)
import System.IO (Handle, hPutStrLn, stderr)
import System.IO.Unsafe (unsafePerformIO)

-- | The current debugging level.  This is established once by reading
-- the @RIAK_DEBUG@ environment variable.
level :: Int
#ifdef DEBUG
level = unsafePerformIO $ do
          es <- try $ getEnv "RIAK_DEBUG"
          case es of
            Left (_::SomeException)   -> return 0
            Right "on" -> return 1
            Right s    -> case reads s of
                            ((n,_):_) -> return n
                            _         -> return 1
{-# NOINLINE level #-}
#else
level = 0
{-# INLINE level #-}
#endif

#ifdef DEBUG
handle :: MVar Handle
handle = unsafePerformIO $ newMVar stderr
{-# NOINLINE handle #-}
#endif

-- | Set the 'Handle' to log to ('stderr' is the default).
setHandle :: Handle -> IO ()
#ifdef DEBUG
setHandle = modifyMVar_ handle . const . return
#else
setHandle _ = return ()
{-# INLINE setHandle #-}
#endif

debug :: String -> String -> IO ()
#ifdef DEBUG
debug func str
    | level == 0 = return ()
    | otherwise  =
  withMVar handle $ \h -> hPutStrLn h $ str ++ " [" ++ func ++ "]"
#else
debug _ _ = return ()
{-# INLINE debug #-}
#endif

-- | Show a 'Tagged' value.  Show the entire value if the debug level
-- is above 1, just the tag otherwise.
showM :: (Show a, Tagged a) => a -> String
showM m | level > 1 = show m
        | otherwise = show (messageTag m)
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.