printparam default

diff --git a/Network/AMQP/Utils/Helpers.hs b/Network/AMQP/Utils/Helpers.hs
index 5763326d1f90f34e9f4d4cfee184eb114bc83b9d..66729babfe83f45f097fb8d63aff61be91250ae5 100644 (file)
--- a/Network/AMQP/Utils/Helpers.hs
+++ b/Network/AMQP/Utils/Helpers.hs
@@ -17,25 +17,22 @@ import System.Exit
 import System.IO
 import System.Process
 
--- | Strings or ByteStrings with label, oder nothing at all
-printwithlabel :: String -> Maybe (IO ()) -> IO ()
-printwithlabel _ Nothing = return ()
-printwithlabel labl (Just i) = do
-  mapM_ (hPutStr stderr) [" --- ", labl, ": "]
-  i
-  hFlush stderr
-
 class Flexprint a where
-  flexprint :: a -> Maybe (IO ())
-
-instance Flexprint (Maybe String) where
-  flexprint = fmap (hPutStrLn stderr)
+  flexprint :: a -> IO ()
+  printparam :: String -> a -> IO ()
+  printparam labl x = do
+    mapM_ (hPutStr stderr) [" --- ", labl, ": "]
+    flexprint x
+    hFlush stderr
 
-instance Flexprint (Maybe Int) where
-  flexprint x = flexprint (fmap show x)
+instance (Flexprint a) => Flexprint (Maybe a) where
+  flexprint Nothing = return ()
+  flexprint (Just x) = flexprint x
+  printparam _ Nothing = return ()
+  printparam x (Just y) = printparam x y
 
 instance Flexprint String where
-  flexprint x = flexprint (Just x)
+  flexprint = hPutStrLn stderr
 
 instance Flexprint [String] where
   flexprint = flexprint . unwords
@@ -49,18 +46,11 @@ instance  Flexprint Int where
 instance Flexprint T.Text where
   flexprint = flexprint . T.unpack
 
--- | optional or required parameters
-printparam :: Flexprint a => String -> a -> IO ()
-printparam labl x = printwithlabel labl $ flexprint x
+instance Flexprint BL.ByteString where
+  flexprint x = hPutStrLn stderr "" >> BL.hPut stderr x >> hPutStrLn stderr ""
 
--- | head chars of body
-printbody :: String -> Maybe BL.ByteString -> IO ()
-printbody labl ms = do
-  printwithlabel labl $
-    fmap
-      (\s -> hPutStrLn stderr "" >> BL.hPut stderr s >> hPutStrLn stderr "")
-      ms
-  hFlush stderr
+instance Flexprint ExitCode where
+  flexprint = flexprint . show
 
 -- | log marker
 hr :: String -> IO ()
@@ -130,7 +120,7 @@ printmsg h (msg, envi) anR now = do
     , ("expiration", mexp)
     , ("delivery mode", mdelivmode)
     ]
-  printbody label anriss
+  printparam label anriss
   mapM_ (\hdl -> BL.hPut hdl body >> hFlush hdl) h
   return $
     concat
@@ -269,7 +259,7 @@ doProc a numstring envi (exe:args) action = do
     createProcess (proc exe args) {std_out = out, std_err = Inherit}
   sout <- mapM BL.hGetContents h
   exitcode <- maybe 0 id (fmap BL.length sout) `seq` waitForProcess processhandle
-  printparam (numstring ++ " call returned") $ show exitcode
+  printparam (numstring ++ " call returned") exitcode
   if isJust action && isJust sout
     then ((fromJust action $ exitcode) (fromJust sout)) >> acke envi a
     else case exitcode of

diff --git a/arbeite.hs b/arbeite.hs
index d542efc468998d2bb14aba295d6b476ddc02b38a..a99f82755404d6514aefbf6e4b908a2b97a98b90 100644 (file)
--- a/arbeite.hs
+++ b/arbeite.hs
@@ -36,7 +36,7 @@ main = do
        (\(x, _, _) -> return x))
       (return)
       (fmap T.pack (qName args))
-  printparam "queue name" $ T.unpack queue
+  printparam "queue name" queue
   if (currentExchange args /= "")
     then do
       printparam "exchange" $ currentExchange args
@@ -50,11 +50,11 @@ main = do
          then Ack
          else NoAck)
       (rpcServerCallback tid args addiArgs chan)
-  printparam "consumer tag" $ T.unpack ctag
-  printparam "send acks" $ show (ack args)
+  printparam "consumer tag" ctag
+  printparam "send acks" (ack args)
   printparam "requeue if rejected" $
     if (ack args)
-      then Just (show (requeuenack args))
+      then Just (requeuenack args)
       else Nothing
   hr "entering main loop"
   X.catch

diff --git a/konsum.hs b/konsum.hs
index a68acb8dc801d4f3a73fb76cdf785a061f4de35e..439246085fa2c4a840dbf4c45954cd4d71fe1ae3 100644 (file)
--- a/konsum.hs
+++ b/konsum.hs
@@ -44,8 +44,8 @@ main = do
          then Ack
          else NoAck)
       (myCallback args addiArgs tid)
-  printparam "consumer tag" $ T.unpack ctag
-  printparam "send acks" $ show (ack args)
+  printparam "consumer tag" ctag
+  printparam "send acks" (ack args)
   printparam "requeue if rejected" $
     if (ack args)
       then Just (show (requeuenack args))

diff --git a/plane.hs b/plane.hs
index 6013958a338aa9263b05b2858d122efb9ca434a5..ff7341d501042c40bd110f8add969c06681f87b0 100644 (file)
--- a/plane.hs
+++ b/plane.hs
@@ -44,7 +44,7 @@ main = do
   printparam "output file" $ outputFile args
   h <- if outputFile args == "-" then return stdout else openBinaryFile (outputFile args) WriteMode
   ctag <- consumeMsgs chan q NoAck (rpcClientCallback h tid args)
-  printparam "consumer tag" $ T.unpack ctag
+  printparam "consumer tag" ctag
   now <- getCurrentTime >>= return . floor . utcTimeToPOSIXSeconds
   hr "publishing request"
   _ <- publishMsg
@@ -69,7 +69,7 @@ main = do
        ec <- exceptionHandler x
        hr "closing connection"
        closeConnection conn
-       printparam "exiting" $ show ec
+       printparam "exiting" ec
        exitWith ec)
 
 exceptionHandler :: RpcException -> IO (ExitCode)