amqp-utils 0.4.5.1 → 0.5.0.0
raw patch · 10 files changed
+51/−31 lines, 10 filessetup-changed
Files
- ChangeLog.md +8/−0
- Network/AMQP/Utils/Helpers.hs +8/−2
- Network/AMQP/Utils/Options.hs +5/−3
- README.md +0/−1
- Setup.hs +2/−1
- agitprop.hs +17/−16
- amqp-utils.cabal +1/−1
- arbeite.hs +5/−2
- konsum.hs +2/−2
- plane.hs +3/−3
ChangeLog.md view
@@ -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)
Network/AMQP/Utils/Helpers.hs view
@@ -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
Network/AMQP/Utils/Options.hs view
@@ -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']
README.md view
@@ -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.
Setup.hs view
@@ -1,2 +1,3 @@-import Distribution.Simple+import Distribution.Simple+ main = defaultMain
agitprop.hs view
@@ -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
amqp-utils.cabal view
@@ -1,6 +1,6 @@ name: amqp-utils -version: 0.4.5.1+version: 0.5.0.0 synopsis: AMQP toolset for the command line
arbeite.hs view
@@ -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
konsum.hs view
@@ -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
plane.hs view
@@ -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