more RawFilePath conversion

451/645
This commit is contained in:
Joey Hess 2020-10-30 15:55:59 -04:00
parent b4b02e4c61
commit 87f91ce563
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
18 changed files with 57 additions and 56 deletions

View file

@ -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

View file

@ -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 ()

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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 =

View file

@ -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 ()

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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 ()

View file

@ -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)]

View file

@ -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 ()

View file

@ -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

View file

@ -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. -}

View file

@ -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

View file

@ -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
)

View file

@ -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 ()