rawfilepath -> OsPath, WiP

https://hasufell.github.io/posts/2022-06-29-fixing-haskell-filepaths.html

diff --git a/Network/AMQP/Utils/Helpers.hs b/Network/AMQP/Utils/Helpers.hs
index f2f214326907ad4da4d189eeeaea160424526f4e..7d880eb27bfc013b5d2558e866b0522def1b72ff 100644 (file)
--- a/Network/AMQP/Utils/Helpers.hs
+++ b/Network/AMQP/Utils/Helpers.hs
@@ -28,8 +28,8 @@ import           Network.Socket                   (PortNumber)
 import           System.Directory                 (removeFile)
 import           System.Environment               (getEnvironment)
 import           System.Exit
-import           System.FilePath.Posix.ByteString (RawFilePath)
 import           System.IO
+import           System.Posix.ByteString          (RawFilePath)
 import           System.Posix.IO.ByteString
 import           System.Process
 
@@ -430,12 +430,3 @@ sleepingBeauty =
 firstInputFile :: [(RawFilePath,String,String)] -> RawFilePath
 firstInputFile []          = "-"
 firstInputFile ((x,_,_):_) = x
-
--- | read RawFilePath to Lazy ByteString
-readFileRawLazy :: RawFilePath -> IO BL.ByteString
-readFileRawLazy path = do
-  h <- openFd path ReadOnly defaultFlags >>= fdToHandle
-  hSetBinaryMode h True
-  BL.hGetContents h
-  where
-    defaultFlags = defaultFileFlags { noctty = True }

diff --git a/Network/AMQP/Utils/Options.hs b/Network/AMQP/Utils/Options.hs
index 5772768984628db560bb183c81ba020738b249f3..9c207be12fa1e23f452f08ce7cad4af2d83d7f68 100644 (file)
--- a/Network/AMQP/Utils/Options.hs
+++ b/Network/AMQP/Utils/Options.hs
@@ -19,7 +19,7 @@ import           Network.AMQP.Types
 import           Network.Socket                   (PortNumber)
 import           Paths_amqp_utils                 (version)
 import           System.Console.GetOpt
-import           System.FilePath.Posix.ByteString (RawFilePath)
+import           System.Posix.ByteString          (RawFilePath)
 
 portnumber :: Args -> PortNumber
 portnumber a

diff --git a/agitprop.hs b/agitprop.hs
index 0b6399dd85ccb33cd049233d9b707a986eb1a7ca..cb1db3906503a59ac6b123d933c5de74d4c8bfa5 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,9 @@ 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.listDirectory folder >>=
+         mapM_ (\fn -> handleFile (publishOneMsg exchange rkey) (suffix args) (folder OS.</> fn))
+    else return ()
   return (wd,folder)
 #endif
 
@@ -152,9 +155,9 @@ handleEvent ::
      (Maybe RawFilePath -> BL.ByteString -> IO ()) -> [BS.ByteString] -> RawFilePath -> 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
@@ -166,7 +169,7 @@ handleFile func suffixes@(_:_) 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
 
@@ -212,7 +215,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
@@ -225,10 +228,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)

diff --git a/amqp-utils.cabal b/amqp-utils.cabal
index d6660f74bf0f89730c4dd37bd8768a7ede587038..49d5538e6a15cfe8200716f67b9f4d467f66bcd7 100644 (file)
--- a/amqp-utils.cabal
+++ b/amqp-utils.cabal
@@ -49,7 +49,8 @@ executable konsum
                        directory,
                        bytestring,
                        utf8-string,
-                       filepath-bytestring,
+                       filepath >= 1.4.100,
+                       file-io,
                        crypton-x509-system,
                        network > 2.6,
                        tls >= 1.7.0,
@@ -75,11 +76,10 @@ executable agitprop
                        time,
                        process,
                        directory,
-                       filepath,
+                       filepath >= 1.4.100,
+                       file-io,
                        bytestring,
                        utf8-string,
-                       rawfilepath,
-                       filepath-bytestring,
                        crypton-x509-system,
                        network > 2.6,
                        tls >= 1.7.0,
@@ -110,11 +110,12 @@ executable plane
                        directory,
                        bytestring,
                        utf8-string,
-                       filepath-bytestring,
+                       filepath >= 1.4.100,
+                       file-io,
                        crypton-x509-system,
                        network > 2.6,
                        tls >= 1.7.0,
-                       amqp >=0.22.2,
+                       amqp >= 0.22.2,
                        unix >= 2.8
 
   ghc-options:         -threaded -Wall
@@ -138,7 +139,8 @@ executable arbeite
                        directory,
                        bytestring,
                        utf8-string,
