From c74c75b3525c9feccdb2520db77d06d06b4fd1a0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 7 Feb 2025 16:07:05 -0400 Subject: [PATCH] more OsPath conversion (639/749) Sponsored-by: k0ld --- Annex/CheckIgnore.hs | 2 +- CmdLine.hs | 12 ++++--- Command/Add.hs | 36 ++++++++++---------- Command/AddUnused.hs | 2 +- Command/AddUrl.hs | 70 +++++++++++++++++++------------------- Command/CalcKey.hs | 2 +- Command/Config.hs | 2 +- Command/ContentLocation.hs | 8 +++-- Command/Copy.hs | 4 +-- Command/DiffDriver.hs | 4 +-- Command/Drop.hs | 2 +- Command/DropUnused.hs | 5 ++- Command/EnableTor.hs | 4 +-- Command/ExamineKey.hs | 8 ++--- Command/Export.hs | 9 +++-- Command/FilterBranch.hs | 8 ++--- Command/FilterProcess.hs | 6 ++-- Command/Find.hs | 10 +++--- Command/Get.hs | 2 +- Command/ImportFeed.hs | 44 ++++++++++++------------ Command/Mirror.hs | 2 +- Command/Move.hs | 2 +- Command/Whereis.hs | 2 +- Git/CheckIgnore.hs | 6 ++-- Git/FilterProcess.hs | 6 ++-- Git/Quote.hs | 7 ++++ Utility/Aeson.hs | 9 +++++ Utility/HtmlDetect.hs | 5 ++- 28 files changed, 147 insertions(+), 132 deletions(-) diff --git a/Annex/CheckIgnore.hs b/Annex/CheckIgnore.hs index d3c03f210a..c280a31494 100644 --- a/Annex/CheckIgnore.hs +++ b/Annex/CheckIgnore.hs @@ -22,7 +22,7 @@ import Annex.Concurrent.Utility newtype CheckGitIgnore = CheckGitIgnore Bool -checkIgnored :: CheckGitIgnore -> RawFilePath -> Annex Bool +checkIgnored :: CheckGitIgnore -> OsPath -> Annex Bool checkIgnored (CheckGitIgnore False) _ = pure False checkIgnored (CheckGitIgnore True) file = ifM (Annex.getRead Annex.force) diff --git a/CmdLine.hs b/CmdLine.hs index f432452e43..ebf0b3b1a1 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module CmdLine ( dispatch, usage, @@ -29,6 +31,7 @@ import Annex.Action import Annex.Environment import Command import Types.Messages +import qualified Utility.OsString as OS {- Parses input arguments, finds a matching Command, and runs it. -} dispatch :: Bool -> Bool -> CmdParams -> [Command] -> [(String, String)] -> IO Git.Repo -> String -> String -> IO () @@ -159,17 +162,18 @@ findAddonCommand Nothing = return Nothing findAddonCommand (Just subcommandname) = searchPath c >>= \case Nothing -> return Nothing - Just p -> return (Just (mkAddonCommand p subcommandname)) + Just p -> return (Just (mkAddonCommand (fromOsPath p) subcommandname)) where c = "git-annex-" ++ subcommandname findAllAddonCommands :: IO [Command] findAllAddonCommands = filter isaddoncommand - . map (\p -> mkAddonCommand p (deprefix p)) - <$> searchPathContents ("git-annex-" `isPrefixOf`) + . map go + <$> searchPathContents (literalOsPath "git-annex-" `OS.isPrefixOf`) where - deprefix = replace "git-annex-" "" . takeFileName + go p = mkAddonCommand (fromOsPath p) (deprefix p) + deprefix = replace "git-annex-" "" . fromOsPath . takeFileName isaddoncommand c -- git-annex-shell | cmdname c == "shell" = False diff --git a/Command/Add.hs b/Command/Add.hs index ef5853126f..aca25f02dd 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -31,7 +31,6 @@ import Utility.InodeCache import Annex.InodeSentinal import Annex.CheckIgnore import qualified Utility.RawFilePath as R -import qualified System.FilePath.ByteString as P import System.PosixCompat.Files (fileSize, isSymbolicLink, isRegularFile, modificationTime, fileID, deviceID, fileMode, ownerExecuteMode, intersectFileModes) @@ -140,23 +139,23 @@ seek' o = do dr = dryRunOption o {- Pass file off to git-add. -} -startSmall :: Bool -> DryRun -> SeekInput -> RawFilePath -> CommandStart +startSmall :: Bool -> DryRun -> SeekInput -> OsPath -> CommandStart startSmall isdotfile dr si file = - liftIO (catchMaybeIO $ R.getSymbolicLinkStatus file) >>= \case + liftIO (catchMaybeIO $ R.getSymbolicLinkStatus $ fromOsPath file) >>= \case Just s -> starting "add" (ActionItemTreeFile file) si $ addSmall isdotfile dr file s Nothing -> stop -addSmall :: Bool -> DryRun -> RawFilePath -> FileStatus -> CommandPerform +addSmall :: Bool -> DryRun -> OsPath -> FileStatus -> CommandPerform addSmall isdotfile dr file s = do showNote $ (if isdotfile then "dotfile" else "non-large file") <> "; adding content to git repository" skipWhenDryRun dr $ next $ addFile Small file s -startSmallOverridden :: DryRun -> SeekInput -> RawFilePath -> CommandStart +startSmallOverridden :: DryRun -> SeekInput -> OsPath -> CommandStart startSmallOverridden dr si file = - liftIO (catchMaybeIO $ R.getSymbolicLinkStatus file) >>= \case + liftIO (catchMaybeIO $ R.getSymbolicLinkStatus $ fromOsPath file) >>= \case Just s -> starting "add" (ActionItemTreeFile file) si $ do showNote "adding content to git repository" skipWhenDryRun dr $ next $ addFile Small file s @@ -164,22 +163,23 @@ startSmallOverridden dr si file = data SmallOrLarge = Small | Large -addFile :: SmallOrLarge -> RawFilePath -> FileStatus -> Annex Bool +addFile :: SmallOrLarge -> OsPath -> FileStatus -> Annex Bool addFile smallorlarge file s = do + let file' = fromOsPath file sha <- if isSymbolicLink s - then hashBlob =<< liftIO (R.readSymbolicLink file) + then hashBlob =<< liftIO (R.readSymbolicLink file') else if isRegularFile s then hashFile file else do qp <- coreQuotePath <$> Annex.getGitConfig - giveup $ decodeBS $ quote qp $ - file <> " is not a regular file" + giveup $ decodeBS $ quote qp file + <> " is not a regular file" let treetype = if isSymbolicLink s then TreeSymlink else if intersectFileModes ownerExecuteMode (fileMode s) /= 0 then TreeExecutable else TreeFile - s' <- liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus file + s' <- liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus file' if maybe True (changed s) s' then do warning $ QuotedPath file <> " changed while it was being added" @@ -206,9 +206,9 @@ addFile smallorlarge file s = do isRegularFile a /= isRegularFile b || isSymbolicLink a /= isSymbolicLink b -start :: DryRun -> SeekInput -> RawFilePath -> AddUnlockedMatcher -> CommandStart +start :: DryRun -> SeekInput -> OsPath -> AddUnlockedMatcher -> CommandStart start dr si file addunlockedmatcher = - liftIO (catchMaybeIO $ R.getSymbolicLinkStatus file) >>= \case + liftIO (catchMaybeIO $ R.getSymbolicLinkStatus $ fromOsPath file) >>= \case Nothing -> stop Just s | not (isRegularFile s) && not (isSymbolicLink s) -> stop @@ -231,11 +231,11 @@ start dr si file addunlockedmatcher = starting "add" (ActionItemTreeFile file) si $ addingExistingLink file key $ skipWhenDryRun dr $ withOtherTmp $ \tmp -> do - let tmpf = tmp P. P.takeFileName file + let tmpf = tmp takeFileName file liftIO $ moveFile file tmpf - ifM (isSymbolicLink <$> liftIO (R.getSymbolicLinkStatus tmpf)) + ifM (isSymbolicLink <$> liftIO (R.getSymbolicLinkStatus $ fromOsPath tmpf)) ( do - liftIO $ R.removeLink tmpf + liftIO $ removeFile tmpf addSymlink file key Nothing next $ cleanup key =<< inAnnex key , do @@ -249,7 +249,7 @@ start dr si file addunlockedmatcher = Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file) next $ addFile Large file s -perform :: RawFilePath -> AddUnlockedMatcher -> CommandPerform +perform :: OsPath -> AddUnlockedMatcher -> CommandPerform perform file addunlockedmatcher = withOtherTmp $ \tmpdir -> do lockingfile <- not <$> addUnlocked addunlockedmatcher (MatchingFile (FileInfo file file Nothing)) @@ -259,7 +259,7 @@ perform file addunlockedmatcher = withOtherTmp $ \tmpdir -> do , hardlinkFileTmpDir = Just tmpdir , checkWritePerms = True } - ld <- lockDown cfg (fromRawFilePath file) + ld <- lockDown cfg file let sizer = keySource <$> ld v <- metered Nothing sizer Nothing $ \_meter meterupdate -> ingestAdd meterupdate ld diff --git a/Command/AddUnused.hs b/Command/AddUnused.hs index 243297c1c6..e883d72aac 100644 --- a/Command/AddUnused.hs +++ b/Command/AddUnused.hs @@ -27,7 +27,7 @@ start :: UnusedMaps -> Int -> CommandStart start = startUnused go (other "bad") (other "tmp") where go n key = do - let file = "unused." <> keyFile key + let file = literalOsPath "unused." <> keyFile key starting "addunused" (ActionItemTreeFile file) (SeekInput [show n]) $ diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index d464dbd048..87a1ae629f 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -177,14 +177,14 @@ checkUrl addunlockedmatcher r o si u = do warning (UnquotedString (show e)) next $ return False go deffile (Right (UrlContents sz mf)) = do - f <- maybe (pure deffile) (sanitizeOrPreserveFilePath o) mf + f <- maybe (pure deffile) (sanitizeOrPreserveFilePath o . fromOsPath) mf let f' = adjustFile o (fromMaybe f (fileOption (downloadOptions o))) void $ commandAction $ startRemote addunlockedmatcher r o si f' u sz go deffile (Right (UrlMulti l)) = case fileOption (downloadOptions o) of Nothing -> forM_ l $ \(u', sz, f) -> do - f' <- sanitizeOrPreserveFilePath o f - let f'' = adjustFile o (deffile f') + f' <- sanitizeOrPreserveFilePath o (fromOsPath f) + let f'' = adjustFile o (fromOsPath (toOsPath deffile toOsPath f')) void $ commandAction $ startRemote addunlockedmatcher r o si f'' u' sz Just f -> case l of [] -> noop @@ -200,14 +200,14 @@ checkUrl addunlockedmatcher r o si u = do startRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> SeekInput -> FilePath -> URLString -> Maybe Integer -> CommandStart startRemote addunlockedmatcher r o si file uri sz = do pathmax <- liftIO $ fileNameLengthLimit "." - let file' = P.joinPath $ map (truncateFilePath pathmax) $ + let file' = toOsPath $ P.joinPath $ map (truncateFilePath pathmax) $ P.splitDirectories (toRawFilePath file) startingAddUrl si uri o $ do showNote $ UnquotedString $ "from " ++ Remote.name r showDestinationFile file' performRemote addunlockedmatcher r o uri file' sz -performRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> URLString -> RawFilePath -> Maybe Integer -> CommandPerform +performRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> URLString -> OsPath -> Maybe Integer -> CommandPerform performRemote addunlockedmatcher r o uri file sz = lookupKey file >>= \case Just k -> adduri k Nothing -> geturi @@ -219,7 +219,7 @@ performRemote addunlockedmatcher r o uri file sz = lookupKey file >>= \case Just n -> (True, n == fromMaybe n (fromKey keySize key), loguri) geturi = next $ isJust <$> downloadRemoteFile addunlockedmatcher r (downloadOptions o) uri file sz -downloadRemoteFile :: AddUnlockedMatcher -> Remote -> DownloadOptions -> URLString -> RawFilePath -> Maybe Integer -> Annex (Maybe Key) +downloadRemoteFile :: AddUnlockedMatcher -> Remote -> DownloadOptions -> URLString -> OsPath -> Maybe Integer -> Annex (Maybe Key) downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd o file $ \canadd -> do let urlkey = Backend.URL.fromUrl uri sz (verifiableOption o) createWorkTreeDirectory (parentDir file) @@ -265,12 +265,12 @@ startWeb addunlockedmatcher o si urlstring = go $ fromMaybe bad $ parseURIPortab f <- sanitizeOrPreserveFilePath o sf if preserveFilenameOption (downloadOptions o) then pure f - else ifM (liftIO $ doesFileExist f <||> doesDirectoryExist f) + else ifM (liftIO $ doesFileExist (toOsPath f) <||> doesDirectoryExist (toOsPath f)) ( pure $ url2file url (pathdepthOption o) pathmax , pure f ) _ -> pure $ url2file url (pathdepthOption o) pathmax - performWeb addunlockedmatcher o urlstring (toRawFilePath file) urlinfo + performWeb addunlockedmatcher o urlstring (toOsPath file) urlinfo sanitizeOrPreserveFilePath :: AddUrlOptions -> FilePath -> Annex FilePath sanitizeOrPreserveFilePath o f @@ -294,12 +294,12 @@ checkPreserveFileNameSecurity f = do qp <- coreQuotePath <$> Annex.getGitConfig giveup $ decodeBS $ quote qp $ "--preserve-filename was used, but the filename (" - <> QuotedPath (toRawFilePath f) + <> QuotedPath (toOsPath f) <> ") has a security problem (" <> d <> "), not adding." -performWeb :: AddUnlockedMatcher -> AddUrlOptions -> URLString -> RawFilePath -> Url.UrlInfo -> CommandPerform +performWeb :: AddUnlockedMatcher -> AddUrlOptions -> URLString -> OsPath -> Url.UrlInfo -> CommandPerform performWeb addunlockedmatcher o url file urlinfo = lookupKey file >>= \case Just k -> addurl k Nothing -> geturl @@ -314,7 +314,7 @@ performWeb addunlockedmatcher o url file urlinfo = lookupKey file >>= \case {- Check that the url exists, and has the same size as the key, - and add it as an url to the key. -} -addUrlChecked :: AddUrlOptions -> URLString -> RawFilePath -> UUID -> (Key -> Annex (Maybe (Bool, Bool, URLString))) -> Key -> CommandPerform +addUrlChecked :: AddUrlOptions -> URLString -> OsPath -> UUID -> (Key -> Annex (Maybe (Bool, Bool, URLString))) -> Key -> CommandPerform addUrlChecked o url file u checkexistssize key = ifM ((elem url <$> getUrls key) <&&> (elem u <$> loggedLocations key)) ( do @@ -340,14 +340,14 @@ addUrlChecked o url file u checkexistssize key = - different file, based on the title of the media. Unless the user - specified fileOption, which then forces using the FilePath. -} -addUrlFile :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> RawFilePath -> Annex (Maybe Key) +addUrlFile :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> OsPath -> Annex (Maybe Key) addUrlFile addunlockedmatcher o url urlinfo file = ifM (Annex.getRead Annex.fast <||> pure (relaxedOption o)) ( nodownloadWeb addunlockedmatcher o url urlinfo file , downloadWeb addunlockedmatcher o url urlinfo file ) -downloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> RawFilePath -> Annex (Maybe Key) +downloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> OsPath -> Annex (Maybe Key) downloadWeb addunlockedmatcher o url urlinfo file = go =<< downloadWith' downloader urlkey webUUID url file where @@ -366,25 +366,25 @@ downloadWeb addunlockedmatcher o url urlinfo file = -- so it's only used when the file contains embedded media. tryyoutubedl tmp backend = youtubeDlFileNameHtmlOnly url >>= \case Right mediafile -> do - liftIO $ liftIO $ removeWhenExistsWith R.removeLink tmp - let f = youtubeDlDestFile o file (toRawFilePath mediafile) + liftIO $ liftIO $ removeWhenExistsWith removeFile tmp + let f = youtubeDlDestFile o file mediafile lookupKey f >>= \case Just k -> alreadyannexed f k Nothing -> dl f Left err -> checkRaw (Just err) o (pure Nothing) (normalfinish tmp backend) where dl dest = withTmpWorkDir mediakey $ \workdir -> do - let cleanuptmp = pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith R.removeLink) + let cleanuptmp = pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith removeFile) dlcmd <- youtubeDlCommand showNote ("using " <> UnquotedString dlcmd) Transfer.notifyTransfer Transfer.Download url $ Transfer.download' webUUID mediakey (AssociatedFile Nothing) Nothing Transfer.noRetry $ \p -> do showDestinationFile dest - youtubeDl url (fromRawFilePath workdir) p >>= \case + youtubeDl url workdir p >>= \case Right (Just mediafile) -> do cleanuptmp checkCanAdd o dest $ \canadd -> do - addWorkTree canadd addunlockedmatcher webUUID mediaurl dest mediakey (Just (toRawFilePath mediafile)) + addWorkTree canadd addunlockedmatcher webUUID mediaurl dest mediakey (Just mediafile) return $ Just mediakey Left msg -> do cleanuptmp @@ -445,10 +445,10 @@ startingAddUrl si url o p = starting "addurl" ai si $ do ai = OnlyActionOn urlkey (ActionItemOther (Just (UnquotedString url))) urlkey = Backend.URL.fromUrl url Nothing (verifiableOption (downloadOptions o)) -showDestinationFile :: RawFilePath -> Annex () +showDestinationFile :: OsPath -> Annex () showDestinationFile file = do showNote ("to " <> QuotedPath file) - maybeShowJSON $ JSONChunk [("file", fromRawFilePath file)] + maybeShowJSON $ JSONChunk [("file", file)] {- The Key should be a dummy key, based on the URL, which is used - for this download, before we can examine the file and find its real key. @@ -459,7 +459,7 @@ showDestinationFile file = do - Downloads the url, sets up the worktree file, and returns the - real key. -} -downloadWith :: CanAddFile -> AddUnlockedMatcher -> (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> RawFilePath -> Annex (Maybe Key) +downloadWith :: CanAddFile -> AddUnlockedMatcher -> (OsPath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> OsPath -> Annex (Maybe Key) downloadWith canadd addunlockedmatcher downloader dummykey u url file = go =<< downloadWith' downloader dummykey u url file where @@ -468,7 +468,7 @@ downloadWith canadd addunlockedmatcher downloader dummykey u url file = {- Like downloadWith, but leaves the dummy key content in - the returned location. -} -downloadWith' :: (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> RawFilePath -> Annex (Maybe (RawFilePath, Backend)) +downloadWith' :: (OsPath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> OsPath -> Annex (Maybe (OsPath, Backend)) downloadWith' downloader dummykey u url file = checkDiskSpaceToGet dummykey Nothing Nothing $ do backend <- chooseBackend file @@ -477,14 +477,14 @@ downloadWith' downloader dummykey u url file = ok <- Transfer.notifyTransfer Transfer.Download url $ \_w -> Transfer.runTransfer t (Just backend) afile Nothing Transfer.stdRetry $ \p -> do createAnnexDirectory (parentDir tmp) - downloader (fromRawFilePath tmp) p + downloader tmp p if ok then return (Just (tmp, backend)) else return Nothing where afile = AssociatedFile (Just file) -finishDownloadWith :: CanAddFile -> AddUnlockedMatcher -> RawFilePath -> Backend -> UUID -> URLString -> RawFilePath -> Annex Key +finishDownloadWith :: CanAddFile -> AddUnlockedMatcher -> OsPath -> Backend -> UUID -> URLString -> OsPath -> Annex Key finishDownloadWith canadd addunlockedmatcher tmp backend u url file = do let source = KeySource { keyFilename = file @@ -502,14 +502,14 @@ addSizeUrlKey urlinfo key = alterKey key $ \d -> d } {- Adds worktree file to the repository. -} -addWorkTree :: CanAddFile -> AddUnlockedMatcher -> UUID -> URLString -> RawFilePath -> Key -> Maybe RawFilePath -> Annex () +addWorkTree :: CanAddFile -> AddUnlockedMatcher -> UUID -> URLString -> OsPath -> Key -> Maybe OsPath -> Annex () addWorkTree _ addunlockedmatcher u url file key mtmp = case mtmp of Nothing -> go Just tmp -> do - s <- liftIO $ R.getSymbolicLinkStatus tmp + s <- liftIO $ R.getSymbolicLinkStatus (fromOsPath tmp) -- Move to final location for large file check. pruneTmpWorkDirBefore tmp $ \_ -> do - createWorkTreeDirectory (P.takeDirectory file) + createWorkTreeDirectory (takeDirectory file) liftIO $ moveFile tmp file largematcher <- largeFilesMatcher large <- checkFileMatcher NoLiveUpdate largematcher file @@ -531,15 +531,15 @@ addWorkTree _ addunlockedmatcher u url file key mtmp = case mtmp of ( do when (isJust mtmp) $ logStatus NoLiveUpdate key InfoPresent - , maybe noop (\tmp -> pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith R.removeLink)) mtmp + , maybe noop (\tmp -> pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith removeFile)) mtmp ) -nodownloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> RawFilePath -> Annex (Maybe Key) +nodownloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> OsPath -> Annex (Maybe Key) nodownloadWeb addunlockedmatcher o url urlinfo file | Url.urlExists urlinfo = if rawOption o then nomedia else youtubeDlFileName url >>= \case - Right mediafile -> usemedia (toRawFilePath mediafile) + Right mediafile -> usemedia mediafile Left err -> checkRaw (Just err) o (pure Nothing) nomedia | otherwise = do warning $ UnquotedString $ "unable to access url: " ++ url @@ -554,12 +554,12 @@ nodownloadWeb addunlockedmatcher o url urlinfo file let mediakey = Backend.URL.fromUrl mediaurl Nothing (verifiableOption o) nodownloadWeb' o addunlockedmatcher mediaurl mediakey dest -youtubeDlDestFile :: DownloadOptions -> RawFilePath -> RawFilePath -> RawFilePath +youtubeDlDestFile :: DownloadOptions -> OsPath -> OsPath -> OsPath youtubeDlDestFile o destfile mediafile | isJust (fileOption o) = destfile - | otherwise = P.takeFileName mediafile + | otherwise = takeFileName mediafile -nodownloadWeb' :: DownloadOptions -> AddUnlockedMatcher -> URLString -> Key -> RawFilePath -> Annex (Maybe Key) +nodownloadWeb' :: DownloadOptions -> AddUnlockedMatcher -> URLString -> Key -> OsPath -> Annex (Maybe Key) nodownloadWeb' o addunlockedmatcher url key file = checkCanAdd o file $ \canadd -> do showDestinationFile file createWorkTreeDirectory (parentDir file) @@ -601,8 +601,8 @@ adjustFile o = addprefix . addsuffix data CanAddFile = CanAddFile -checkCanAdd :: DownloadOptions -> RawFilePath -> (CanAddFile -> Annex (Maybe a)) -> Annex (Maybe a) -checkCanAdd o file a = ifM (isJust <$> (liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus file)) +checkCanAdd :: DownloadOptions -> OsPath -> (CanAddFile -> Annex (Maybe a)) -> Annex (Maybe a) +checkCanAdd o file a = ifM (isJust <$> (liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus (fromOsPath file))) ( do warning $ QuotedPath file <> " already exists; not overwriting" return Nothing diff --git a/Command/CalcKey.hs b/Command/CalcKey.hs index 44aa69b59d..ebe796fa5b 100644 --- a/Command/CalcKey.hs +++ b/Command/CalcKey.hs @@ -32,4 +32,4 @@ run _ _ file = tryNonAsync (genKey ks nullMeterUpdate =<< defaultBackend) >>= \c Left _err -> return False where ks = KeySource file' file' Nothing - file' = toRawFilePath file + file' = toOsPath file diff --git a/Command/Config.hs b/Command/Config.hs index c61b443c3e..e138162cd7 100644 --- a/Command/Config.hs +++ b/Command/Config.hs @@ -152,7 +152,7 @@ seek (ShowOrigin ck@(ConfigKey name) forfile) = commandAction $ | decodeBS name `elem` annexAttrs = case forfile of Just file -> do - v <- checkAttr (decodeBS name) (toRawFilePath file) + v <- checkAttr (decodeBS name) (toOsPath file) if null v then cont else showval "gitattributes" v diff --git a/Command/ContentLocation.hs b/Command/ContentLocation.hs index ea2845899a..7b367b7abe 100644 --- a/Command/ContentLocation.hs +++ b/Command/ContentLocation.hs @@ -9,7 +9,6 @@ module Command.ContentLocation where import Command import Annex.Content -import qualified Utility.RawFilePath as R import qualified Data.ByteString.Char8 as B8 @@ -23,10 +22,13 @@ cmd = noCommit $ noMessages $ run :: () -> SeekInput -> String -> Annex Bool run _ _ p = do let k = fromMaybe (giveup "bad key") $ deserializeKey p - maybe (return False) (\f -> liftIO (B8.putStrLn f) >> return True) + maybe (return False) emit =<< inAnnex' (pure True) Nothing check k where - check f = ifM (liftIO (R.doesPathExist f)) + check f = ifM (liftIO (doesFileExist f)) ( return (Just f) , return Nothing ) + emit f = liftIO $ do + B8.putStrLn $ fromOsPath f + return True diff --git a/Command/Copy.hs b/Command/Copy.hs index f23626c4b2..dce01ddefe 100644 --- a/Command/Copy.hs +++ b/Command/Copy.hs @@ -77,7 +77,7 @@ seek' o fto = startConcurrency (Command.Move.stages fto) $ do {- A copy is just a move that does not delete the source file. - However, auto mode avoids unnecessary copies, and avoids getting or - sending non-preferred content. -} -start :: CopyOptions -> FromToHereOptions -> SeekInput -> RawFilePath -> Key -> CommandStart +start :: CopyOptions -> FromToHereOptions -> SeekInput -> OsPath -> Key -> CommandStart start o fto si file key = do ru <- case fto of FromOrToRemote (ToRemote dest) -> getru dest @@ -90,7 +90,7 @@ start o fto si file key = do where getru dest = Just . Remote.uuid <$> getParsed dest -start' :: LiveUpdate -> CopyOptions -> FromToHereOptions -> SeekInput -> RawFilePath -> Key -> CommandStart +start' :: LiveUpdate -> CopyOptions -> FromToHereOptions -> SeekInput -> OsPath -> Key -> CommandStart start' lu o fto si file key = stopUnless shouldCopy $ Command.Move.start lu fto Command.Move.RemoveNever si file key where diff --git a/Command/DiffDriver.hs b/Command/DiffDriver.hs index 4c398026dc..bfcc917ec7 100644 --- a/Command/DiffDriver.hs +++ b/Command/DiffDriver.hs @@ -119,7 +119,7 @@ fixupReq req@(Req {}) opts = maybe (return r) go (parseLinkTargetOrPointer =<< v) _ -> maybe (return r) go =<< liftIO (isPointerFile f) where - f = toRawFilePath (getfile r) + f = toOsPath (getfile r) go k = do when (getOption opts) $ unlessM (inAnnex k) $ @@ -132,7 +132,7 @@ fixupReq req@(Req {}) opts = si = SeekInput [] af = AssociatedFile (Just f) repoint k = withObjectLoc k $ - pure . setfile r . fromRawFilePath + pure . setfile r . fromOsPath externalDiffer :: String -> [String] -> Differ externalDiffer c ps = \req -> boolSystem c (map Param ps ++ serializeReq req ) diff --git a/Command/Drop.hs b/Command/Drop.hs index 819d61dcc7..94720a6ae4 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -76,7 +76,7 @@ seek o = startConcurrency commandStages $ do where ww = WarnUnmatchLsFiles "drop" -start :: DropOptions -> Maybe Remote -> SeekInput -> RawFilePath -> Key -> CommandStart +start :: DropOptions -> Maybe Remote -> SeekInput -> OsPath -> Key -> CommandStart start o from si file key = start' o from key afile ai si where afile = AssociatedFile (Just file) diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 45663bafcd..6733b42235 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -17,7 +17,6 @@ import qualified Git import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused) import Annex.NumCopies import Annex.Content -import qualified Utility.RawFilePath as R cmd :: Command cmd = withAnnexOptions [jobsOption, jsonOptions] $ @@ -77,8 +76,8 @@ perform from numcopies mincopies key = case from of pcc = Command.Drop.PreferredContentChecked False ud = Command.Drop.DroppingUnused True -performOther :: (Key -> Git.Repo -> RawFilePath) -> Key -> CommandPerform +performOther :: (Key -> Git.Repo -> OsPath) -> Key -> CommandPerform performOther filespec key = do f <- fromRepo $ filespec key - pruneTmpWorkDirBefore f (liftIO . removeWhenExistsWith R.removeLink) + pruneTmpWorkDirBefore f (liftIO . removeWhenExistsWith removeFile) next $ return True diff --git a/Command/EnableTor.hs b/Command/EnableTor.hs index f80c4c06fd..03293d2af4 100644 --- a/Command/EnableTor.hs +++ b/Command/EnableTor.hs @@ -57,7 +57,7 @@ start _os = do Nothing -> giveup "Need user-id parameter." Just userid -> go userid else starting "enable-tor" ai si $ do - gitannex <- liftIO programPath + gitannex <- fromOsPath <$> liftIO programPath let ps = [Param (cmdname cmd), Param (show curruserid)] sucommand <- liftIO $ mkSuCommand gitannex ps cleanenv <- liftIO $ cleanStandaloneEnvironment @@ -145,6 +145,6 @@ checkHiddenService = bracket setup cleanup go haslistener sockfile = catchBoolIO $ do soc <- S.socket S.AF_UNIX S.Stream S.defaultProtocol - S.connect soc (S.SockAddrUnix sockfile) + S.connect soc (S.SockAddrUnix $ fromOsPath sockfile) S.close soc return True diff --git a/Command/ExamineKey.hs b/Command/ExamineKey.hs index 439472a47e..1caa4224db 100644 --- a/Command/ExamineKey.hs +++ b/Command/ExamineKey.hs @@ -39,7 +39,7 @@ optParser :: Parser ExamineOptions optParser = ExamineOptions <$> optional parseFormatOption <*> (fmap (DeferredParse . tobackend) <$> migrateopt) - <*> (AssociatedFile <$> fileopt) + <*> (AssociatedFile . fmap stringToOsPath <$> fileopt) where fileopt = optional $ strOption ( long "filename" <> metavar paramFile @@ -59,8 +59,8 @@ run o _ input = do let objectpointer = formatPointer k isterminal <- liftIO $ checkIsTerminal stdout showFormatted isterminal (format o) (serializeKey' k) $ - [ ("objectpath", fromRawFilePath objectpath) - , ("objectpointer", fromRawFilePath objectpointer) + [ ("objectpath", fromOsPath objectpath) + , ("objectpointer", decodeBS objectpointer) ] ++ formatVars k af return True where @@ -71,7 +71,7 @@ run o _ input = do ik = fromMaybe (giveup "bad key") (deserializeKey' ikb) af = if B.null ifb' then associatedFile o - else AssociatedFile (Just ifb') + else AssociatedFile (Just (toOsPath ifb')) getkey = case migrateToBackend o of Nothing -> pure ik diff --git a/Command/Export.hs b/Command/Export.hs index a8bdfab5ab..b4acaac401 100644 --- a/Command/Export.hs +++ b/Command/Export.hs @@ -78,8 +78,8 @@ optParser _ = ExportOptions -- To handle renames which swap files, the exported file is first renamed -- to a stable temporary name based on the key. exportTempName :: Key -> ExportLocation -exportTempName ek = mkExportLocation $ toRawFilePath $ - ".git-annex-tmp-content-" ++ serializeKey ek +exportTempName ek = mkExportLocation $ + literalOsPath ".git-annex-tmp-content-" <> toOsPath (serializeKey'' ek) seek :: ExportOptions -> CommandSeek seek o = startConcurrency commandStages $ do @@ -312,12 +312,11 @@ performExport r srcrs db ek af contentsha loc allfilledvar = do sent <- tryNonAsync $ if not (isGitShaKey ek) then tryrenameannexobject $ sendannexobject -- Sending a non-annexed file. - else withTmpFile (toOsPath "export") $ \tmp h -> do + else withTmpFile (literalOsPath "export") $ \tmp h -> do b <- catObject contentsha liftIO $ L.hPut h b liftIO $ hClose h - Remote.action $ - storer (fromRawFilePath (fromOsPath tmp)) ek loc nullMeterUpdate + Remote.action $ storer tmp ek loc nullMeterUpdate let failedsend = liftIO $ modifyMVar_ allfilledvar (pure . const (AllFilled False)) case sent of Right True -> next $ cleanupExport r db ek loc True diff --git a/Command/FilterBranch.hs b/Command/FilterBranch.hs index 6c565c5d29..6f79d47ad6 100644 --- a/Command/FilterBranch.hs +++ b/Command/FilterBranch.hs @@ -27,13 +27,11 @@ import Git.Env import Git.UpdateIndex import qualified Git.LsTree as LsTree import qualified Git.Branch as Git -import Utility.RawFilePath import qualified Data.Map as M import qualified Data.Set as S import qualified Data.ByteString.Lazy as L import Data.ByteString.Builder -import qualified System.FilePath.ByteString as P cmd :: Command cmd = noMessages $ withAnnexOptions [annexedMatchingOptions] $ @@ -120,10 +118,10 @@ mkUUIDMatcher' sameasmap l = \u -> seek :: FilterBranchOptions -> CommandSeek seek o = withOtherTmp $ \tmpdir -> do - let tmpindex = tmpdir P. "index" + let tmpindex = tmpdir literalOsPath "index" gc <- Annex.getGitConfig tmpindexrepo <- Annex.inRepo $ \r -> - addGitEnv r indexEnv (fromRawFilePath tmpindex) + addGitEnv r indexEnv (fromOsPath tmpindex) withUpdateIndex tmpindexrepo $ \h -> do keyinfomatcher <- mkUUIDMatcher (keyInformation o) repoconfigmatcher <- mkUUIDMatcher (repoConfig o) @@ -186,7 +184,7 @@ seek o = withOtherTmp $ \tmpdir -> do -- Commit the temporary index, and output the result. t <- liftIO $ Git.writeTree tmpindexrepo - liftIO $ removeWhenExistsWith removeLink tmpindex + liftIO $ removeWhenExistsWith removeFile tmpindex cmode <- annexCommitMode <$> Annex.getGitConfig cmessage <- Annex.Branch.commitMessage c <- inRepo $ Git.commitTree cmode [cmessage] [] t diff --git a/Command/FilterProcess.hs b/Command/FilterProcess.hs index ff20dd7268..023d165d29 100644 --- a/Command/FilterProcess.hs +++ b/Command/FilterProcess.hs @@ -36,7 +36,7 @@ seek _ = liftIO longRunningFilterProcessHandshake >>= \case go Nothing -> return () -smudge :: FilePath -> Annex () +smudge :: OsPath -> Annex () smudge file = do {- The whole git file content is necessarily buffered in memory, - because we have to consume everything git is sending before @@ -49,7 +49,7 @@ smudge file = do - See Command.Smudge.smudge for details of how this works. -} liftIO $ respondFilterRequest b -clean :: FilePath -> Annex () +clean :: OsPath -> Annex () clean file = do {- We have to consume everything git is sending before we can - respond to it. But it can be an arbitrarily large file, @@ -82,7 +82,7 @@ clean file = do -- read from the file. It may be less expensive to incrementally -- hash the content provided by git, but Backend does not currently -- have an interface to do so. - Command.Smudge.clean' (toRawFilePath file) + Command.Smudge.clean' file (parseLinkTargetOrPointer' b) passthrough discardreststdin diff --git a/Command/Find.hs b/Command/Find.hs index 3a1fabe5e2..2bd7debc64 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -88,9 +88,9 @@ contentPresentUnlessLimited s = do else Just True } -start :: FindOptions -> IsTerminal -> SeekInput -> RawFilePath -> Key -> CommandStart +start :: FindOptions -> IsTerminal -> SeekInput -> OsPath -> Key -> CommandStart start o isterminal _ file key = startingCustomOutput key $ do - showFormatted isterminal (formatOption o) file + showFormatted isterminal (formatOption o) (fromOsPath file) (formatVars key (AssociatedFile (Just file))) next $ return True @@ -113,14 +113,14 @@ showFormatted (IsTerminal isterminal) format unformatted vars = formatVars :: Key -> AssociatedFile -> [(String, String)] formatVars key (AssociatedFile af) = - (maybe id (\f l -> (("file", fromRawFilePath f) : l)) af) + (maybe id (\f l -> (("file", fromOsPath f) : l)) af) [ ("key", serializeKey key) , ("backend", decodeBS $ formatKeyVariety $ fromKey keyVariety key) , ("bytesize", size show) , ("humansize", size $ roughSize storageUnits True) , ("keyname", decodeBS $ S.fromShort $ fromKey keyName key) - , ("hashdirlower", fromRawFilePath $ hashDirLower def key) - , ("hashdirmixed", fromRawFilePath $ hashDirMixed def key) + , ("hashdirlower", fromOsPath $ hashDirLower def key) + , ("hashdirmixed", fromOsPath $ hashDirMixed def key) , ("mtime", whenavail show $ fromKey keyMtime key) ] where diff --git a/Command/Get.hs b/Command/Get.hs index f9a48733af..880aa03198 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -55,7 +55,7 @@ seek o = startConcurrency transferStages $ do where ww = WarnUnmatchLsFiles "get" -start :: GetOptions -> Maybe Remote -> SeekInput -> RawFilePath -> Key -> CommandStart +start :: GetOptions -> Maybe Remote -> SeekInput -> OsPath -> Key -> CommandStart start o from si file key = do lu <- prepareLiveUpdate Nothing key AddingKey start' lu (expensivecheck lu) from key afile ai si diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index 8adeb9a487..df1537fb65 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -24,7 +24,6 @@ import Data.Time.LocalTime import Control.Concurrent.STM import qualified Data.Text as T import qualified Data.Text.Encoding as TE -import qualified System.FilePath.ByteString as P import qualified Data.ByteString as B import Command @@ -158,7 +157,7 @@ getFeed o url st = | scrapeOption o = scrape | otherwise = get - get = withTmpFile (toOsPath "feed") $ \tmpf h -> do + get = withTmpFile (literalOsPath "feed") $ \tmpf h -> do let tmpf' = fromRawFilePath $ fromOsPath tmpf liftIO $ hClose h ifM (downloadFeed url tmpf') @@ -270,7 +269,7 @@ downloadFeed :: URLString -> FilePath -> Annex Bool downloadFeed url f | Url.parseURIRelaxed url == Nothing = giveup "invalid feed url" | otherwise = Url.withUrlOptions $ - Url.download nullMeterUpdate Nothing url f + Url.download nullMeterUpdate Nothing url (toOsPath f) startDownload :: AddUnlockedMatcher -> ImportFeedOptions -> Cache -> TMVar Bool -> ToDownload -> CommandStart startDownload addunlockedmatcher opts cache cv todownload = case location todownload of @@ -315,15 +314,15 @@ startDownload addunlockedmatcher opts cache cv todownload = case location todown ifM (useYoutubeDl (downloadOptions opts) <&&> youtubeDlSupported linkurl) ( startUrlDownload cv todownload linkurl $ withTmpWorkDir mediakey $ \workdir -> do - dl <- youtubeDl linkurl (fromRawFilePath workdir) nullMeterUpdate + dl <- youtubeDl linkurl workdir nullMeterUpdate case dl of Right (Just mediafile) -> do - let ext = case takeExtension mediafile of + let ext = case fromOsPath (takeExtension mediafile) of [] -> ".m" s -> s runDownload todownload linkurl ext cache cv $ \f -> checkCanAdd (downloadOptions opts) f $ \canadd -> do - addWorkTree canadd addunlockedmatcher webUUID mediaurl f mediakey (Just (toRawFilePath mediafile)) + addWorkTree canadd addunlockedmatcher webUUID mediaurl f mediakey (Just mediafile) return (Just [mediakey]) -- youtube-dl didn't support it, so -- download it as if the link were @@ -352,16 +351,16 @@ startDownload addunlockedmatcher opts cache cv todownload = case location todown ) downloadEnclosure :: AddUnlockedMatcher -> ImportFeedOptions -> Cache -> TMVar Bool -> ToDownload -> URLString -> CommandPerform -downloadEnclosure addunlockedmatcher opts cache cv todownload url = - runDownload todownload url (takeWhile (/= '?') $ takeExtension url) cache cv $ \f -> do - let f' = fromRawFilePath f +downloadEnclosure addunlockedmatcher opts cache cv todownload url = + let extension = takeWhile (/= '?') $ fromOsPath $ takeExtension $ toOsPath url + in runDownload todownload url extension cache cv $ \f -> do r <- checkClaimingUrl (downloadOptions opts) url if Remote.uuid r == webUUID || rawOption (downloadOptions opts) then checkRaw (Just url) (downloadOptions opts) (pure Nothing) $ do let dlopts = (downloadOptions opts) -- force using the filename -- chosen here - { fileOption = Just f' + { fileOption = Just (fromOsPath f) -- don't use youtube-dl , rawOption = True } @@ -385,7 +384,7 @@ downloadEnclosure addunlockedmatcher opts cache cv todownload url = downloadRemoteFile addunlockedmatcher r (downloadOptions opts) url f sz Right (UrlMulti l) -> do kl <- forM l $ \(url', sz, subf) -> - let dest = f P. toRawFilePath (sanitizeFilePath subf) + let dest = f toOsPath (sanitizeFilePath (fromOsPath subf)) in downloadRemoteFile addunlockedmatcher r (downloadOptions opts) url' dest sz return $ Just $ if all isJust kl then catMaybes kl @@ -397,7 +396,7 @@ runDownload -> String -> Cache -> TMVar Bool - -> (RawFilePath -> Annex (Maybe [Key])) + -> (OsPath -> Annex (Maybe [Key])) -> CommandPerform runDownload todownload url extension cache cv getter = do dest <- makeunique (1 :: Integer) $ @@ -406,7 +405,7 @@ runDownload todownload url extension cache cv getter = do Nothing -> do recordsuccess next $ return True - Just f -> getter (toRawFilePath f) >>= \case + Just f -> getter f >>= \case Just ks -- Download problem. | null ks -> do @@ -440,7 +439,7 @@ runDownload todownload url extension cache cv getter = do - to be re-downloaded. -} makeunique n file = ifM alreadyexists ( ifM forced - ( lookupKey (toRawFilePath f) >>= \case + ( lookupKey f >>= \case Just k -> checksameurl k Nothing -> tryanother , tryanother @@ -449,12 +448,12 @@ runDownload todownload url extension cache cv getter = do ) where f = if n < 2 - then file + then toOsPath file else - let (d, base) = splitFileName file - in d show n ++ "_" ++ base + let (d, base) = splitFileName (toOsPath file) + in d toOsPath (show n ++ "_") <> base tryanother = makeunique (n + 1) file - alreadyexists = liftIO $ isJust <$> catchMaybeIO (R.getSymbolicLinkStatus (toRawFilePath f)) + alreadyexists = liftIO $ isJust <$> catchMaybeIO (R.getSymbolicLinkStatus (fromOsPath f)) checksameurl k = ifM (elem url . map fst . map getDownloader <$> getUrls k) ( return Nothing , tryanother @@ -609,10 +608,10 @@ feedProblem url message = ifM (checkFeedBroken url) - least 23 hours. -} checkFeedBroken :: URLString -> Annex Bool checkFeedBroken url = checkFeedBroken' url =<< feedState url -checkFeedBroken' :: URLString -> RawFilePath -> Annex Bool +checkFeedBroken' :: URLString -> OsPath -> Annex Bool checkFeedBroken' url f = do prev <- maybe Nothing readish - <$> liftIO (catchMaybeIO $ readFile (fromRawFilePath f)) + <$> liftIO (catchMaybeIO $ readFile (fromOsPath f)) now <- liftIO getCurrentTime case prev of Nothing -> do @@ -628,10 +627,9 @@ checkFeedBroken' url f = do clearFeedProblem :: URLString -> Annex () clearFeedProblem url = - void $ liftIO . tryIO . removeFile . fromRawFilePath - =<< feedState url + void $ liftIO . tryIO . removeFile =<< feedState url -feedState :: URLString -> Annex RawFilePath +feedState :: URLString -> Annex OsPath feedState url = fromRepo $ gitAnnexFeedState $ fromUrl url Nothing False {- The feed library parses the feed to Text, and does not use the diff --git a/Command/Mirror.hs b/Command/Mirror.hs index 7f5be7ae54..8116dcf0ce 100644 --- a/Command/Mirror.hs +++ b/Command/Mirror.hs @@ -57,7 +57,7 @@ seek o = startConcurrency stages $ , usesLocationLog = True } -start :: MirrorOptions -> SeekInput -> RawFilePath -> Key -> CommandStart +start :: MirrorOptions -> SeekInput -> OsPath -> Key -> CommandStart start o si file k = startKey o afile (si, k, ai) where afile = AssociatedFile (Just file) diff --git a/Command/Move.hs b/Command/Move.hs index 89c5556b78..120cb4f598 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -94,7 +94,7 @@ stages ToHere = transferStages stages (FromRemoteToRemote _ _) = transferStages stages (FromAnywhereToRemote _) = transferStages -start :: LiveUpdate -> FromToHereOptions -> RemoveWhen -> SeekInput -> RawFilePath -> Key -> CommandStart +start :: LiveUpdate -> FromToHereOptions -> RemoveWhen -> SeekInput -> OsPath -> Key -> CommandStart start lu fromto removewhen si f k = start' lu fromto removewhen afile si k ai where afile = AssociatedFile (Just f) diff --git a/Command/Whereis.hs b/Command/Whereis.hs index b91c44bb1c..919d96b322 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -67,7 +67,7 @@ seek o = do where ww = WarnUnmatchLsFiles "whereis" -start :: WhereisOptions -> M.Map UUID Remote -> SeekInput -> RawFilePath -> Key -> CommandStart +start :: WhereisOptions -> M.Map UUID Remote -> SeekInput -> OsPath -> Key -> CommandStart start o remotemap si file key = startKeys o remotemap (si, key, mkActionItem (key, afile)) where diff --git a/Git/CheckIgnore.hs b/Git/CheckIgnore.hs index 46a5b25cf3..78811e1ef0 100644 --- a/Git/CheckIgnore.hs +++ b/Git/CheckIgnore.hs @@ -52,11 +52,11 @@ checkIgnoreStop :: CheckIgnoreHandle -> IO () checkIgnoreStop = void . tryIO . CoProcess.stop {- Returns True if a file is ignored. -} -checkIgnored :: CheckIgnoreHandle -> RawFilePath -> IO Bool +checkIgnored :: CheckIgnoreHandle -> OsPath -> IO Bool checkIgnored h file = CoProcess.query h send (receive "") where send to = do - B.hPutStr to $ file `B.snoc` 0 + B.hPutStr to $ fromOsPath file `B.snoc` 0 hFlush to receive c from = do s <- hGetSomeString from 1024 @@ -68,4 +68,4 @@ checkIgnored h file = CoProcess.query h send (receive "") parse s = case segment (== '\0') s of (_source:_line:pattern:_pathname:_eol:[]) -> Just $ not $ null pattern _ -> Nothing - eofError = ioError $ mkIOError userErrorType "git cat-file EOF" Nothing Nothing + eofError = ioError $ mkIOError userErrorType "git check-ignore EOF" Nothing Nothing diff --git a/Git/FilterProcess.hs b/Git/FilterProcess.hs index 7e04e46118..678f11f837 100644 --- a/Git/FilterProcess.hs +++ b/Git/FilterProcess.hs @@ -130,7 +130,7 @@ longRunningFilterProcessHandshake = -- Delay capability is not implemented, so filter it out. filtercapabilities = filter (`elem` [Capability "smudge", Capability "clean"]) -data FilterRequest = Smudge FilePath | Clean FilePath +data FilterRequest = Smudge OsPath | Clean OsPath deriving (Show, Eq) {- Waits for the next FilterRequest to be received. Does not read @@ -143,8 +143,8 @@ getFilterRequest = do let cs = mapMaybe decodeConfigValue ps case (extractConfigValue cs "command", extractConfigValue cs "pathname") of (Just command, Just pathname) - | command == "smudge" -> return $ Just $ Smudge pathname - | command == "clean" -> return $ Just $ Clean pathname + | command == "smudge" -> return $ Just $ Smudge $ toOsPath pathname + | command == "clean" -> return $ Just $ Clean $ toOsPath pathname | otherwise -> return Nothing _ -> return Nothing diff --git a/Git/Quote.hs b/Git/Quote.hs index ea9d7e55a3..24b616de4e 100644 --- a/Git/Quote.hs +++ b/Git/Quote.hs @@ -7,6 +7,7 @@ -} {-# LANGUAGE OverloadedStrings, TypeSynonymInstances #-} +{-# LANGUAGE CPP #-} module Git.Quote ( unquote, @@ -71,6 +72,12 @@ instance Quoteable RawFilePath where noquote = id +#ifdef WITH_OSPATH +instance Quoteable OsPath where + quote qp f = quote qp (fromOsPath f :: RawFilePath) + noquote = fromOsPath +#endif + -- Allows building up a string that contains paths, which will get quoted. -- With OverloadedStrings, strings are passed through without quoting. -- Eg: QuotedPath f <> ": not found" diff --git a/Utility/Aeson.hs b/Utility/Aeson.hs index e03a707051..5de512d314 100644 --- a/Utility/Aeson.hs +++ b/Utility/Aeson.hs @@ -8,6 +8,7 @@ -} {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-} +{-# LANGUAGE CPP #-} module Utility.Aeson ( module X, @@ -32,6 +33,9 @@ import qualified Data.Vector import Prelude import Utility.FileSystemEncoding +#ifdef WITH_OSPATH +import Utility.OsPath +#endif -- | Use this instead of Data.Aeson.encode to make sure that the -- below String instance is used. @@ -60,6 +64,11 @@ instance ToJSON' String where instance ToJSON' S.ByteString where toJSON' = toJSON . packByteString +#ifdef WITH_OSPATH +instance ToJSON' OsPath where + toJSON' p = toJSON' (fromOsPath p :: S.ByteString) +#endif + -- | Pack a String to Text, correctly handling the filesystem encoding. -- -- Use this instead of Data.Text.pack. diff --git a/Utility/HtmlDetect.hs b/Utility/HtmlDetect.hs index cf83e52f08..e1739a94e9 100644 --- a/Utility/HtmlDetect.hs +++ b/Utility/HtmlDetect.hs @@ -14,7 +14,6 @@ module Utility.HtmlDetect ( import Author import qualified Utility.FileIO as F -import Utility.RawFilePath import Utility.OsPath import Text.HTML.TagSoup @@ -60,8 +59,8 @@ isHtmlBs = isHtml . B8.unpack -- It would be equivalent to use isHtml <$> readFile file, -- but since that would not read all of the file, the handle -- would remain open until it got garbage collected sometime later. -isHtmlFile :: RawFilePath -> IO Bool -isHtmlFile file = F.withFile (toOsPath file) ReadMode $ \h -> +isHtmlFile :: OsPath -> IO Bool +isHtmlFile file = F.withFile file ReadMode $ \h -> isHtmlBs <$> B.hGet h htmlPrefixLength -- | How much of the beginning of a html document is needed to detect it.