]> woffs.de Git - fd/haskell-amqp-utils.git/commitdiff
formatting callbackenvironment
authorFrank Doepper <[email protected]>
Tue, 18 Feb 2020 12:19:13 +0000 (13:19 +0100)
committerFrank Doepper <[email protected]>
Tue, 18 Feb 2020 12:19:13 +0000 (13:19 +0100)
Network/AMQP/Utils/Helpers.hs
Network/AMQP/Utils/Options.hs
arbeite.hs
konsum.hs
plane.hs

index ccb7d54e70b31fb05b42faf5237cbc28c2da3d54..9d6765cfdd3fba16a01ce03831d44d70245524ea 100644 (file)
@@ -93,22 +93,26 @@ formatheaders :: ((T.Text, FieldValue) -> [a]) -> FieldTable -> [a]
 formatheaders f (FieldTable ll) = concat $ map f $ M.toList ll
 
 -- | format headers for setting environment variables
-formatheaders' ::
-     ((Int, (T.Text, FieldValue)) -> [(String, String)]) -> FieldTable -> [(String,String)]
-formatheaders' f (FieldTable ll) = concat $ map f $ zip [0 ..] $ M.toList ll
+formatheadersEnv ::
+     ((Int, (T.Text, FieldValue)) -> [(String, String)])
+  -> FieldTable
+  -> [(String, String)]
+formatheadersEnv f (FieldTable ll) = concat $ map f $ zip [0 ..] $ M.toList ll
 
 -- | log formatting
 fieldshow :: (T.Text, FieldValue) -> String
 fieldshow (k, v) = "\n        " ++ T.unpack k ++ ": " ++ valueshow v
 
 -- | callback cmdline formatting
-fieldshow' :: (T.Text, FieldValue) -> [String]
-fieldshow' (k, v) = ["-h", T.unpack k ++ "=" ++ valueshow v]
+fieldshowOpt :: (T.Text, FieldValue) -> [String]
+fieldshowOpt (k, v) = ["-h", T.unpack k ++ "=" ++ valueshow v]
 
 -- | environment variable formatting
-fieldshow'' :: (Int, (T.Text, FieldValue)) -> [(String, String)]
-fieldshow'' (n, (k, v)) =
-  [("AMQP_HEADER_KEY_" ++ nn, T.unpack k), ("AMQP_HEADER_VALUE_" ++ nn, valueshow v)]
+fieldshowEnv :: (Int, (T.Text, FieldValue)) -> [(String, String)]
+fieldshowEnv (n, (k, v)) =
+  [ ("AMQP_HEADER_KEY_" ++ nn, T.unpack k)
+  , ("AMQP_HEADER_VALUE_" ++ nn, valueshow v)
+  ]
   where
     nn = show n
 
@@ -207,9 +211,11 @@ printmsg h (msg, envi) anR now = do
            ] ++
          headersOpt)
     headers = fmap (formatheaders fieldshow) $ msgHeaders msg
