diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,13 @@ # Revision history for haskell-amqp-utils +## 0.5.0.0 -- 2020-03-03 + +* add option -f (--prefetch) for arbeite, default 1 (was unset before) +* print a line after (not) receiving rpc answer +* catch IOException instead of SomeException in callback +* remove --enable-tests from cabal in Makefile +* reformat with hindent + stylish-haskell + ## 0.4.5.1 -- 2020-02-19 * unify threadDelay in mainloop (reduce system load when sleeping) diff --git a/Network/AMQP/Utils/Helpers.hs b/Network/AMQP/Utils/Helpers.hs --- a/Network/AMQP/Utils/Helpers.hs +++ b/Network/AMQP/Utils/Helpers.hs @@ -76,6 +76,8 @@ instance Flexprint X.SomeException +instance Flexprint X.IOException + instance Flexprint AMQPException instance Flexprint ConfirmationResult @@ -355,7 +357,7 @@ if (cleanupTmpFile a) then X.catch (maybe (return ()) removeFile path) - (\e -> printparam "error removing temp file" (e :: X.SomeException)) + (\e -> printparam "error removing temp file" (e :: X.IOException)) else return () where out = @@ -380,4 +382,8 @@ -- | main loop: sleep forever or wait for an exception sleepingBeauty :: IO (X.SomeException) -sleepingBeauty = X.catch (forever (threadDelay 600000000) >> return (X.toException $ X.ErrorCall "not reached")) return +sleepingBeauty = + X.catch + (forever (threadDelay 600000000) >> + return (X.toException $ X.ErrorCall "not reached")) + return diff --git a/Network/AMQP/Utils/Options.hs b/Network/AMQP/Utils/Options.hs --- a/Network/AMQP/Utils/Options.hs +++ b/Network/AMQP/Utils/Options.hs @@ -161,7 +161,7 @@ ["tempdir", "target"] (OptArg (\s o -> o {tempDir = Just (fromMaybe "/tmp" s)}) "DIR") "tempdir (default: no file creation, -t without arg: /tmp)") - , ( "k" + , ( "kr" , Option ['f'] ["prefetch"] @@ -309,13 +309,15 @@ ['u'] ["remove"] (NoArg (\o -> o {removeSentFile = not (removeSentFile o)})) - ("Toggle removal of sent file in hotfolder mode (default: " ++ show (removeSentFile def) ++ ")")) + ("Toggle removal of sent file in hotfolder mode (default: " ++ + show (removeSentFile def) ++ ")")) , ( "a" , Option ['d'] ["dirscan"] (NoArg (\o -> o {initialScan = not (initialScan o)})) - ("Toggle initial directory scan in hotfolder mode (default: " ++ show (initialScan def) ++ ")")) + ("Toggle initial directory scan in hotfolder mode (default: " ++ + show (initialScan def) ++ ")")) , ( "a" , Option ['m'] diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,7 +6,6 @@ - git://woffs.de/git/fd/haskell-amqp-utils.git - https://woffs.de/git/fd/haskell-amqp-utils.git - https://git.sr.ht/~woffs/haskell-amqp-utils -- https://github.com/woffs/haskell-amqp-utils ## Overview The package contains 4 binaries for commandline use. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,3 @@ -import Distribution.Simple +import Distribution.Simple + main = defaultMain diff --git a/agitprop.hs b/agitprop.hs --- a/agitprop.hs +++ b/agitprop.hs @@ -41,9 +41,8 @@ then return False else F.getFileStatus (inputFile args) >>= return . F.isDirectory if isDir - then - printparam "hotfolder" (inputFile args) >> - printparam "initial scan" (initialScan args) + then printparam "hotfolder" (inputFile args) >> + printparam "initial scan" (initialScan args) else printparam "input file" [ inputFile args @@ -60,14 +59,16 @@ confirmSelect chan False addConfirmationListener chan confirmCallback else return () - let publishOneMsg = publishOneMsg' chan args {removeSentFile = removeSentFile args && isDir} + let publishOneMsg = + publishOneMsg' chan args {removeSentFile = removeSentFile args && isDir} X.catch (if isDir then do setCurrentDirectory (inputFile args) if (initialScan args) - then getDirectoryContents "." >>= mapM_ (\fn -> handleFile publishOneMsg (suffix args) fn) - else return() + then getDirectoryContents "." >>= + mapM_ (\fn -> handleFile publishOneMsg (suffix args) fn) + else return () inotify <- initINotify wd <- addWatch @@ -118,10 +119,7 @@ -- | Hotfolder event handler handleEvent :: - (Maybe String -> BL.ByteString -> IO ()) - -> [String] - -> Event - -> IO () + (Maybe String -> BL.ByteString -> IO ()) -> [String] -> Event -> IO () -- just handle closewrite and movedin events #if MIN_VERSION_hinotify(0,3,10) handleEvent func suffixes (Closed False (Just fileName) True) = @@ -129,8 +127,10 @@ handleEvent func suffixes (MovedIn False fileName _) = handleFile func suffixes (BS.unpack fileName) #else -handleEvent func suffixes (Closed False (Just fileName) True) = handleFile func suffixes fileName -handleEvent func suffixes (MovedIn False fileName _) = handleFile func suffixes fileName +handleEvent func suffixes (Closed False (Just fileName) True) = + handleFile func suffixes fileName +handleEvent func suffixes (MovedIn False fileName _) = + handleFile func suffixes fileName #endif handleEvent _ _ _ = return () @@ -145,7 +145,7 @@ handleFile func [] fileName = X.catch (BL.readFile fileName >>= func (Just fileName)) - (\e -> printparam "exception in handleFile" (e :: X.SomeException)) + (\e -> printparam "exception in handleFile" (e :: X.IOException)) -- | Publish one message with our settings publishOneMsg' :: Channel -> Args -> Maybe FilePath -> BL.ByteString -> IO () @@ -191,6 +191,7 @@ substheader (s:r) (Just fname) old = substheader r (Just fname) (addheader old (s ++ "=" ++ fname)) substheader _ _ old = old - removeSentFileIfRequested False _ = return () - removeSentFileIfRequested True Nothing = return () - removeSentFileIfRequested True (Just fname) = printparam "removing" fname >> removeFile fname + removeSentFileIfRequested False _ = return () + removeSentFileIfRequested True Nothing = return () + removeSentFileIfRequested True (Just fname) = + printparam "removing" fname >> removeFile fname diff --git a/amqp-utils.cabal b/amqp-utils.cabal --- a/amqp-utils.cabal +++ b/amqp-utils.cabal @@ -1,6 +1,6 @@ name: amqp-utils -version: 0.4.5.1 +version: 0.5.0.0 synopsis: AMQP toolset for the command line diff --git a/arbeite.hs b/arbeite.hs --- a/arbeite.hs +++ b/arbeite.hs @@ -31,6 +31,9 @@ printparam "client version" ["amqp-utils", showVersion version] (conn, chan) <- connect args addChannelExceptionHandler chan (X.throwTo tid) + -- set prefetch + printparam "prefetch" $ preFetch args + qos chan 0 (preFetch args) False queue <- maybe (declareQueue @@ -70,8 +73,8 @@ (callbackoptions, callbackenv) <- X.catch (printmsg Nothing m (anRiss a) now) - (\x -> X.throwTo tid (x :: X.SomeException) >> return ([], [])) - either (\e -> printparam "ERROR" (e :: X.SomeException)) return =<< + (\x -> X.throwTo tid (x :: X.IOException) >> return ([], [])) + either (\e -> printparam "ERROR" (e :: X.IOException)) return =<< X.try (optionalFileStuff m diff --git a/konsum.hs b/konsum.hs --- a/konsum.hs +++ b/konsum.hs @@ -78,8 +78,8 @@ (callbackoptions, callbackenv) <- X.catch (printmsg Nothing m (anRiss a) now) - (\x -> X.throwTo tid (x :: X.SomeException) >> return ([], [])) - either (\e -> printparam "ERROR" (e :: X.SomeException) >> reje envi a) return =<< + (\x -> X.throwTo tid (x :: X.IOException) >> return ([], [])) + either (\e -> printparam "ERROR" (e :: X.IOException) >> reje envi a) return =<< X.try (optionalFileStuff m diff --git a/plane.hs b/plane.hs --- a/plane.hs +++ b/plane.hs @@ -78,8 +78,8 @@ exitWith ec) exceptionHandler :: RpcException -> IO (ExitCode) -exceptionHandler ReceivedException = return ExitSuccess -exceptionHandler TimeoutException = return $ ExitFailure 1 +exceptionHandler ReceivedException = hr "success" >> (return ExitSuccess) +exceptionHandler TimeoutException = hr "timeout" >> (return $ ExitFailure 1) rpcClientCallback :: Handle -> ThreadId -> Args -> (Message, Envelope) -> IO () rpcClientCallback h tid a m@(_, env) = do @@ -89,7 +89,7 @@ _ <- X.catch (printmsg (Just h) m (anRiss a) now) - (\x -> X.throwTo tid (x :: X.SomeException) >> return ([], [])) + (\x -> X.throwTo tid (x :: X.IOException) >> return ([], [])) throwTo tid ReceivedException data RpcException