]> dgit.raspbian.org Git - git-annex.git/commitdiff
more RawFilePath conversion
authorJoey Hess <joeyh@joeyh.name>
Fri, 30 Oct 2020 19:55:59 +0000 (15:55 -0400)
committerJoey Hess <joeyh@joeyh.name>
Fri, 30 Oct 2020 19:55:59 +0000 (15:55 -0400)
451/645

18 files changed:
Annex/FileMatcher.hs
Annex/Ingest.hs
Annex/Link.hs
Annex/Locations.hs
Annex/NumCopies.hs
Annex/View.hs
CmdLine/Batch.hs
CmdLine/Seek.hs
Command.hs
Command/Uninit.hs
Command/Unlock.hs
Command/Unused.hs
Command/Vicfg.hs
Command/View.hs
Git/UpdateIndex.hs
Limit.hs
Remote/Git.hs
Remote/Rsync.hs

index 9aa3ca18cf755def4a185c2290da1971206cd2b1..06df41f1fdcdf7ca8e8c8e8219abe76e79be6d2f 100644 (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
 
index 0d761199f4a51d4ba376451eb75785c68b3e9918..5f6ec948f7021228b855c86d049665f48307c446 100644 (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 ()
index 12cde6a2c80a07c161c02319cecec20d7e0b838f..b9f6a662df02c73b39254bbc78030d286b315945 100644 (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
index 399bd0ce7927fd0d2cd18b5036d68d0c544536ce..ffb9763f9d91ec82ee98c9917b9992dc2d708723 100644 (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
index 8ece4bb63c37ad980d8d5382b4f85691f4b4d48f..7b80e4c48681aaa2442ab3e4dadc4852d01d3574 100644 (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
index d84f9d4ec140b05602d652ee6b4c3c9e61df5cef..5d62a8286b17740c31e2360ea02f468c5da5e143 100644 (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 =
index 4c403e33d2b6a8c790579beafb01c30cc084e260..a9fc349e531df39ea17ab514631aa253e8f3ecde 100644 (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 ()
index ed716008c779ea8eecb46e7b9ebab1a5d387cd82..1a804e01aec7c5fedb120488799ccc9a965960a1 100644 (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
index b9f02d168422c17b3d61e6e67beaed7c38643bab..6b4130bc532cf56a85aa0b94e6a27a817ed530b4 100644 (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
index de05febbaf2c034d4d337345d683fa7533932483..5f1554969009d87d90defb81f6b41f13251852bc 100644 (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
index da45243663ad6298d2185e6097b9c8889ea650b4..cfe49f19eee0d53bb6b72060f2a4ff16effe48b1 100644 (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 ()
index a83c35d9810904f5a325c38fb1ae4a0678733e32..52f43c1279950eb16d414508118c790fc739a05b 100644 (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)]
index a9959c0a8e86dfb1d20741660a198fb6626cc47e..a2029bcafb3eb21704b917ffdf0f2029d95ac397 100644 (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 ()
index 2aaed261cc36f420a73258fec5028de246d921a5..d4f82bb26e4bb719ea583445873e88886ef7ba11 100644 (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
index 8f1d0a0ff0a2e8d5471ebc6c93e211cce60d79e0..8e406b1ed71c728e4e3a504b4b0e9154f62c2db7 100644 (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. -}
index 9caeb44e02135932eb6bf4649c2e7984609bd09c..2de48d4a6e06c7ca03cfa44fb3f7efefd571a1dc 100644 (file)
--- a/Limit.hs
+++ b/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
index 0b2b2718d114d62bb8ef9c408644a0f65198c690..d25ab6325b2db2522cca06efe7063d52817fea02 100644 (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
                        )
index 6226a2b64446fc81d147feb2e63e84736ecac1f1..813c0f1bbd1452201451f34c0852dee74c5e8574 100644 (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 ()