more RawFilePath conversion
451/645
This commit is contained in:
parent
b4b02e4c61
commit
87f91ce563
18 changed files with 57 additions and 56 deletions
|
@ -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
|
||||
|
||||
|
|
|
@ -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 ()
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 =
|
||||
|
|
|
@ -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 ()
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ()
|
||||
|
|
|
@ -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)]
|
||||
|
|
|
@ -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 ()
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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. -}
|
||||
|
|
2
Limit.hs
2
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
|
||||
|
|
|
@ -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
|
||||
)
|
||||
|
|
|
@ -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 ()
|
||||
|
|
Loading…
Reference in a new issue