diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs index 9aa3ca18cf..06df41f1fd 100644 --- a/Annex/FileMatcher.hs +++ b/Annex/FileMatcher.hs @@ -52,18 +52,19 @@ import Annex.Magic import Data.Either import qualified Data.Set as S -type GetFileMatcher = FilePath -> Annex (FileMatcher Annex) +type GetFileMatcher = RawFilePath -> Annex (FileMatcher Annex) -checkFileMatcher :: GetFileMatcher -> FilePath -> Annex Bool -checkFileMatcher getmatcher file = checkFileMatcher' getmatcher file (return True) +checkFileMatcher :: GetFileMatcher -> RawFilePath -> Annex Bool +checkFileMatcher getmatcher file = + checkFileMatcher' getmatcher file (return True) -- | Allows running an action when no matcher is configured for the file. -checkFileMatcher' :: GetFileMatcher -> FilePath -> Annex Bool -> Annex Bool +checkFileMatcher' :: GetFileMatcher -> RawFilePath -> Annex Bool -> Annex Bool checkFileMatcher' getmatcher file notconfigured = do matcher <- getmatcher file checkMatcher matcher Nothing afile S.empty notconfigured d where - afile = AssociatedFile (Just (toRawFilePath file)) + afile = AssociatedFile (Just file) -- checkMatcher will never use this, because afile is provided. d = return True diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs index 0d761199f4..5f6ec948f7 100644 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -157,7 +157,7 @@ ingest' preferredbackend meterupdate (Just (LockedDown cfg source)) mk restage = k <- case mk of Nothing -> do backend <- maybe - (chooseBackend $ fromRawFilePath $ keyFilename source) + (chooseBackend $ keyFilename source) (return . Just) preferredbackend fst <$> genKey source meterupdate backend @@ -176,7 +176,7 @@ ingest' preferredbackend meterupdate (Just (LockedDown cfg source)) mk restage = go _ _ Nothing = failure "failed to generate a key" golocked key mcache s = - tryNonAsync (moveAnnex key $ fromRawFilePath $ contentLocation source) >>= \case + tryNonAsync (moveAnnex key $ contentLocation source) >>= \case Right True -> do populateAssociatedFiles key source restage success key mcache s @@ -189,7 +189,7 @@ ingest' preferredbackend meterupdate (Just (LockedDown cfg source)) mk restage = -- already has a hard link. cleanCruft source cleanOldKeys (keyFilename source) key - linkToAnnex key (fromRawFilePath $ keyFilename source) (Just cache) >>= \case + linkToAnnex key (keyFilename source) (Just cache) >>= \case LinkAnnexFailed -> failure "failed to link to annex" _ -> do finishIngestUnlocked' key source restage @@ -254,7 +254,7 @@ cleanOldKeys file newkey = do -- so no need for any recovery. (f:_) -> do ic <- withTSDelta (liftIO . genInodeCache f) - void $ linkToAnnex key (fromRawFilePath f) ic + void $ linkToAnnex key f ic _ -> logStatus key InfoMissing {- On error, put the file back so it doesn't seem to have vanished. @@ -272,9 +272,9 @@ restoreFile file key e = do throwM e {- Creates the symlink to the annexed content, returns the link target. -} -makeLink :: FilePath -> Key -> Maybe InodeCache -> Annex String +makeLink :: FilePath -> Key -> Maybe InodeCache -> Annex LinkTarget makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do - l <- calcRepo $ gitAnnexLink file key + l <- calcRepo $ gitAnnexLink (toRawFilePath file) key replaceWorkTreeFile file $ makeAnnexLink l . toRawFilePath -- touch symlink to have same time as the original file, @@ -349,7 +349,7 @@ addAnnexedFile ci matcher file key mtmp = ifM (addUnlocked matcher mi) stagePointerFile file' mode =<< hashPointerFile key Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file') case mtmp of - Just tmp -> ifM (moveAnnex key tmp) + Just tmp -> ifM (moveAnnex key (toRawFilePath tmp)) ( linkunlocked mode >> return True , writepointer mode >> return False ) @@ -360,7 +360,7 @@ addAnnexedFile ci matcher file key mtmp = ifM (addUnlocked matcher mi) , do addLink ci file key Nothing case mtmp of - Just tmp -> moveAnnex key tmp + Just tmp -> moveAnnex key (toRawFilePath tmp) Nothing -> return True ) where @@ -380,7 +380,7 @@ addAnnexedFile ci matcher file key mtmp = ifM (addUnlocked matcher mi) , providedMimeEncoding = Nothing } - linkunlocked mode = linkFromAnnex key file mode >>= \case + linkunlocked mode = linkFromAnnex key file' mode >>= \case LinkAnnexFailed -> liftIO $ writePointerFile file' key mode _ -> return () diff --git a/Annex/Link.hs b/Annex/Link.hs index 12cde6a2c8..b9f6a662df 100644 --- a/Annex/Link.hs +++ b/Annex/Link.hs @@ -126,7 +126,7 @@ hashSymlink = hashBlob . toInternalGitPath stageSymlink :: RawFilePath -> Sha -> Annex () stageSymlink file sha = Annex.Queue.addUpdateIndex =<< - inRepo (Git.UpdateIndex.stageSymlink (fromRawFilePath file) sha) + inRepo (Git.UpdateIndex.stageSymlink file sha) {- Injects a pointer file content into git, returning its Sha. -} hashPointerFile :: Key -> Annex Sha diff --git a/Annex/Locations.hs b/Annex/Locations.hs index 399bd0ce79..ffb9763f9d 100644 --- a/Annex/Locations.hs +++ b/Annex/Locations.hs @@ -268,11 +268,8 @@ gitAnnexObjectDir r = fromRawFilePath $ P.addTrailingPathSeparator $ Git.localGitDir r P. objectDir' {- .git/annex/tmp/ is used for temp files for key's contents -} -gitAnnexTmpObjectDir :: Git.Repo -> FilePath -gitAnnexTmpObjectDir = fromRawFilePath . gitAnnexTmpObjectDir' - -gitAnnexTmpObjectDir' :: Git.Repo -> RawFilePath -gitAnnexTmpObjectDir' r = P.addTrailingPathSeparator $ +gitAnnexTmpObjectDir :: Git.Repo -> RawFilePath +gitAnnexTmpObjectDir r = P.addTrailingPathSeparator $ gitAnnexDir r P. "tmp" {- .git/annex/othertmp/ is used for other temp files -} @@ -297,7 +294,7 @@ gitAnnexTmpWatcherDir r = fromRawFilePath $ {- The temp file to use for a given key's content. -} gitAnnexTmpObjectLocation :: Key -> Git.Repo -> RawFilePath -gitAnnexTmpObjectLocation key r = gitAnnexTmpObjectDir' r P. keyFile key +gitAnnexTmpObjectLocation key r = gitAnnexTmpObjectDir r P. keyFile key {- Given a temp file such as gitAnnexTmpObjectLocation, makes a name for a - subdirectory in the same location, that can be used as a work area @@ -531,8 +528,8 @@ gitAnnexUrlFile :: Git.Repo -> FilePath gitAnnexUrlFile r = fromRawFilePath $ gitAnnexDir r P. "url" {- Temporary file used to edit configuriation from the git-annex branch. -} -gitAnnexTmpCfgFile :: Git.Repo -> FilePath -gitAnnexTmpCfgFile r = fromRawFilePath $ gitAnnexDir r P. "config.tmp" +gitAnnexTmpCfgFile :: Git.Repo -> RawFilePath +gitAnnexTmpCfgFile r = gitAnnexDir r P. "config.tmp" {- .git/annex/ssh/ is used for ssh connection caching -} gitAnnexSshDir :: Git.Repo -> RawFilePath diff --git a/Annex/NumCopies.hs b/Annex/NumCopies.hs index 8ece4bb63c..7b80e4c486 100644 --- a/Annex/NumCopies.hs +++ b/Annex/NumCopies.hs @@ -63,7 +63,7 @@ getNumCopies = fromSources {- Numcopies value for a file, from any configuration source, including the - deprecated git config. -} -getFileNumCopies :: FilePath -> Annex NumCopies +getFileNumCopies :: RawFilePath -> Annex NumCopies getFileNumCopies f = fromSources [ getForcedNumCopies , getFileNumCopies' f @@ -72,17 +72,17 @@ getFileNumCopies f = fromSources getAssociatedFileNumCopies :: AssociatedFile -> Annex NumCopies getAssociatedFileNumCopies (AssociatedFile afile) = - maybe getNumCopies getFileNumCopies (fromRawFilePath <$> afile) + maybe getNumCopies getFileNumCopies afile {- This is the globally visible numcopies value for a file. So it does - not include local configuration in the git config or command line - options. -} -getGlobalFileNumCopies :: FilePath -> Annex NumCopies +getGlobalFileNumCopies :: RawFilePath -> Annex NumCopies getGlobalFileNumCopies f = fromSources [ getFileNumCopies' f ] -getFileNumCopies' :: FilePath -> Annex (Maybe NumCopies) +getFileNumCopies' :: RawFilePath -> Annex (Maybe NumCopies) getFileNumCopies' file = maybe getGlobalNumCopies (return . Just) =<< getattr where getattr = (NumCopies <$$> readish) @@ -95,12 +95,12 @@ getFileNumCopies' file = maybe getGlobalNumCopies (return . Just) =<< getattr - This is good enough for everything except dropping the file, which - requires active verification of the copies. -} -numCopiesCheck :: FilePath -> Key -> (Int -> Int -> v) -> Annex v +numCopiesCheck :: RawFilePath -> Key -> (Int -> Int -> v) -> Annex v numCopiesCheck file key vs = do have <- trustExclude UnTrusted =<< Remote.keyLocations key numCopiesCheck' file vs have -numCopiesCheck' :: FilePath -> (Int -> Int -> v) -> [UUID] -> Annex v +numCopiesCheck' :: RawFilePath -> (Int -> Int -> v) -> [UUID] -> Annex v numCopiesCheck' file vs have = do NumCopies needed <- getFileNumCopies file return $ length have `vs` needed diff --git a/Annex/View.hs b/Annex/View.hs index d84f9d4ec1..5d62a8286b 100644 --- a/Annex/View.hs +++ b/Annex/View.hs @@ -369,8 +369,7 @@ applyView' mkviewedfile getfilemetadata view = do let f = fromRawFilePath $ getTopFilePath topf let metadata' = getfilemetadata f `unionMetaData` metadata forM_ (genviewedfiles f metadata') $ \fv -> do - f' <- fromRawFilePath <$> - fromRepo (fromTopFilePath $ asTopFilePath $ toRawFilePath fv) + f' <- fromRepo (fromTopFilePath $ asTopFilePath $ toRawFilePath fv) stagesymlink uh f' =<< calcRepo (gitAnnexLink f' k) go uh topf sha (Just treeitemtype) Nothing | "." `B.isPrefixOf` getTopFilePath topf = diff --git a/CmdLine/Batch.hs b/CmdLine/Batch.hs index 4c403e33d2..a9fc349e53 100644 --- a/CmdLine/Batch.hs +++ b/CmdLine/Batch.hs @@ -137,7 +137,7 @@ batchFilesMatching fmt a = do ) where go a' = batchInput fmt - (Right <$$> liftIO . relPathCwdToFile) + (Right . fromRawFilePath <$$> liftIO . relPathCwdToFile . toRawFilePath) (batchCommandAction . uncurry a') batchAnnexedFilesMatching :: BatchFormat -> AnnexedFileSeeker -> Annex () diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs index ed716008c7..1a804e01ae 100644 --- a/CmdLine/Seek.hs +++ b/CmdLine/Seek.hs @@ -25,6 +25,7 @@ import qualified Git.Ref import Git.FilePath import qualified Limit import CmdLine.GitAnnex.Options +import CmdLine.Action import Logs import Logs.Unused import Types.Transfer @@ -44,7 +45,6 @@ import qualified Annex.BranchState import qualified Database.Keys import qualified Utility.RawFilePath as R import Utility.Tuple -import CmdLine.Action import Control.Concurrent.Async import System.Posix.Types @@ -102,7 +102,7 @@ withPathContents a params = do a f where get p = ifM (isDirectory <$> getFileStatus p) - ( map (\f -> (f, makeRelative (parentDir p) f)) + ( map (\f -> (f, makeRelative (takeDirectory (dropTrailingPathSeparator p)) f)) <$> dirContentsRecursiveSkipping (".git" `isSuffixOf`) True p , return [(p, takeFileName p)] ) @@ -490,7 +490,7 @@ workTreeItems' (AllowHidden allowhidden) ww ps = case ww of currbranch <- getCurrentBranch stopattop <- prepviasymlink ps' <- flip filterM ps $ \p -> do - relf <- liftIO $ relPathCwdToFile p + relf <- liftIO $ relPathCwdToFile $ toRawFilePath p ifM (not <$> (exists p <||> hidden currbranch relf)) ( prob (p ++ " not found") , ifM (viasymlink stopattop (upFrom relf)) @@ -517,7 +517,7 @@ workTreeItems' (AllowHidden allowhidden) ww ps = case ww of viasymlink _ Nothing = return False viasymlink stopattop (Just p) = do - st <- liftIO $ getSymbolicLinkStatus p + st <- liftIO $ R.getSymbolicLinkStatus p if stopattop st then return False else if isSymbolicLink st @@ -526,7 +526,7 @@ workTreeItems' (AllowHidden allowhidden) ww ps = case ww of hidden currbranch f | allowhidden = isJust - <$> catObjectMetaDataHidden (toRawFilePath f) currbranch + <$> catObjectMetaDataHidden f currbranch | otherwise = return False prob msg = do diff --git a/Command.hs b/Command.hs index b9f02d1684..6b4130bc53 100644 --- a/Command.hs +++ b/Command.hs @@ -129,7 +129,8 @@ noDaemonRunning :: Command -> Command noDaemonRunning = addCheck $ whenM (isJust <$> daemonpid) $ giveup "You cannot run this command while git-annex watch or git-annex assistant is running." where - daemonpid = liftIO . checkDaemon =<< fromRepo gitAnnexPidFile + daemonpid = liftIO . checkDaemon . fromRawFilePath + =<< fromRepo gitAnnexPidFile dontCheck :: CommandCheck -> Command -> Command dontCheck check cmd = mutateCheck cmd $ \c -> filter (/= check) c diff --git a/Command/Uninit.hs b/Command/Uninit.hs index de05febbaf..5f15549690 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -31,8 +31,8 @@ check = do b <- current_branch when (b == Annex.Branch.name) $ giveup $ "cannot uninit when the " ++ Git.fromRef b ++ " branch is checked out" - top <- fromRawFilePath <$> fromRepo Git.repoPath - currdir <- liftIO getCurrentDirectory + top <- fromRepo Git.repoPath + currdir <- liftIO R.getCurrentDirectory whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath currdir)) $ giveup "can only run uninit from the top of the git repository" where diff --git a/Command/Unlock.hs b/Command/Unlock.hs index da45243663..cfe49f19ee 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -50,7 +50,7 @@ perform dest key = do replaceWorkTreeFile (fromRawFilePath dest) $ \tmp -> ifM (inAnnex key) ( do - r <- linkFromAnnex key tmp destmode + r <- linkFromAnnex key (toRawFilePath tmp) destmode case r of LinkAnnexOk -> return () LinkAnnexNoop -> return () diff --git a/Command/Unused.hs b/Command/Unused.hs index a83c35d981..52f43c1279 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -108,7 +108,7 @@ check file msg a c = do l <- a let unusedlist = number c l unless (null l) $ showLongNote $ msg unusedlist - updateUnusedLog file $ M.fromList unusedlist + updateUnusedLog (toRawFilePath file) (M.fromList unusedlist) return $ c + length l number :: Int -> [a] -> [(Int, a)] diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs index a9959c0a8e..a2029bcafb 100644 --- a/Command/Vicfg.hs +++ b/Command/Vicfg.hs @@ -43,11 +43,12 @@ seek = withNothing (commandAction start) start :: CommandStart start = do f <- fromRepo gitAnnexTmpCfgFile + let f' = fromRawFilePath f createAnnexDirectory $ parentDir f cfg <- getCfg descs <- uuidDescriptions - liftIO $ writeFile f $ genCfg cfg descs - vicfg cfg f + liftIO $ writeFile f' $ genCfg cfg descs + vicfg cfg f' stop vicfg :: Cfg -> FilePath -> Annex () diff --git a/Command/View.hs b/Command/View.hs index 2aaed261cc..d4f82bb26e 100644 --- a/Command/View.hs +++ b/Command/View.hs @@ -19,6 +19,8 @@ import Types.View import Annex.View import Logs.View +import qualified System.FilePath.ByteString as P + cmd :: Command cmd = notBareRepo $ command "view" SectionMetaData "enter a view branch" @@ -101,19 +103,19 @@ checkoutViewBranch view mkbranch = do - and this pollutes the view, so remove them. - (However, emptry directories used by submodules are not - removed.) -} - top <- liftIO . absPath . fromRawFilePath =<< fromRepo Git.repoPath + top <- liftIO . absPath =<< fromRepo Git.repoPath (l, cleanup) <- inRepo $ - LsFiles.notInRepoIncludingEmptyDirectories [] False - [toRawFilePath top] + LsFiles.notInRepoIncludingEmptyDirectories [] False [top] forM_ l (removeemptydir top) liftIO $ void cleanup unlessM (liftIO $ doesDirectoryExist here) $ do - showLongNote (cwdmissing top) + showLongNote (cwdmissing (fromRawFilePath top)) return ok where removeemptydir top d = do p <- inRepo $ toTopFilePath d - liftIO $ tryIO $ removeDirectory (top fromRawFilePath (getTopFilePath p)) + liftIO $ tryIO $ removeDirectory $ + fromRawFilePath $ (top P. getTopFilePath p) cwdmissing top = unlines [ "This view does not include the subdirectory you are currently in." , "Perhaps you should: cd " ++ top diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs index 8f1d0a0ff0..8e406b1ed7 100644 --- a/Git/UpdateIndex.hs +++ b/Git/UpdateIndex.hs @@ -118,12 +118,12 @@ unstageFile' p = pureStreamer $ L.fromStrict $ <> indexPath p {- A streamer that adds a symlink to the index. -} -stageSymlink :: FilePath -> Sha -> Repo -> IO Streamer +stageSymlink :: RawFilePath -> Sha -> Repo -> IO Streamer stageSymlink file sha repo = do !line <- updateIndexLine <$> pure sha <*> pure TreeSymlink - <*> toTopFilePath (toRawFilePath file) repo + <*> toTopFilePath file repo return $ pureStreamer line {- A streamer that applies a DiffTreeItem to the index. -} diff --git a/Limit.hs b/Limit.hs index 9caeb44e02..2de48d4a6e 100644 --- a/Limit.hs +++ b/Limit.hs @@ -333,7 +333,7 @@ limitLackingCopies approx want = case readish want of then approxNumCopies else case mi of MatchingFile fi -> getGlobalFileNumCopies $ - fromRawFilePath $ matchFile fi + matchFile fi MatchingKey _ _ -> approxNumCopies MatchingInfo {} -> approxNumCopies MatchingUserInfo {} -> approxNumCopies diff --git a/Remote/Git.hs b/Remote/Git.hs index 0b2b2718d1..d25ab6325b 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -640,8 +640,8 @@ copyFromRemoteCheap r st repo loc <- liftIO $ gitAnnexLocation key repo gc liftIO $ ifM (R.doesPathExist loc) ( do - absloc <- absPath (fromRawFilePath loc) - createSymbolicLink absloc file + absloc <- absPath loc + R.createSymbolicLink absloc (toRawFilePath file) , giveup "remote does not contain key" ) | Git.repoIsSsh repo = Just $ \key af file -> @@ -692,7 +692,7 @@ copyToRemote' repo r st@(State connpool duc _ _ _) key file meterupdate let rsp = RetrievalAllKeysSecure res <- Annex.Content.getViaTmp rsp verify key $ \dest -> metered (Just (combineMeterUpdate meterupdate p)) key $ \_ p' -> - copier object dest p' (liftIO checksuccessio) + copier object (fromRawFilePath dest) p' (liftIO checksuccessio) Annex.Content.saveState True return res ) diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 6226a2b644..813c0f1bbd 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -352,7 +352,7 @@ sendParams = ifM crippledFileSystem - up trees for rsync. -} withRsyncScratchDir :: (FilePath -> Annex a) -> Annex a withRsyncScratchDir a = do - t <- fromRepo gitAnnexTmpObjectDir + t <- fromRawFilePath <$> fromRepo gitAnnexTmpObjectDir withTmpDirIn t "rsynctmp" a rsyncRetrieve :: RsyncOpts -> [RsyncUrl] -> FilePath -> Maybe MeterUpdate -> Annex ()