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:
parent
a7004375ec
commit
bdec7fed9c
97 changed files with 323 additions and 271 deletions
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue