{-# LANGUAGE CPP, ScopedTypeVariables #-}

-- |
-- Module:      Network.Riak.Debug
-- Copyright:   (c) 2011 MailRank, Inc.
-- License:     Apache
-- Maintainer:  Mark Hibberd <mark@hibberd.id.au>, Nathan Hunter <nhunter@janrain.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
    , debugValues
    , setHandle
    , showM
    ) where

import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, withMVar)
import Control.Exception hiding (handle)
import Control.Monad (forM_, when)
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 :: Int
level = IO Int -> Int
forall a. IO a -> a
unsafePerformIO (IO Int -> Int) -> IO Int -> Int
forall a b. (a -> b) -> a -> b
$ do
          Either SomeException String
es <- IO String -> IO (Either SomeException String)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO String -> IO (Either SomeException String))
-> IO String -> IO (Either SomeException String)
forall a b. (a -> b) -> a -> b
$ String -> IO String
getEnv String
"RIAK_DEBUG"
          case Either SomeException String
es of
            Left (SomeException
_::SomeException)   -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0
            Right String
"on" -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1
            Right String
s    -> case ReadS Int
forall a. Read a => ReadS a
reads String
s of
                            ((Int
n,String
_):[(Int, String)]
_) -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n
                            [(Int, String)]
_         -> Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1
{-# NOINLINE level #-}
#else
level = 0
{-# INLINE level #-}
#endif

#ifdef DEBUG
handle :: MVar Handle
handle :: MVar Handle
handle = IO (MVar Handle) -> MVar Handle
forall a. IO a -> a
unsafePerformIO (IO (MVar Handle) -> MVar Handle)
-> IO (MVar Handle) -> MVar Handle
forall a b. (a -> b) -> a -> b
$ Handle -> IO (MVar Handle)
forall a. a -> IO (MVar a)
newMVar Handle
stderr
{-# NOINLINE handle #-}
#endif

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

-- | Print a debug message, if debugging is enabled.
debug :: String                 -- ^ Function name.
      -> String                 -- ^ Debug message.
      -> IO ()
#ifdef DEBUG
debug :: String -> String -> IO ()
debug String
func String
str
    | Int
level Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise  =
  MVar Handle -> (Handle -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Handle
handle ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> Handle -> String -> IO ()
hPutStrLn Handle
h (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
func String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
#else
debug _ _ = return ()
{-# INLINE debug #-}
#endif

-- | Print a debug message, and information about some values.  If the
-- debug level is greater than 1, print the values themselves.
debugValues :: (Show a) =>
               String
            -> String
            -> [a]
            -> IO ()
debugValues :: String -> String -> [a] -> IO ()
debugValues String
func String
str [a]
values
#ifdef DEBUG
    | Int
level Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise =
  MVar Handle -> (Handle -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Handle
handle ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
    Handle -> String -> IO ()
hPutStrLn Handle
h (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
values) String -> String -> String
forall a. [a] -> [a] -> [a]
++
                  String
" values [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
func String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (IO () -> IO ())
-> (((Int, a) -> IO ()) -> IO ()) -> ((Int, a) -> IO ()) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [(Int, a)] -> ((Int, a) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
0::Int)..] [a]
values) (((Int, a) -> IO ()) -> IO ()) -> ((Int, a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Int
i,a
v) ->
        Handle -> String -> IO ()
hPutStrLn Handle
h (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"  [" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i 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
v
#else
debugValues _ _ _ = return ()
{-# INLINE debugValues #-}
#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 :: a -> String
showM a
m | Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = a -> String
forall a. Show a => a -> String
show a
m
        | Bool
otherwise = MessageTag -> String
forall a. Show a => a -> String
show (a -> MessageTag
forall msg. Tagged msg => msg -> MessageTag
messageTag a
m)