]> woffs.de Git - fd/haskell-amqp-utils.git/commitdiff
agitprop: handle exceptions
authorFrank Doepper <[email protected]>
Tue, 26 Jun 2018 14:26:59 +0000 (16:26 +0200)
committerFrank Doepper <[email protected]>
Tue, 26 Jun 2018 14:39:43 +0000 (16:39 +0200)
agitprop.hs

index 969ce495ec3b4d9bab2b9ab6c7be890893514a1c..7f52a28561ad36374d17208229419a867a51c306 100644 (file)
@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 import Control.Concurrent (threadDelay)
+import qualified Control.Exception as X
 import Control.Monad (forever)
 import qualified Data.ByteString.Lazy.Char8 as BL
 import qualified Data.Text as T
@@ -44,24 +45,26 @@ main = do
             (T.pack $ rKey args)
             newMsg {msgBody = f, msgDeliveryMode = Just Persistent}
         printparam "sent" $ fmap show r
-  if isDir
-    then do
-      inotify <- initINotify
-      wd <-
-        addWatch
-          inotify
-          [CloseWrite, MoveIn]
-          (inputFile args)
-          (handleEvent publishOneMsg)
-      hr (inputFile args)
-      _ <- forever $ threadDelay 1000000
-      removeWatch wd
-    else do
-      hr (inputFile args)
-      messageFile <- BL.readFile (inputFile args)
-      if (lineMode args)
-        then mapM_ publishOneMsg (BL.lines messageFile)
-        else publishOneMsg messageFile
+  X.catch
+    (if isDir
+       then do
+         inotify <- initINotify
+         wd <-
+           addWatch
+             inotify
+             [CloseWrite, MoveIn]
+             (inputFile args)
+             (handleEvent publishOneMsg)
+         hr $ "watching " ++ (inputFile args)
+         _ <- forever $ threadDelay 1000000
+         removeWatch wd
+       else do
+         hr $ "sending " ++ (inputFile args)
+         messageFile <- BL.readFile (inputFile args)
+         if (lineMode args)
+           then mapM_ publishOneMsg (BL.lines messageFile)
+           else publishOneMsg messageFile)
+    (\exception -> printparam' "exception" $ show (exception :: X.SomeException))
   -- all done. wait and close.
   if (confirm args)
     then waitForConfirms chan >>= return . show >> return ()
@@ -79,13 +82,19 @@ confirmCallback (deliveryTag, isAll, ackType) =
         else " this ") ++
      (show ackType))
 
--- | hotfolder event handler
+-- | Hotfolder event handler
 handleEvent :: (BL.ByteString -> IO ()) -> Event -> IO ()
+-- just handle closewrite and movedin events
 handleEvent f (Closed False (Just x) True) = handleFile f x
 handleEvent f (MovedIn False x _) = handleFile f x
 handleEvent _ _ = return ()
 
--- | hotfolder file handler
+-- | Hotfolder file handler
 handleFile :: (BL.ByteString -> IO ()) -> FilePath -> IO ()
-handleFile _ ('.':_) = return ()
-handleFile f x = hr x >> BL.readFile x >>= f
+handleFile _ ('.':_) = return () -- ignore hidden files
+handleFile f x =
+  X.catch
+    (hr ("sending " ++ x) >> BL.readFile x >>= f)
+    (\exception ->
+       printparam' "exception in handleFile" $
+       show (exception :: X.SomeException))