convert TopFilePath to use RawFilePath

Adds a dependency on filepath-bytestring, an as yet unreleased fork of
filepath that operates on RawFilePath.

Git.Repo also changed to use RawFilePath for the path to the repo.

This does eliminate some RawFilePath -> FilePath -> RawFilePath
conversions. And filepath-bytestring's </> is probably faster.
But I don't expect a major performance improvement from this.
This is mostly groundwork for making Annex.Location use RawFilePath,
which will allow for a conversion-free pipleline.
This commit is contained in:
Joey Hess 2019-12-09 13:49:05 -04:00
parent a7004375ec
commit bdec7fed9c
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
97 changed files with 323 additions and 271 deletions

View file

@ -91,4 +91,4 @@ getConfigs = S.fromList . map extract
<$> liftAnnex (inRepo $ LsTree.lsTreeFiles Annex.Branch.fullname files)
where
files = map (fromRawFilePath . fst) configFilesActions
extract treeitem = (toRawFilePath $ getTopFilePath $ LsTree.file treeitem, LsTree.sha treeitem)
extract treeitem = (getTopFilePath $ LsTree.file treeitem, LsTree.sha treeitem)

View file

@ -26,7 +26,7 @@ import qualified Command.Sync
mergeThread :: NamedThread
mergeThread = namedThread "Merger" $ do
g <- liftAnnex gitRepo
let dir = Git.localGitDir g </> "refs"
let dir = fromRawFilePath (Git.localGitDir g) </> "refs"
liftIO $ createDirectoryIfMissing True dir
let hook a = Just <$> asIO2 (runHandler a)
changehook <- hook onChange

View file

@ -159,7 +159,7 @@ handleMount urlrenderer dir = do
-}
remotesUnder :: FilePath -> Assistant [Remote]
remotesUnder dir = do
repotop <- liftAnnex $ fromRepo Git.repoPath
repotop <- liftAnnex $ fromRawFilePath <$> fromRepo Git.repoPath
rs <- liftAnnex remoteList
pairs <- liftAnnex $ mapM (checkremote repotop) rs
let (waschanged, rs') = unzip pairs

View file

@ -119,7 +119,7 @@ pairReqReceived False urlrenderer msg = do
pairAckReceived :: Bool -> Maybe PairingInProgress -> PairMsg -> [PairingInProgress] -> Assistant [PairingInProgress]
pairAckReceived True (Just pip) msg cache = do
stopSending pip
repodir <- repoPath <$> liftAnnex gitRepo
repodir <- fromRawFilePath . repoPath <$> liftAnnex gitRepo
liftIO $ setupAuthorizedKeys msg repodir
finishedLocalPairing msg (inProgressSshKeyPair pip)
startSending pip PairDone $ multicastPairMsg

View file

@ -269,5 +269,5 @@ checkOldUnused urlrenderer = go =<< annexExpireUnused <$> liftAnnex Annex.getGit
checkRepoExists :: Assistant ()
checkRepoExists = do
g <- liftAnnex gitRepo
liftIO $ unlessM (doesDirectoryExist $ Git.repoPath g) $
liftIO $ unlessM (doesDirectoryExist $ fromRawFilePath $ Git.repoPath g) $
terminateSelf

View file

@ -136,8 +136,7 @@ startupScan scanner = do
-- Notice any files that were deleted before
-- watching was started.
top <- liftAnnex $ fromRepo Git.repoPath
(fs, cleanup) <- liftAnnex $ inRepo $ LsFiles.deleted
[toRawFilePath top]
(fs, cleanup) <- liftAnnex $ inRepo $ LsFiles.deleted [top]
forM_ fs $ \f -> do
let f' = fromRawFilePath f
liftAnnex $ onDel' f'
@ -215,7 +214,7 @@ onAddUnlocked symlinkssupported matcher f fs = do
where
addassociatedfile key file =
Database.Keys.addAssociatedFile key
=<< inRepo (toTopFilePath file)
=<< inRepo (toTopFilePath (toRawFilePath file))
samefilestatus key file status = do
cache <- Database.Keys.getInodeCaches key
curr <- withTSDelta $ \delta -> liftIO $ toInodeCache delta file status
@ -225,7 +224,7 @@ onAddUnlocked symlinkssupported matcher f fs = do
_ -> return False
contentchanged oldkey file = do
Database.Keys.removeAssociatedFile oldkey
=<< inRepo (toTopFilePath file)
=<< inRepo (toTopFilePath (toRawFilePath file))
unlessM (inAnnex oldkey) $
logStatus oldkey InfoMissing
addlink file key = do
@ -347,7 +346,7 @@ onDel file _ = do
onDel' :: FilePath -> Annex ()
onDel' file = do
topfile <- inRepo (toTopFilePath file)
topfile <- inRepo (toTopFilePath (toRawFilePath file))
withkey $ flip Database.Keys.removeAssociatedFile topfile
Annex.Queue.addUpdateIndex =<<
inRepo (Git.UpdateIndex.unstageFile file)

View file

@ -100,7 +100,7 @@ webAppThread assistantdata urlrenderer noannex cannotrun postfirstrun listenhost
getreldir
| noannex = return Nothing
| otherwise = Just <$>
(relHome =<< absPath
(relHome =<< absPath . fromRawFilePath
=<< getAnnex' (fromRepo repoPath))
go tlssettings addr webapp htmlshim urlfile = do
let url = myUrl tlssettings webapp addr