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
k <- case mk of
Nothing -> do
backend <- maybe
- (chooseBackend $ fromRawFilePath $ keyFilename source)
+ (chooseBackend $ keyFilename source)
(return . Just)
preferredbackend
fst <$> genKey source meterupdate backend
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
-- 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
-- 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.
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,
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
)
, do
addLink ci file key Nothing
case mtmp of
- Just tmp -> moveAnnex key tmp
+ Just tmp -> moveAnnex key (toRawFilePath tmp)
Nothing -> return True
)
where
, providedMimeEncoding = Nothing
}
- linkunlocked mode = linkFromAnnex key file mode >>= \case
+ linkunlocked mode = linkFromAnnex key file' mode >>= \case
LinkAnnexFailed -> liftIO $
writePointerFile file' key mode
_ -> return ()
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
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 -}
{- 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
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
{- 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
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)
- 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
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 =
)
where
go a' = batchInput fmt
- (Right <$$> liftIO . relPathCwdToFile)
+ (Right . fromRawFilePath <$$> liftIO . relPathCwdToFile . toRawFilePath)
(batchCommandAction . uncurry a')
batchAnnexedFilesMatching :: BatchFormat -> AnnexedFileSeeker -> Annex ()
import Git.FilePath
import qualified Limit
import CmdLine.GitAnnex.Options
+import CmdLine.Action
import Logs
import Logs.Unused
import Types.Transfer
import qualified Database.Keys
import qualified Utility.RawFilePath as R
import Utility.Tuple
-import CmdLine.Action
import Control.Concurrent.Async
import System.Posix.Types
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)]
)
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))
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
hidden currbranch f
| allowhidden = isJust
- <$> catObjectMetaDataHidden (toRawFilePath f) currbranch
+ <$> catObjectMetaDataHidden f currbranch
| otherwise = return False
prob msg = do
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
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
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 ()
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)]
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 ()
import Annex.View
import Logs.View
+import qualified System.FilePath.ByteString as P
+
cmd :: Command
cmd = notBareRepo $
command "view" SectionMetaData "enter a view branch"
- 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
<> 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. -}
then approxNumCopies
else case mi of
MatchingFile fi -> getGlobalFileNumCopies $
- fromRawFilePath $ matchFile fi
+ matchFile fi
MatchingKey _ _ -> approxNumCopies
MatchingInfo {} -> approxNumCopies
MatchingUserInfo {} -> approxNumCopies
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 ->
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
)
- 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 ()