-    headersOpt = maybeToList $ fmap (formatheaders fieldshow') $ msgHeaders msg
+    headersOpt =
+      maybeToList $ fmap (formatheaders fieldshowOpt) $ msgHeaders msg
     headersEnv =
-      concat . maybeToList $ fmap (formatheaders' fieldshow'') $ msgHeaders msg
+      concat . maybeToList $
+      fmap (formatheadersEnv fieldshowEnv) $ msgHeaders msg
     body = msgBody msg
     anriss =
       if isimage ctype
@@ -282,7 +288,7 @@ optionalFileStuff ::
   -> Args
   -> ThreadId
   -> Maybe (ExitCode -> BL.ByteString -> IO ())
-  -> [(String,String)]
+  -> [(String, String)]
   -> IO ()
 optionalFileStuff (msg, envi) callbackoptions addi numstring a tid action environment = do
   path <- saveFile (tempDir a) numstring (msgBody msg)
@@ -329,7 +335,7 @@ doProc ::
   -> [String]
   -> Maybe (ExitCode -> BL.ByteString -> IO ())
   -> Maybe String
-  -> [(String,String)]
+  -> [(String, String)]
   -> IO ()
 doProc a numstring envi (exe:args) action path environment = do
   (_, h, _, processhandle) <-
@@ -356,7 +362,7 @@ doProc a numstring envi (exe:args) action path environment = do
         then CreatePipe
         else Inherit
     environment' =
-      ("AMQP_NUMBER",numstring):("AMQP_FILE",fromJust path):environment
+      ("AMQP_NUMBER", numstring) : ("AMQP_FILE", fromJust path) : environment
 doProc _ _ _ _ _ _ _ = return ()
 
 -- | ack
index c660d2bbbc1fd91fc76d8c876ffd3a46b40d3fd0..fb90b182ec3a3a25d7f432a55776946b72a1f0cb 100644 (file)
@@ -1,8 +1,8 @@
 module Network.AMQP.Utils.Options where
 
+import qualified Data.ByteString.Char8 as BS
 import Data.Default.Class
 import Data.Int (Int64)
-import qualified Data.ByteString.Char8 as BS
 import qualified Data.Map as M
 import Data.Maybe
 import Data.Text (Text, pack)
index 2c8e2284015fbcd91d8f9aa930ddbc1728a42cf3..f4366eedd3b238d2d4319e8c2aab7b84ba63737f 100644 (file)
@@ -75,10 +75,18 @@ rpcServerCallback tid a addi c m@(msg, env) = do
   (callbackoptions, callbackenv) <-
     X.catch
       (printmsg Nothing m (anRiss a) now)
-      (\x -> X.throwTo tid (x :: X.SomeException) >> return ([],[]))
+      (\x -> X.throwTo tid (x :: X.SomeException) >> return ([], []))
   either (\e -> printparam "ERROR" (e :: X.SomeException)) return =<<
     X.try
-      (optionalFileStuff m callbackoptions addi numstring a tid (Just reply) callbackenv)
+      (optionalFileStuff
+         m
+         callbackoptions
+         addi
+         numstring
+         a
+         tid
+         (Just reply)
+         callbackenv)
   hr $ "END " ++ numstring
   where
     reply e contents = do
index f30457bc9a1454c73417d92dd7686cee63baf93c..b8377332e90a5847cb0c4aec50ca94623dc7e53e 100644 (file)
--- a/konsum.hs
+++ b/konsum.hs
@@ -84,7 +84,16 @@ myCallback a addi tid m@(_, envi) = do
   (callbackoptions, callbackenv) <-
     X.catch
       (printmsg Nothing m (anRiss a) now)
-      (\x -> X.throwTo tid (x :: X.SomeException) >> return ([],[]))
+      (\x -> X.throwTo tid (x :: X.SomeException) >> return ([], []))
   either (\e -> printparam "ERROR" (e :: X.SomeException) >> reje envi a) return =<<
-    X.try (optionalFileStuff m callbackoptions addi numstring a tid Nothing callbackenv)
+    X.try
+      (optionalFileStuff
+         m
+         callbackoptions
+         addi
+         numstring
+         a
+         tid
+         Nothing
+         callbackenv)
   hr $ "END " ++ numstring
index a3b6fe4dfc1ff390e3126875715f71283dc81381..02bb095723dffc3cd50e025a7f829a6c0e904990 100644 (file)
--- a/plane.hs
+++ b/plane.hs
@@ -89,7 +89,7 @@ rpcClientCallback h tid a m@(_, env) = do
   _ <-
     X.catch
       (printmsg (Just h) m (anRiss a) now)
-      (\x -> X.throwTo tid (x :: X.SomeException) >> return ([],[]))
+      (\x -> X.throwTo tid (x :: X.SomeException) >> return ([], []))
   throwTo tid ReceivedException
 
 data RpcException