WiP rabbit hole

[fd/haskell-amqp-utils.git] / agitprop.hs

diff --git a/agitprop.hs b/agitprop.hs
index 70c52732c618feef17a9e58b898db43cc0ff42f0..445f686f80e0aca7bef4a69b5119146c4f49a7f3 100644 (file)
--- a/agitprop.hs
+++ b/agitprop.hs
@@ -1,3 +1,7 @@
+-- SPDX-FileCopyrightText: 2022 Frank Doepper
+--
+-- SPDX-License-Identifier: GPL-3.0-only
+
 {-# LANGUAGE CPP               #-}
 {-# LANGUAGE OverloadedStrings #-}
 
@@ -5,9 +9,8 @@
 import           Control.Concurrent
 import qualified Control.Exception                as X
 import           Control.Monad                    (forM_)
-import qualified Data.ByteString.Lazy.Char8       as BL
-import qualified RawFilePath.Directory            as RD
 import qualified Data.ByteString.Char8            as BS
+import qualified Data.ByteString.Lazy.Char8       as BL
 import qualified Data.Map                         as M
 import           Data.Maybe
 import qualified Data.Text                        as T
@@ -22,13 +25,17 @@ import           Network.AMQP.Utils.Connection
 import           Network.AMQP.Utils.Helpers
 import           Network.AMQP.Utils.Options
 import           Paths_amqp_utils                 (version)
+import qualified System.Directory.OsPath          as DO
 import           System.Environment
 import           System.Exit
-import           System.FilePath.Posix.ByteString
 #if linux_HOST_OS
 import           System.INotify
 #endif
-import qualified System.Posix.Files.ByteString    as F
+import           System.Posix.ByteString           (RawFilePath)
+import qualified System.Posix.Files.ByteString    as FB
+import qualified System.Posix.Files.PosixString   as FP
+import qualified System.OsPath                    as OS
+import qualified System.File.OsPath               as FOS
 
 main :: IO ()
 main = do
@@ -50,7 +57,7 @@ main = do
   isDir <-
     if inputFile' == "-"
       then return False
-      else F.getFileStatus inputFile' >>= return . F.isDirectory
+      else FB.getFileStatus inputFile' >>= return . FB.isDirectory
   let publishOneMsg =
         publishOneMsg' chan args {removeSentFile = removeSentFile args && isDir}
   if isDir
@@ -72,11 +79,12 @@ main = do
        then do
 #if linux_HOST_OS
          wds <- mapM (watchHotfolder args publishOneMsg) (inputFiles args)
-         sleepingBeauty >>= printparam "exception"
-         forM_ wds (\(wd,folder) -> do
-           removeWatch wd
-           printparam "END watching" folder
-           )
+         sleepingBeauty >>= (\x -> do
+           forM_ wds (\(wd,folder) -> do
+             removeWatch wd
+             printparam "END watching" folder
+             )
+           X.throw x)
 #else
          X.throw (X.ErrorCall "ERROR: watching a directory is only supported in Linux")
 #endif
@@ -85,17 +93,17 @@ main = do
          messageFile <-
            if inputFile' == "-"
              then BL.getContents
-             else readFileRawLazy inputFile'
+             else OS.encodeUtf (BS.unpack inputFile') >>= FOS.readFile
          if (lineMode args)
            then mapM_ (publishOneMsg (currentExchange args) (rKey args) Nothing) (BL.lines messageFile)
            else publishOneMsg (currentExchange args) (rKey args) (Just (inputFile')) messageFile
-         hr "END sending")
+         hr "END sending"
+         if (confirm args)
+           then waitForConfirms chan >>= printparam "confirmed"
+           else return ()
+         X.catch (closeConnection conn) exceptionHandler
+         )
     exceptionHandler
-  -- all done. wait and close.
-  if (confirm args)
-    then waitForConfirms chan >>= printparam "confirmed"
-    else return ()
-  X.catch (closeConnection conn) exceptionHandler
 
 #if linux_HOST_OS
 -- | watch a hotfolder
@@ -115,9 +123,11 @@ watchHotfolder args publishOneMsg (folder, exchange, rkey) = do
      (handleEvent (publishOneMsg exchange rkey) (suffix args) folder)
   hr "BEGIN watching"
   if (initialScan args)
-   then RD.listDirectory folder >>=
-        mapM_ (\fn -> handleFile (publishOneMsg exchange rkey) (suffix args) (folder </> fn))
-   else return ()
+    then do
+      folder' <- OS.encodeUtf (BS.unpack folder)
+      DO.listDirectory folder' >>=
+        mapM_ (\fn -> handleFile (publishOneMsg exchange rkey) (suffix args) (folder' OS.</> fn))
+    else return ()
   return (wd,folder)
 #endif
 
@@ -140,27 +150,28 @@ confirmCallback (deliveryTag, isAll, ackType) =
         else "this"
     , show ackType
     ]
+
 #if linux_HOST_OS
 -- | Hotfolder event handler
 handleEvent ::
-     (Maybe RawFilePath -> BL.ByteString -> IO ()) -> [BS.ByteString] -> RawFilePath -> Event -> IO ()
+     (Maybe RawFilePath -> BL.ByteString -> IO ()) -> [BS.ByteString] -> OS.OsPath -> Event -> IO ()
 -- just handle closewrite and movedin events
 handleEvent func suffixes folder (Closed False (Just fileName) True) =
-  handleFile func suffixes (folder </> fileName)
+  handleFile func suffixes (folder OS.</> fileName)
 handleEvent func suffixes folder (MovedIn False fileName _) =
-  handleFile func suffixes (folder </> fileName)
+  handleFile func suffixes (folder OS.</> fileName)
 handleEvent _ _ _ _ = return ()
 
 -- | Hotfolder file handler
 handleFile ::
-     (Maybe RawFilePath -> BL.ByteString -> IO ()) -> [BS.ByteString] -> RawFilePath -> IO ()
+     (Maybe RawFilePath -> BL.ByteString -> IO ()) -> [BS.ByteString] -> OS.OsPath -> IO ()
 handleFile func suffixes@(_:_) fileName =
   if (any (flip BS.isSuffixOf fileName) suffixes) && not ("." `BS.isPrefixOf` fileName)
     then handleFile func [] fileName
     else return ()
 handleFile func [] fileName =
   X.catch
-    (readFileRawLazy fileName >>= func (Just fileName))
+    (FOS.readFile fileName >>= func (Just fileName))
     (\e -> printparam "exception while processing" fileName >> printparam "exception in handleFile" (e :: X.IOException))
 #endif
 
@@ -206,7 +217,7 @@ publishOneMsg' chan a exchange rkey fn content = do
       , msgPriority = prio a
       , msgCorrelationID = corrid a
       , msgExpiration = msgexp a
-      , msgHeaders = substheader (fnheader a) (fmap takeFileName fn) $ msgheader a
+      , msgHeaders = substheader (fnheader a) (fmap OS.takeFileName fn) $ msgheader a
       } >>=
     printparam "sent"
   removeSentFileIfRequested (removeSentFile a) (moveSentFileTo a) fn
@@ -219,10 +230,10 @@ publishOneMsg' chan a exchange rkey fn content = do
     removeSentFileIfRequested False _ _ = return ()
     removeSentFileIfRequested True _ Nothing = return ()
     removeSentFileIfRequested True Nothing (Just fname) =
-      printparam "removing" fname >> RD.removeFile fname
+      printparam "removing" fname >> DO.removeFile fname
     removeSentFileIfRequested True (Just path) (Just fname) =
       printparam "moving" [fname,"to",path] >>
-      F.rename fname (replaceDirectory fname ((takeDirectory fname) </> path))
+      FP.rename fname (OS.replaceDirectory fname ((OS.takeDirectory fname) OS.</> path))
     addheader' :: Maybe FieldTable -> String -> BS.ByteString -> Maybe FieldTable
     addheader' Nothing k v =
       Just $ FieldTable $ M.singleton (T.pack k) (FVString v)