From: Frank Doepper Date: Mon, 21 Aug 2023 14:39:19 +0000 (+0200) Subject: rawfilepath -> OsPath, WiP X-Git-Url: https://woffs.de/git/fd/haskell-amqp-utils.git/commitdiff_plain/f0f3b76b4517dcc8a51322d52bf1d6b0a8ea05bc 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 f2f2143..7d880eb 100644 --- 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 5772768..9c207be 100644 --- 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 0b6399d..cb1db39 100644 --- 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 d6660f7..49d5538 100644 --- 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 a5e2cb2..a64852a 100644 --- 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 29e746e..56d6509 100644 --- 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 a95e902..4f3bf9d 100644 --- 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 3dcf7ce..b30e152 100644 --- 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