diff --git a/Annex/CheckIgnore.hs b/Annex/CheckIgnore.hs index e3252d8cd9..42e635b667 100644 --- a/Annex/CheckIgnore.hs +++ b/Annex/CheckIgnore.hs @@ -22,7 +22,7 @@ import Annex.Concurrent.Utility newtype CheckGitIgnore = CheckGitIgnore Bool -checkIgnored :: CheckGitIgnore -> FilePath -> Annex Bool +checkIgnored :: CheckGitIgnore -> RawFilePath -> Annex Bool checkIgnored (CheckGitIgnore False) _ = pure False checkIgnored (CheckGitIgnore True) file = ifM (Annex.getState Annex.force) diff --git a/Annex/Content/PointerFile.hs b/Annex/Content/PointerFile.hs index 7c7881e0cb..e13f2ad1ae 100644 --- a/Annex/Content/PointerFile.hs +++ b/Annex/Content/PointerFile.hs @@ -64,12 +64,13 @@ depopulatePointerFile key file = do secureErase file liftIO $ removeWhenExistsWith R.removeLink file ic <- replaceWorkTreeFile file' $ \tmp -> do - liftIO $ writePointerFile (toRawFilePath tmp) key mode + let tmp' = toRawFilePath tmp + liftIO $ writePointerFile tmp' key mode #if ! defined(mingw32_HOST_OS) -- Don't advance mtime; this avoids unncessary re-smudging -- by git in some cases. liftIO $ maybe noop - (\t -> touch tmp t False) + (\t -> touch tmp' t False) (fmap modificationTimeHiRes st) #endif withTSDelta (liftIO . genInodeCache (toRawFilePath tmp)) diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs index 5f6ec948f7..c83af52f91 100644 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -61,7 +61,7 @@ data LockedDown = LockedDown data LockDownConfig = LockDownConfig { lockingFile :: Bool -- ^ write bit removed during lock down - , hardlinkFileTmpDir :: Maybe FilePath + , hardlinkFileTmpDir :: Maybe RawFilePath -- ^ hard link to temp directory } deriving (Show) @@ -109,7 +109,7 @@ lockDown' cfg file = tryIO $ ifM crippledFileSystem when (lockingFile cfg) $ freezeContent file withTSDelta $ \delta -> liftIO $ do - (tmpfile, h) <- openTempFile tmpdir $ + (tmpfile, h) <- openTempFile (fromRawFilePath tmpdir) $ relatedTemplate $ "ingest-" ++ takeFileName file hClose h removeWhenExistsWith removeLink tmpfile @@ -139,7 +139,7 @@ ingestAdd' ci meterupdate ld@(Just (LockedDown cfg source)) mk = do Just k -> do let f = keyFilename source if lockingFile cfg - then addLink ci (fromRawFilePath f) k mic + then addLink ci f k mic else do mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus (contentLocation source) @@ -272,10 +272,10 @@ restoreFile file key e = do throwM e {- Creates the symlink to the annexed content, returns the link target. -} -makeLink :: FilePath -> Key -> Maybe InodeCache -> Annex LinkTarget -makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do - l <- calcRepo $ gitAnnexLink (toRawFilePath file) key - replaceWorkTreeFile file $ makeAnnexLink l . toRawFilePath +makeLink :: RawFilePath -> Key -> Maybe InodeCache -> Annex LinkTarget +makeLink file key mcache = flip catchNonAsync (restoreFile file' key) $ do + l <- calcRepo $ gitAnnexLink file key + replaceWorkTreeFile file' $ makeAnnexLink l . toRawFilePath -- touch symlink to have same time as the original file, -- as provided in the InodeCache @@ -284,6 +284,8 @@ makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do Nothing -> noop return l + where + file' = fromRawFilePath file {- Creates the symlink to the annexed content, and stages it in git. - @@ -294,15 +296,15 @@ makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do - Also, using git add allows it to skip gitignored files, unless forced - to include them. -} -addLink :: CheckGitIgnore -> FilePath -> Key -> Maybe InodeCache -> Annex () +addLink :: CheckGitIgnore -> RawFilePath -> Key -> Maybe InodeCache -> Annex () addLink ci file key mcache = ifM (coreSymlinks <$> Annex.getGitConfig) ( do _ <- makeLink file key mcache ps <- gitAddParams ci - Annex.Queue.addCommand "add" (ps++[Param "--"]) [file] + Annex.Queue.addCommand "add" (ps++[Param "--"]) [fromRawFilePath file] , do l <- makeLink file key mcache - addAnnexLink l (toRawFilePath file) + addAnnexLink l file ) {- Parameters to pass to git add, forcing addition of ignored files. @@ -339,17 +341,17 @@ addUnlocked matcher mi = - - When the content of the key is not accepted into the annex, returns False. -} -addAnnexedFile :: CheckGitIgnore -> AddUnlockedMatcher -> FilePath -> Key -> Maybe FilePath -> Annex Bool +addAnnexedFile :: CheckGitIgnore -> AddUnlockedMatcher -> RawFilePath -> Key -> Maybe RawFilePath -> Annex Bool addAnnexedFile ci matcher file key mtmp = ifM (addUnlocked matcher mi) ( do mode <- maybe (pure Nothing) - (\tmp -> liftIO $ catchMaybeIO $ fileMode <$> getFileStatus tmp) + (\tmp -> liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus tmp) mtmp - stagePointerFile file' mode =<< hashPointerFile key - Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file') + stagePointerFile file mode =<< hashPointerFile key + Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file) case mtmp of - Just tmp -> ifM (moveAnnex key (toRawFilePath tmp)) + Just tmp -> ifM (moveAnnex key tmp) ( linkunlocked mode >> return True , writepointer mode >> return False ) @@ -360,19 +362,19 @@ addAnnexedFile ci matcher file key mtmp = ifM (addUnlocked matcher mi) , do addLink ci file key Nothing case mtmp of - Just tmp -> moveAnnex key (toRawFilePath tmp) + Just tmp -> moveAnnex key tmp Nothing -> return True ) where mi = case mtmp of Just tmp -> MatchingFile $ FileInfo - { contentFile = Just (toRawFilePath tmp) - , matchFile = file' + { contentFile = Just tmp + , matchFile = file } -- Provide as much info as we can without access to the -- file's content. Nothing -> MatchingInfo $ ProvidedInfo - { providedFilePath = file' + { providedFilePath = file , providedKey = Just key , providedFileSize = fromMaybe 0 $ keySize `fromKey` key @@ -380,10 +382,8 @@ addAnnexedFile ci matcher file key mtmp = ifM (addUnlocked matcher mi) , providedMimeEncoding = Nothing } - linkunlocked mode = linkFromAnnex key file' mode >>= \case - LinkAnnexFailed -> liftIO $ - writePointerFile file' key mode + linkunlocked mode = linkFromAnnex key file mode >>= \case + LinkAnnexFailed -> liftIO $ writepointer mode _ -> return () - writepointer mode = liftIO $ writePointerFile file' key mode - - file' = toRawFilePath file + + writepointer mode = liftIO $ writePointerFile file key mode diff --git a/Annex/Locations.hs b/Annex/Locations.hs index ffb9763f9d..058fd109d9 100644 --- a/Annex/Locations.hs +++ b/Annex/Locations.hs @@ -362,19 +362,19 @@ gitAnnexFsckResultsLog u r = {- .git/annex/smudge.log is used to log smudges worktree files that need to - be updated. -} -gitAnnexSmudgeLog :: Git.Repo -> FilePath -gitAnnexSmudgeLog r = fromRawFilePath $ gitAnnexDir r P. "smudge.log" +gitAnnexSmudgeLog :: Git.Repo -> RawFilePath +gitAnnexSmudgeLog r = gitAnnexDir r P. "smudge.log" gitAnnexSmudgeLock :: Git.Repo -> RawFilePath gitAnnexSmudgeLock r = gitAnnexDir r P. "smudge.lck" {- .git/annex/move.log is used to log moves that are in progress, - to better support resuming an interrupted move. -} -gitAnnexMoveLog :: Git.Repo -> FilePath -gitAnnexMoveLog r = fromRawFilePath $ gitAnnexDir r P. "move.log" +gitAnnexMoveLog :: Git.Repo -> RawFilePath +gitAnnexMoveLog r = gitAnnexDir r P. "move.log" -gitAnnexMoveLock :: Git.Repo -> FilePath -gitAnnexMoveLock r = fromRawFilePath $ gitAnnexDir r P. "move.lck" +gitAnnexMoveLock :: Git.Repo -> RawFilePath +gitAnnexMoveLock r = gitAnnexDir r P. "move.lck" {- .git/annex/export/ is used to store information about - exports to special remotes. -} diff --git a/Annex/Perms.hs b/Annex/Perms.hs index ffeb910bb2..26e30a1470 100644 --- a/Annex/Perms.hs +++ b/Annex/Perms.hs @@ -143,7 +143,7 @@ freezeContent file = unlessM crippledFileSystem $ removeModes writeModes . addModes [ownerReadMode] -isContentWritePermOk :: FilePath -> Annex Bool +isContentWritePermOk :: RawFilePath -> Annex Bool isContentWritePermOk file = ifM crippledFileSystem ( return True , withShared go @@ -153,7 +153,7 @@ isContentWritePermOk file = ifM crippledFileSystem go AllShared = want writeModes go _ = return True want wantmode = - liftIO (catchMaybeIO $ fileMode <$> getFileStatus file) >>= return . \case + liftIO (catchMaybeIO $ fileMode <$> R.getFileStatus file) >>= return . \case Nothing -> True Just havemode -> havemode == combineModes (havemode:wantmode) diff --git a/Command/Add.hs b/Command/Add.hs index 6aecce8d0c..3b411c8f10 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -81,8 +81,9 @@ seek o = startConcurrency commandStages $ do annexdotfiles <- getGitConfigVal annexDotFiles let gofile (si, file) = case largeFilesOverride o of Nothing -> - let file' = fromRawFilePath file - in ifM (pure (annexdotfiles || not (dotfile file')) <&&> (checkFileMatcher largematcher file' <||> Annex.getState Annex.force)) + ifM (pure (annexdotfiles || not (dotfile file)) + <&&> (checkFileMatcher largematcher file + <||> Annex.getState Annex.force)) ( start o si file addunlockedmatcher , ifM (annexAddSmallFiles <$> Annex.getGitConfig) ( startSmall o si file @@ -128,20 +129,19 @@ startSmallOverridden o si file = addSmallOverridden :: AddOptions -> RawFilePath -> Annex Bool addSmallOverridden o file = do showNote "adding content to git repository" - let file' = fromRawFilePath file - s <- liftIO $ getSymbolicLinkStatus file' + s <- liftIO $ R.getSymbolicLinkStatus file if not (isRegularFile s) then addFile (checkGitIgnoreOption o) file else do -- Can't use addFile because the clean filter will -- honor annex.largefiles and it has been overridden. -- Instead, hash the file and add to the index. - sha <- hashFile file' + sha <- hashFile file let ty = if isExecutable (fileMode s) then TreeExecutable else TreeFile Annex.Queue.addUpdateIndex =<< - inRepo (Git.UpdateIndex.stageFile sha ty file') + inRepo (Git.UpdateIndex.stageFile sha ty (fromRawFilePath file)) return True addFile :: CheckGitIgnore -> RawFilePath -> Annex Bool @@ -172,7 +172,7 @@ start o si file addunlockedmatcher = do fixuplink key = starting "add" (ActionItemWorkTreeFile file) si $ do -- the annexed symlink is present but not yet added to git liftIO $ removeFile (fromRawFilePath file) - addLink (checkGitIgnoreOption o) (fromRawFilePath file) key Nothing + addLink (checkGitIgnoreOption o) file key Nothing next $ cleanup key =<< inAnnex key fixuppointer key = starting "add" (ActionItemWorkTreeFile file) si $ do diff --git a/Command/AddUnused.hs b/Command/AddUnused.hs index 23ff4aed00..828e53d8a3 100644 --- a/Command/AddUnused.hs +++ b/Command/AddUnused.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Command.AddUnused where import Logs.Location @@ -33,7 +35,7 @@ perform key = next $ do addLink (CheckGitIgnore False) file key Nothing return True where - file = "unused." ++ fromRawFilePath (keyFile key) + file = "unused." <> keyFile key {- The content is not in the annex, but in another directory, and - it seems better to error out, rather than moving bad/tmp content into diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index d39e9cd583..90026e536b 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -7,8 +7,6 @@ module Command.AddUrl where -import Network.URI - import Command import Backend import qualified Annex @@ -32,8 +30,12 @@ import Logs.Location import Utility.Metered import Utility.HtmlDetect import Utility.Path.Max +import qualified Utility.RawFilePath as R import qualified Annex.Transfer as Transfer +import Network.URI +import qualified System.FilePath.ByteString as P + cmd :: Command cmd = notBareRepo $ withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption] $ command "addurl" SectionCommon "add urls to annex" @@ -182,7 +184,7 @@ performRemote addunlockedmatcher r o uri file sz = ifAnnexed (toRawFilePath file downloadRemoteFile :: AddUnlockedMatcher -> Remote -> DownloadOptions -> URLString -> FilePath -> Maybe Integer -> Annex (Maybe Key) downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd o file $ \canadd -> do let urlkey = Backend.URL.fromUrl uri sz - createWorkTreeDirectory (parentDir file) + createWorkTreeDirectory (parentDir (toRawFilePath file)) ifM (Annex.getState Annex.fast <||> pure (relaxedOption o)) ( do addWorkTree canadd addunlockedmatcher (Remote.uuid r) loguri file urlkey Nothing @@ -313,7 +315,7 @@ downloadWeb addunlockedmatcher o url urlinfo file = ) normalfinish tmp = checkCanAdd o file $ \canadd -> do showDestinationFile file - createWorkTreeDirectory (parentDir file) + createWorkTreeDirectory (parentDir (toRawFilePath file)) Just <$> finishDownloadWith canadd addunlockedmatcher tmp webUUID url file -- Ask youtube-dl what filename it will download first, -- so it's only used when the file contains embedded media. @@ -326,7 +328,7 @@ downloadWeb addunlockedmatcher o url urlinfo file = Left _ -> normalfinish tmp where dl dest = withTmpWorkDir mediakey $ \workdir -> do - let cleanuptmp = pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith removeLink) + let cleanuptmp = pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith R.removeLink) showNote "using youtube-dl" Transfer.notifyTransfer Transfer.Download url $ Transfer.download webUUID mediakey (AssociatedFile Nothing) Transfer.noRetry $ \p -> @@ -400,7 +402,7 @@ downloadWith' downloader dummykey u url afile = then return (Just tmp) else return Nothing -finishDownloadWith :: CanAddFile -> AddUnlockedMatcher -> FilePath -> UUID -> URLString -> FilePath -> Annex Key +finishDownloadWith :: CanAddFile -> AddUnlockedMatcher -> RawFilePath -> UUID -> URLString -> RawFilePath -> Annex Key finishDownloadWith canadd addunlockedmatcher tmp u url file = do backend <- chooseBackend file let source = KeySource @@ -419,14 +421,16 @@ addSizeUrlKey urlinfo key = alterKey key $ \d -> d } {- Adds worktree file to the repository. -} -addWorkTree :: CanAddFile -> AddUnlockedMatcher -> UUID -> URLString -> FilePath -> Key -> Maybe FilePath -> Annex () +addWorkTree :: CanAddFile -> AddUnlockedMatcher -> UUID -> URLString -> RawFilePath -> Key -> Maybe RawFilePath -> Annex () addWorkTree _ addunlockedmatcher u url file key mtmp = case mtmp of Nothing -> go Just tmp -> do -- Move to final location for large file check. pruneTmpWorkDirBefore tmp $ \_ -> do - createWorkTreeDirectory (takeDirectory file) - liftIO $ renameFile tmp file + createWorkTreeDirectory (P.takeDirectory file) + liftIO $ renameFile + (fromRawFilePath tmp) + (fromRawFilePath file) largematcher <- largeFilesMatcher large <- checkFileMatcher largematcher file if large @@ -434,9 +438,11 @@ addWorkTree _ addunlockedmatcher u url file key mtmp = case mtmp of -- Move back to tmp because addAnnexedFile -- needs the file in a different location -- than the work tree file. - liftIO $ renameFile file tmp + liftIO $ renameFile + (fromRawFilePath file) + (fromRawFilePath tmp) go - else void $ Command.Add.addSmall noci (toRawFilePath file) + else void $ Command.Add.addSmall noci file where go = do maybeShowJSON $ JSONChunk [("key", serializeKey key)] @@ -446,18 +452,18 @@ addWorkTree _ addunlockedmatcher u url file key mtmp = case mtmp of ( do when (isJust mtmp) $ logStatus key InfoPresent - , maybe noop (\tmp -> pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith removeLink)) mtmp + , maybe noop (\tmp -> pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith R.removeLink)) mtmp ) -- git does not need to check ignores, because that has already -- been done, as witnessed by the CannAddFile. noci = CheckGitIgnore False -nodownloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key) +nodownloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> RawFilePath -> Annex (Maybe Key) nodownloadWeb addunlockedmatcher o url urlinfo file | Url.urlExists urlinfo = if rawOption o then nomedia - else either (const nomedia) usemedia + else either (const nomedia) (usemedia . toRawFilePath) =<< youtubeDlFileName url | otherwise = do warning $ "unable to access url: " ++ url @@ -472,14 +478,14 @@ nodownloadWeb addunlockedmatcher o url urlinfo file let mediakey = Backend.URL.fromUrl mediaurl Nothing nodownloadWeb' o addunlockedmatcher mediaurl mediakey dest -youtubeDlDestFile :: DownloadOptions -> FilePath -> FilePath -> FilePath +youtubeDlDestFile :: DownloadOptions -> RawFilePath -> RawFilePath -> RawFilePath youtubeDlDestFile o destfile mediafile | isJust (fileOption o) = destfile - | otherwise = takeFileName mediafile + | otherwise = P.takeFileName mediafile -nodownloadWeb' :: DownloadOptions -> AddUnlockedMatcher -> URLString -> Key -> FilePath -> Annex (Maybe Key) +nodownloadWeb' :: DownloadOptions -> AddUnlockedMatcher -> URLString -> Key -> RawFilePath -> Annex (Maybe Key) nodownloadWeb' o addunlockedmatcher url key file = checkCanAdd o file $ \canadd -> do - showDestinationFile file + showDestinationFile (fromRawFilePath file) createWorkTreeDirectory (parentDir file) addWorkTree canadd addunlockedmatcher webUUID url file key Nothing return (Just key) @@ -515,14 +521,14 @@ adjustFile o = addprefix . addsuffix data CanAddFile = CanAddFile -checkCanAdd :: DownloadOptions -> FilePath -> (CanAddFile -> Annex (Maybe a)) -> Annex (Maybe a) -checkCanAdd o file a = ifM (isJust <$> (liftIO $ catchMaybeIO $ getSymbolicLinkStatus file)) +checkCanAdd :: DownloadOptions -> RawFilePath -> (CanAddFile -> Annex (Maybe a)) -> Annex (Maybe a) +checkCanAdd o file a = ifM (isJust <$> (liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus file)) ( do - warning $ file ++ " already exists; not overwriting" + warning $ fromRawFilePath file ++ " already exists; not overwriting" return Nothing , ifM (checkIgnored (checkGitIgnoreOption o) file) ( do - warning $ "not adding " ++ file ++ " which is .gitignored (use --no-check-gitignore to override)" + warning $ "not adding " ++ fromRawFilePath file ++ " which is .gitignored (use --no-check-gitignore to override)" return Nothing , a CanAddFile ) diff --git a/Command/Copy.hs b/Command/Copy.hs index 2fe56c0dad..15f2ea4f16 100644 --- a/Command/Copy.hs +++ b/Command/Copy.hs @@ -72,7 +72,7 @@ start o si file key = stopUnless shouldCopy $ Command.Move.start (fromToOptions o) Command.Move.RemoveNever si file key where shouldCopy - | autoMode o = want <||> numCopiesCheck (fromRawFilePath file) key (<) + | autoMode o = want <||> numCopiesCheck file key (<) | otherwise = return True want = case fromToOptions o of Right (ToRemote dest) -> diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index f0415eaa90..17067b7d57 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -15,6 +15,7 @@ import qualified Git import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused) import Annex.NumCopies import Annex.Content +import qualified Utility.RawFilePath as R cmd :: Command cmd = command "dropunused" SectionMaintenance @@ -63,8 +64,8 @@ perform from numcopies key = case from of where droplocal = Command.Drop.performLocal key (AssociatedFile Nothing) numcopies [] -performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform +performOther :: (Key -> Git.Repo -> RawFilePath) -> Key -> CommandPerform performOther filespec key = do f <- fromRepo $ filespec key - pruneTmpWorkDirBefore f (liftIO . removeWhenExistsWith removeLink) + pruneTmpWorkDirBefore f (liftIO . removeWhenExistsWith R.removeLink) next $ return True diff --git a/Command/Fix.hs b/Command/Fix.hs index 210370071d..73401e726f 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -46,11 +46,10 @@ data FixWhat = FixSymlinks | FixAll start :: FixWhat -> SeekInput -> RawFilePath -> Key -> CommandStart start fixwhat si file key = do currlink <- liftIO $ catchMaybeIO $ R.readSymbolicLink file - wantlink <- calcRepo $ gitAnnexLink (fromRawFilePath file) key + wantlink <- calcRepo $ gitAnnexLink file key case currlink of Just l - | l /= toRawFilePath wantlink -> fixby $ - fixSymlink (fromRawFilePath file) wantlink + | l /= wantlink -> fixby $ fixSymlink file wantlink | otherwise -> stop Nothing -> case fixwhat of FixAll -> fixthin @@ -78,7 +77,7 @@ breakHardLink file key obj = do unlessM (checkedCopyFile key obj' tmp mode) $ error "unable to break hard link" thawContent tmp - modifyContent obj' $ freezeContent obj' + modifyContent obj $ freezeContent obj' Database.Keys.storeInodeCaches key [file] next $ return True @@ -86,25 +85,25 @@ makeHardLink :: RawFilePath -> Key -> CommandPerform makeHardLink file key = do replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file - linkFromAnnex key tmp mode >>= \case + linkFromAnnex key (toRawFilePath tmp) mode >>= \case LinkAnnexFailed -> error "unable to make hard link" _ -> noop next $ return True -fixSymlink :: FilePath -> FilePath -> CommandPerform +fixSymlink :: RawFilePath -> RawFilePath -> CommandPerform fixSymlink file link = do #if ! defined(mingw32_HOST_OS) -- preserve mtime of symlink mtime <- liftIO $ catchMaybeIO $ modificationTimeHiRes - <$> getSymbolicLinkStatus file + <$> R.getSymbolicLinkStatus file #endif createWorkTreeDirectory (parentDir file) - liftIO $ removeFile file - liftIO $ createSymbolicLink link file + liftIO $ R.removeLink file + liftIO $ R.createSymbolicLink link file #if ! defined(mingw32_HOST_OS) liftIO $ maybe noop (\t -> touch file t False) mtime #endif - next $ cleanupSymlink file + next $ cleanupSymlink (fromRawFilePath file) cleanupSymlink :: FilePath -> CommandCleanup cleanupSymlink file = do diff --git a/Command/FromKey.hs b/Command/FromKey.hs index 85a2f48965..32bfd2ba08 100644 --- a/Command/FromKey.hs +++ b/Command/FromKey.hs @@ -16,6 +16,7 @@ import Annex.WorkTree import Annex.Perms import qualified Annex import qualified Backend.URL +import qualified Utility.RawFilePath as R import Network.URI @@ -51,12 +52,12 @@ seekBatch fmt = batchInput fmt parse (commandAction . go) let (keyname, file) = separate (== ' ') s if not (null keyname) && not (null file) then do - file' <- liftIO $ relPathCwdToFile file + file' <- liftIO $ relPathCwdToFile (toRawFilePath file) return $ Right (file', keyOpt keyname) else return $ Left "Expected pairs of key and filename" go (si, (file, key)) = - let ai = mkActionItem (key, toRawFilePath file) + let ai = mkActionItem (key, file) in starting "fromkey" ai si $ perform key file @@ -67,9 +68,11 @@ start force (si, (keyname, file)) = do inbackend <- inAnnex key unless inbackend $ giveup $ "key ("++ keyname ++") is not present in backend (use --force to override this sanity check)" - let ai = mkActionItem (key, toRawFilePath file) + let ai = mkActionItem (key, file') starting "fromkey" ai si $ - perform key file + perform key file' + where + file' = toRawFilePath file -- From user input to a Key. -- User can input either a serialized key, or an url. @@ -86,15 +89,15 @@ keyOpt s = case parseURI s of Just k -> k Nothing -> giveup $ "bad key/url " ++ s -perform :: Key -> FilePath -> CommandPerform -perform key file = lookupKeyNotHidden (toRawFilePath file) >>= \case - Nothing -> ifM (liftIO $ doesFileExist file) +perform :: Key -> RawFilePath -> CommandPerform +perform key file = lookupKeyNotHidden file >>= \case + Nothing -> ifM (liftIO $ doesFileExist (fromRawFilePath file)) ( hasothercontent , do link <- calcRepo $ gitAnnexLink file key createWorkTreeDirectory (parentDir file) - liftIO $ createSymbolicLink link file - Annex.Queue.addCommand "add" [Param "--"] [file] + liftIO $ R.createSymbolicLink link file + Annex.Queue.addCommand "add" [Param "--"] [fromRawFilePath file] next $ return True ) Just k @@ -102,5 +105,5 @@ perform key file = lookupKeyNotHidden (toRawFilePath file) >>= \case | otherwise -> hasothercontent where hasothercontent = do - warning $ file ++ " already exists with different content" + warning $ fromRawFilePath file ++ " already exists with different content" next $ return False diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 7a9800694d..6aa25c50c6 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -6,6 +6,7 @@ -} {-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} module Command.Fsck where @@ -42,6 +43,7 @@ import System.Posix.Types (EpochTime) import qualified Data.Set as S import qualified Data.Map as M import Data.Either +import qualified System.FilePath.ByteString as P cmd :: Command cmd = withGlobalOptions [jobsOption, jsonOptions, annexedMatchingOptions] $ @@ -115,7 +117,7 @@ start :: Maybe Remote -> Incremental -> SeekInput -> RawFilePath -> Key -> Comma start from inc si file key = Backend.getBackend (fromRawFilePath file) key >>= \case Nothing -> stop Just backend -> do - numcopies <- getFileNumCopies (fromRawFilePath file) + numcopies <- getFileNumCopies file case from of Nothing -> go $ perform key file backend numcopies Just r -> go $ performRemote key afile backend numcopies r @@ -177,11 +179,11 @@ performRemote key afile backend numcopies remote = pid <- liftIO getPID t <- fromRepo gitAnnexTmpObjectDir createAnnexDirectory t - let tmp = t "fsck" ++ show pid ++ "." ++ fromRawFilePath (keyFile key) - let cleanup = liftIO $ catchIO (removeFile tmp) (const noop) + let tmp = t P. "fsck" <> toRawFilePath (show pid) <> "." <> keyFile key + let cleanup = liftIO $ catchIO (R.removeLink tmp) (const noop) cleanup cleanup `after` a tmp - getfile tmp = ifM (checkDiskSpace (Just (takeDirectory tmp)) key 0 True) + getfile tmp = ifM (checkDiskSpace (Just (fromRawFilePath (P.takeDirectory tmp))) key 0 True) ( ifM (getcheap tmp) ( return (Just True) , ifM (Annex.getState Annex.fast) @@ -191,10 +193,10 @@ performRemote key afile backend numcopies remote = ) , return (Just False) ) - getfile' tmp = Remote.retrieveKeyFile remote key (AssociatedFile Nothing) tmp dummymeter + getfile' tmp = Remote.retrieveKeyFile remote key (AssociatedFile Nothing) (fromRawFilePath tmp) dummymeter dummymeter _ = noop getcheap tmp = case Remote.retrieveKeyFileCheap remote of - Just a -> isRight <$> tryNonAsync (a key afile tmp) + Just a -> isRight <$> tryNonAsync (a key afile (fromRawFilePath tmp)) Nothing -> return False startKey :: Maybe Remote -> Incremental -> (SeekInput, Key, ActionItem) -> NumCopies -> CommandStart @@ -222,16 +224,16 @@ check cs = and <$> sequence cs {- Checks that symlinks points correctly to the annexed content. -} fixLink :: Key -> RawFilePath -> Annex Bool fixLink key file = do - want <- calcRepo $ gitAnnexLink (fromRawFilePath file) key + want <- calcRepo $ gitAnnexLink file key have <- getAnnexLinkTarget file maybe noop (go want) have return True where go want have - | want /= fromRawFilePath (fromInternalGitPath have) = do + | want /= fromInternalGitPath have = do showNote "fixing link" - createWorkTreeDirectory (parentDir (fromRawFilePath file)) - liftIO $ removeFile (fromRawFilePath file) + createWorkTreeDirectory (parentDir file) + liftIO $ R.removeLink file addAnnexLink want file | otherwise = noop @@ -239,9 +241,9 @@ fixLink key file = do - in this repository only. -} verifyLocationLog :: Key -> KeyStatus -> ActionItem -> Annex Bool verifyLocationLog key keystatus ai = do - obj <- fromRawFilePath <$> calcRepo (gitAnnexLocation key) + obj <- calcRepo (gitAnnexLocation key) present <- if isKeyUnlockedThin keystatus - then liftIO (doesFileExist obj) + then liftIO (doesFileExist (fromRawFilePath obj)) else inAnnex key u <- getUUID @@ -249,12 +251,12 @@ verifyLocationLog key keystatus ai = do - in a permission fixup here too. -} when present $ do void $ tryIO $ case keystatus of - KeyUnlockedThin -> thawContent obj - KeyLockedThin -> thawContent obj - _ -> freezeContent obj + KeyUnlockedThin -> thawContent (fromRawFilePath obj) + KeyLockedThin -> thawContent (fromRawFilePath obj) + _ -> freezeContent (fromRawFilePath obj) unlessM (isContentWritePermOk obj) $ - warning $ "** Unable to set correct write mode for " ++ obj ++ " ; perhaps you don't own that file" - whenM (liftIO $ doesDirectoryExist $ parentDir obj) $ + warning $ "** Unable to set correct write mode for " ++ fromRawFilePath obj ++ " ; perhaps you don't own that file" + whenM (liftIO $ R.doesPathExist $ parentDir obj) $ freezeContentDir obj {- Warn when annex.securehashesonly is set and content using an @@ -263,7 +265,7 @@ verifyLocationLog key keystatus ai = do - config was set. -} whenM (pure present <&&> (not <$> Backend.isCryptographicallySecure key)) $ whenM (annexSecureHashesOnly <$> Annex.getGitConfig) $ - warning $ "** Despite annex.securehashesonly being set, " ++ obj ++ " has content present in the annex using an insecure " ++ decodeBS (formatKeyVariety (fromKey keyVariety key)) ++ " key" + warning $ "** Despite annex.securehashesonly being set, " ++ fromRawFilePath obj ++ " has content present in the annex using an insecure " ++ decodeBS (formatKeyVariety (fromKey keyVariety key)) ++ " key" verifyLocationLog' key ai present u (logChange key u) @@ -346,7 +348,7 @@ verifyWorkTree key file = do replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file ifM (annexThin <$> Annex.getGitConfig) - ( void $ linkFromAnnex key tmp mode + ( void $ linkFromAnnex key (toRawFilePath tmp) mode , do obj <- fromRawFilePath <$> calcRepo (gitAnnexLocation key) void $ checkedCopyFile key obj tmp mode @@ -366,23 +368,23 @@ checkKeySize _ KeyUnlockedThin _ = return True checkKeySize key _ ai = do file <- calcRepo $ gitAnnexLocation key ifM (liftIO $ R.doesPathExist file) - ( checkKeySizeOr badContent key (fromRawFilePath file) ai + ( checkKeySizeOr badContent key file ai , return True ) -withLocalCopy :: Maybe FilePath -> (FilePath -> Annex Bool) -> Annex Bool +withLocalCopy :: Maybe RawFilePath -> (RawFilePath -> Annex Bool) -> Annex Bool withLocalCopy Nothing _ = return True withLocalCopy (Just localcopy) f = f localcopy -checkKeySizeRemote :: Key -> Remote -> ActionItem -> FilePath -> Annex Bool +checkKeySizeRemote :: Key -> Remote -> ActionItem -> RawFilePath -> Annex Bool checkKeySizeRemote key remote ai localcopy = checkKeySizeOr (badContentRemote remote localcopy) key localcopy ai -checkKeySizeOr :: (Key -> Annex String) -> Key -> FilePath -> ActionItem -> Annex Bool +checkKeySizeOr :: (Key -> Annex String) -> Key -> RawFilePath -> ActionItem -> Annex Bool checkKeySizeOr bad key file ai = case fromKey keySize key of Nothing -> return True Just size -> do - size' <- liftIO $ getFileSize file + size' <- liftIO $ getFileSize (fromRawFilePath file) comparesizes size size' where comparesizes a b = do @@ -436,30 +438,30 @@ checkBackend backend key keystatus afile = do content <- calcRepo (gitAnnexLocation key) ifM (pure (isKeyUnlockedThin keystatus) <&&> (not <$> isUnmodified key content)) ( nocheck - , checkBackendOr badContent backend key (fromRawFilePath content) ai + , checkBackendOr badContent backend key content ai ) where nocheck = return True ai = mkActionItem (key, afile) -checkBackendRemote :: Backend -> Key -> Remote -> ActionItem -> FilePath -> Annex Bool +checkBackendRemote :: Backend -> Key -> Remote -> ActionItem -> RawFilePath -> Annex Bool checkBackendRemote backend key remote ai localcopy = checkBackendOr (badContentRemote remote localcopy) backend key localcopy ai -checkBackendOr :: (Key -> Annex String) -> Backend -> Key -> FilePath -> ActionItem -> Annex Bool +checkBackendOr :: (Key -> Annex String) -> Backend -> Key -> RawFilePath -> ActionItem -> Annex Bool checkBackendOr bad backend key file ai = checkBackendOr' bad backend key file ai (return True) -- The postcheck action is run after the content is verified, -- in order to detect situations where the file is changed while being -- verified. -checkBackendOr' :: (Key -> Annex String) -> Backend -> Key -> FilePath -> ActionItem -> Annex Bool -> Annex Bool +checkBackendOr' :: (Key -> Annex String) -> Backend -> Key -> RawFilePath -> ActionItem -> Annex Bool -> Annex Bool checkBackendOr' bad backend key file ai postcheck = case Types.Backend.verifyKeyContent backend of Nothing -> return True Just verifier -> do - ok <- verifier key file + ok <- verifier key (fromRawFilePath file) ifM postcheck ( do unless ok $ do @@ -529,19 +531,20 @@ badContent key = do - symlink to a file in the remote). To avoid any further data loss, - that temp file is moved to the bad content directory unless - the local annex has a copy of the content. -} -badContentRemote :: Remote -> FilePath -> Key -> Annex String +badContentRemote :: Remote -> RawFilePath -> Key -> Annex String badContentRemote remote localcopy key = do bad <- fromRepo gitAnnexBadDir - let destbad = bad fromRawFilePath (keyFile key) - movedbad <- ifM (inAnnex key <||> liftIO (doesFileExist destbad)) + let destbad = bad P. keyFile key + let destbad' = fromRawFilePath destbad + movedbad <- ifM (inAnnex key <||> liftIO (doesFileExist destbad')) ( return False , do createAnnexDirectory (parentDir destbad) liftIO $ catchDefaultIO False $ - ifM (isSymbolicLink <$> getSymbolicLinkStatus localcopy) - ( copyFileExternal CopyTimeStamps localcopy destbad + ifM (isSymbolicLink <$> R.getSymbolicLinkStatus localcopy) + ( copyFileExternal CopyTimeStamps (fromRawFilePath localcopy) destbad' , do - moveFile localcopy destbad + moveFile (fromRawFilePath localcopy) destbad' return True ) ) @@ -551,7 +554,7 @@ badContentRemote remote localcopy key = do Remote.logStatus remote key InfoMissing return $ case (movedbad, dropped) of (True, Right ()) -> "moved from " ++ Remote.name remote ++ - " to " ++ destbad + " to " ++ fromRawFilePath destbad (False, Right ()) -> "dropped from " ++ Remote.name remote (_, Left e) -> "failed to drop from" ++ Remote.name remote ++ ": " ++ show e @@ -583,22 +586,23 @@ recordFsckTime inc key = withFsckDb inc $ \h -> liftIO $ FsckDb.addDb h key recordStartTime :: UUID -> Annex () recordStartTime u = do f <- fromRepo (gitAnnexFsckState u) + let f' = fromRawFilePath f createAnnexDirectory $ parentDir f - liftIO $ removeWhenExistsWith removeLink f - liftIO $ withFile f WriteMode $ \h -> do + liftIO $ removeWhenExistsWith R.removeLink f + liftIO $ withFile f' WriteMode $ \h -> do #ifndef mingw32_HOST_OS - t <- modificationTime <$> getFileStatus f + t <- modificationTime <$> R.getFileStatus f #else t <- getPOSIXTime #endif hPutStr h $ showTime $ realToFrac t - setAnnexFilePerm f + setAnnexFilePerm f' where showTime :: POSIXTime -> String showTime = show resetStartTime :: UUID -> Annex () -resetStartTime u = liftIO . removeWhenExistsWith removeLink +resetStartTime u = liftIO . removeWhenExistsWith R.removeLink =<< fromRepo (gitAnnexFsckState u) {- Gets the incremental fsck start time. -} @@ -606,9 +610,9 @@ getStartTime :: UUID -> Annex (Maybe EpochTime) getStartTime u = do f <- fromRepo (gitAnnexFsckState u) liftIO $ catchDefaultIO Nothing $ do - timestamp <- modificationTime <$> getFileStatus f + timestamp <- modificationTime <$> R.getFileStatus f let fromstatus = Just (realToFrac timestamp) - fromfile <- parsePOSIXTime <$> readFile f + fromfile <- parsePOSIXTime <$> readFile (fromRawFilePath f) return $ if matchingtimestamp fromfile fromstatus then Just timestamp else Nothing diff --git a/Command/Get.hs b/Command/Get.hs index a63644b85d..ffb40df89c 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -60,7 +60,7 @@ start o from si file key = start' expensivecheck from key afile ai si afile = AssociatedFile (Just file) ai = mkActionItem (key, afile) expensivecheck - | autoMode o = numCopiesCheck (fromRawFilePath file) key (<) + | autoMode o = numCopiesCheck file key (<) <||> wantGet False (Just key) afile | otherwise = return True @@ -118,5 +118,6 @@ getKey' key afile = dispatch download (Remote.uuid r) key afile stdRetry (\p -> do showAction $ "from " ++ Remote.name r - Remote.verifiedAction (Remote.retrieveKeyFile r key afile dest p) + Remote.verifiedAction $ + Remote.retrieveKeyFile r key afile (fromRawFilePath dest) p ) witness diff --git a/Command/Lock.hs b/Command/Lock.hs index c084bc6e83..3f8672c08e 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -60,7 +60,7 @@ start si file key = ifM (isJust <$> isAnnexLink file) perform :: RawFilePath -> Key -> CommandPerform perform file key = do lockdown =<< calcRepo (gitAnnexLocation key) - addLink (CheckGitIgnore False) (fromRawFilePath file) key + addLink (CheckGitIgnore False) file key =<< withTSDelta (liftIO . genInodeCache file) next $ cleanup file key where diff --git a/Command/Migrate.hs b/Command/Migrate.hs index 628fe6cc1f..669be7f56c 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -44,7 +44,7 @@ start si file key = do Just oldbackend -> do exists <- inAnnex key newbackend <- maybe defaultBackend return - =<< chooseBackend (fromRawFilePath file) + =<< chooseBackend file if (newbackend /= oldbackend || upgradableKey oldbackend key || forced) && exists then starting "migrate" (mkActionItem (key, file)) si $ perform file key oldbackend newbackend diff --git a/Command/Mirror.hs b/Command/Mirror.hs index 0028116daa..28f7c92968 100644 --- a/Command/Mirror.hs +++ b/Command/Mirror.hs @@ -88,4 +88,4 @@ startKey o afile (si, key, ai) = case fromToOptions o of where getnumcopies = case afile of AssociatedFile Nothing -> getNumCopies - AssociatedFile (Just af) -> getFileNumCopies (fromRawFilePath af) + AssociatedFile (Just af) -> getFileNumCopies af diff --git a/Command/Move.hs b/Command/Move.hs index cfab0725aa..85ee923422 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -226,7 +226,7 @@ fromPerform src removewhen key afile = do get = notifyTransfer Download afile $ download (Remote.uuid src) key afile stdRetry $ \p -> getViaTmp (Remote.retrievalSecurityPolicy src) (RemoteVerify src) key $ \t -> - Remote.verifiedAction $ Remote.retrieveKeyFile src key afile t p + Remote.verifiedAction $ Remote.retrieveKeyFile src key afile (fromRawFilePath t) p dispatch _ _ False = stop -- failed dispatch RemoveNever _ True = next $ return True -- copy complete @@ -363,7 +363,7 @@ logMove srcuuid destuuid deststartedwithcopy key a = bracket setup cleanup go go logf -- Only need to check log when there is a copy. | deststartedwithcopy = do - wasnocopy <- checkLogFile logf gitAnnexMoveLock + wasnocopy <- checkLogFile (fromRawFilePath logf) gitAnnexMoveLock (== logline) if wasnocopy then go' False diff --git a/Command/ReKey.hs b/Command/ReKey.hs index 6853507e10..3054eb26af 100644 --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -124,7 +124,7 @@ cleanup file oldkey newkey = do ( do -- Update symlink to use the new key. liftIO $ removeFile (fromRawFilePath file) - addLink (CheckGitIgnore False) (fromRawFilePath file) newkey Nothing + addLink (CheckGitIgnore False) file newkey Nothing , do mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file liftIO $ whenM (isJust <$> isPointerFile file) $ diff --git a/Git/CheckIgnore.hs b/Git/CheckIgnore.hs index 67eef7abe1..46a5b25cf3 100644 --- a/Git/CheckIgnore.hs +++ b/Git/CheckIgnore.hs @@ -18,6 +18,7 @@ import Git.Command import qualified Utility.CoProcess as CoProcess import System.IO.Error +import qualified Data.ByteString as B type CheckIgnoreHandle = CoProcess.CoProcessHandle @@ -51,11 +52,11 @@ checkIgnoreStop :: CheckIgnoreHandle -> IO () checkIgnoreStop = void . tryIO . CoProcess.stop {- Returns True if a file is ignored. -} -checkIgnored :: CheckIgnoreHandle -> FilePath -> IO Bool +checkIgnored :: CheckIgnoreHandle -> RawFilePath -> IO Bool checkIgnored h file = CoProcess.query h send (receive "") where send to = do - hPutStr to $ file ++ "\0" + B.hPutStr to $ file `B.snoc` 0 hFlush to receive c from = do s <- hGetSomeString from 1024 diff --git a/Logs/File.hs b/Logs/File.hs index e0c34b4c9e..32162f7525 100644 --- a/Logs/File.hs +++ b/Logs/File.hs @@ -51,12 +51,15 @@ withLogHandle f a = do -- | Appends a line to a log file, first locking it to prevent -- concurrent writers. -appendLogFile :: FilePath -> (Git.Repo -> RawFilePath) -> L.ByteString -> Annex () +appendLogFile :: RawFilePath -> (Git.Repo -> RawFilePath) -> L.ByteString -> Annex () appendLogFile f lck c = - createDirWhenNeeded (toRawFilePath f) $ + createDirWhenNeeded f $ withExclusiveLock lck $ do - liftIO $ withFile f AppendMode $ \h -> L8.hPutStrLn h c - setAnnexFilePerm f + liftIO $ withFile f' AppendMode $ + \h -> L8.hPutStrLn h c + setAnnexFilePerm f' + where + f' = fromRawFilePath f -- | Modifies a log file. -- @@ -66,18 +69,19 @@ appendLogFile f lck c = -- -- The file is locked to prevent concurrent writers, and it is written -- atomically. -modifyLogFile :: FilePath -> (Git.Repo -> RawFilePath) -> ([L.ByteString] -> [L.ByteString]) -> Annex () +modifyLogFile :: RawFilePath -> (Git.Repo -> RawFilePath) -> ([L.ByteString] -> [L.ByteString]) -> Annex () modifyLogFile f lck modf = withExclusiveLock lck $ do ls <- liftIO $ fromMaybe [] - <$> tryWhenExists (L8.lines <$> L.readFile f) + <$> tryWhenExists (L8.lines <$> L.readFile f') let ls' = modf ls when (ls' /= ls) $ - createDirWhenNeeded (toRawFilePath f) $ - viaTmp writelog f (L8.unlines ls') + createDirWhenNeeded f $ + viaTmp writelog f' (L8.unlines ls') where - writelog f' b = do - liftIO $ L.writeFile f' b - setAnnexFilePerm f' + f' = fromRawFilePath f + writelog lf b = do + liftIO $ L.writeFile lf b + setAnnexFilePerm lf -- | Checks the content of a log file to see if any line matches. -- diff --git a/Logs/Smudge.hs b/Logs/Smudge.hs index 743c765d2a..90e5475f92 100644 --- a/Logs/Smudge.hs +++ b/Logs/Smudge.hs @@ -32,7 +32,7 @@ smudgeLog k f = do streamSmudged :: (Key -> TopFilePath -> Annex ()) -> Annex () streamSmudged a = do logf <- fromRepo gitAnnexSmudgeLog - streamLogFile logf gitAnnexSmudgeLock $ \l -> + streamLogFile (fromRawFilePath logf) gitAnnexSmudgeLock $ \l -> case parse l of Nothing -> noop Just (k, f) -> a k f diff --git a/Utility/Touch.hs b/Utility/Touch.hs index 1b2511cc79..136091db42 100644 --- a/Utility/Touch.hs +++ b/Utility/Touch.hs @@ -14,19 +14,20 @@ module Utility.Touch ( #if ! defined(mingw32_HOST_OS) -import System.Posix.Files +import System.FilePath.ByteString (RawFilePath) +import System.Posix.Files.ByteString import Data.Time.Clock.POSIX {- Changes the access and modification times of an existing file. Can follow symlinks, or not. -} -touchBoth :: FilePath -> POSIXTime -> POSIXTime -> Bool -> IO () +touchBoth :: RawFilePath -> POSIXTime -> POSIXTime -> Bool -> IO () touchBoth file atime mtime follow | follow = setFileTimesHiRes file atime mtime | otherwise = setSymbolicLinkTimesHiRes file atime mtime {- Changes the access and modification times of an existing file - to the same value. Can follow symlinks, or not. -} -touch :: FilePath -> POSIXTime -> Bool -> IO () +touch :: RawFilePath -> POSIXTime -> Bool -> IO () touch file mtime = touchBoth file mtime mtime #else @@ -34,10 +35,10 @@ touch file mtime = touchBoth file mtime mtime import Data.Time.Clock.POSIX {- Noop for Windows -} -touchBoth :: FilePath -> POSIXTime -> POSIXTime -> Bool -> IO () +touchBoth :: RawFilePath -> POSIXTime -> POSIXTime -> Bool -> IO () touchBoth _ _ _ _ = return () -touch :: FilePath -> POSIXTime -> Bool -> IO () +touch :: RawFilePath -> POSIXTime -> Bool -> IO () touch _ _ _ = return () #endif