-                       filepath-bytestring,
+                       filepath >= 1.4.100,
+                       file-io,
                        crypton-x509-system,
                        network > 2.6,
                        tls >= 1.7.0,

diff --git a/amqp-utils.nix b/amqp-utils.nix
index a5e2cb288880a2b06f97d4490066a6530a78a68d..a64852addef3a9da13dbf1946467b2f2d312ccfe 100644 (file)
--- a/amqp-utils.nix
+++ b/amqp-utils.nix
@@ -4,8 +4,7 @@
 
 { lib, mkDerivation, amqp, base, bytestring, crypton-connection, containers
 , data-default-class, process, text, time, tls, crypton-x509-system, unix
-, hinotify, magic, network, directory, utf8-string, filepath
-, rawfilepath, filepath-bytestring
+, hinotify, magic, network, directory, utf8-string, filepath, file-io
 }:
 
 mkDerivation {
@@ -18,7 +17,7 @@ mkDerivation {
   executableHaskellDepends = [
     amqp base bytestring crypton-connection containers data-default-class
     process text time tls crypton-x509-system unix hinotify magic network
-    directory utf8-string filepath rawfilepath filepath-bytestring
+    directory utf8-string filepath file-io
   ];
   description = "AMQP toolset for the command line";
   license = lib.licenses.gpl3Only;

diff --git a/flake.nix b/flake.nix
index 29e746e95f43eaefa7f0f4435a2b61a0f86cb31e..56d6509b7b82eb269c6076cd432bb3bc7877da4e 100644 (file)
--- a/flake.nix
+++ b/flake.nix
@@ -5,7 +5,7 @@
 # thank https://magnus.therning.org/2022-03-13-simple-nix-flake-for-haskell-development.html !
 {
   inputs = {
-    nixpkgs.url = "nixpkgs/haskell-updates";
+    nixpkgs.url = "nixpkgs/nixos-unstable";
     flake-utils.url = "flake-utils";
   };
 
@@ -26,14 +26,6 @@
               amqp = hl.dontCheck super.amqp_0_22_2;
               tls = super.tls_1_7_0;
               crypton-connection = super.crypton-connection.override { inherit tls; };
-              rawfilepath = hl.overrideCabal super.rawfilepath {
-                src = pkgs.fetchFromGitHub {
-                  owner = "georgefst";
-                  repo = "rawfilepath";
-                  rev = "044079fa0c3a407037be9086fab92f1209dfb1a8";
-                  hash = "sha256-2LFMLjhm6lLzXTditN0pi9R4QKg0zdBsDOPhcQUD1lQ=";
-                };
-              };
             };
             modifier = (t.flip t.pipe) [
               hl.dontHaddock

diff --git a/plane.hs b/plane.hs
index a95e90298e2c685cb99c153710094afbda5520e9..4f3bf9da13f8e73c2ea7e8c0d947f098a59ad79f 100644 (file)
--- a/plane.hs
+++ b/plane.hs
@@ -8,6 +8,7 @@
 import           Control.Concurrent
 import qualified Control.Exception             as X
 import           Control.Monad
+import qualified Data.ByteString.Char8         as BS
 import qualified Data.ByteString.Lazy.Char8    as BL
 import qualified Data.Text                     as T
 import           Data.Time
@@ -21,6 +22,8 @@ import           Paths_amqp_utils              (version)
 import           System.Environment
 import           System.Exit
 import           System.IO
+import qualified System.File.OsPath               as FOS
+import qualified System.OsPath                    as OS
 
 main :: IO ()
 main = do
@@ -45,7 +48,7 @@ main = do
   message <-
     if inputFile' == "-"
       then BL.getContents
-      else readFileRawLazy inputFile'
+      else OS.encodeUtf (BS.unpack inputFile') >>= FOS.readFile
   printparam "output file" $ outputFile args
   h <-
     if outputFile args == "-"

diff --git a/stack.yaml b/stack.yaml
index 3dcf7ce4297884f663a9ce3248931c37c7c7c982..b30e1520bd7b558c09acd089a073af30ca7bd962 100644 (file)
--- a/stack.yaml
+++ b/stack.yaml
@@ -2,7 +2,7 @@
 #
 # SPDX-License-Identifier: GPL-3.0-only
 
-resolver: nightly-2023-07-19
+resolver: nightly-2023-08-21
 flags: {}
 extra-package-dbs: []
 packages:
@@ -10,6 +10,4 @@ packages:
 nix:
   packages: [ file ]
 extra-deps:
-- amqp-0.22.2
-- git: https://github.com/georgefst/rawfilepath/
-  commit: 044079fa0c3a407037be9086fab92f1209dfb1a8
+- file-io-0.1.0.1