WiP rabbit hole

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

diff --git a/agitprop.hs b/agitprop.hs
index 80b8c9a26967a968ecbcb993c533d2e1776bbf63..445f686f80e0aca7bef4a69b5119146c4f49a7f3 100644 (file)
--- a/agitprop.hs
+++ b/agitprop.hs
@@ -25,14 +25,17 @@ import           Network.AMQP.Utils.Connection
 import           Network.AMQP.Utils.Helpers
 import           Network.AMQP.Utils.Options
 import           Paths_amqp_utils                 (version)
-import qualified RawFilePath.Directory            as RD
+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
@@ -54,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
@@ -90,7 +93,7 @@ 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
@@ -120,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
 
@@ -145,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
 
@@ -211,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
@@ -224,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)