more RawFilePath conversion

580/645

This commit was sponsored by Jack Hill on Patreon.

diff --git a/Annex/Drop.hs b/Annex/Drop.hs
index f41118d10faa209e997fda319097c14ad302844c..2ad9c78d4938bdbbf070d2d4becee89e142dd919 100644 (file)
--- a/Annex/Drop.hs
+++ b/Annex/Drop.hs
@@ -64,7 +64,7 @@ handleDropsFrom locs rs reason fromhere key afile si preverified runner = do
                (untrusted, have) <- trustPartition UnTrusted locs
                numcopies <- if null fs
                        then getNumCopies
-                       else maximum <$> mapM (getFileNumCopies . fromRawFilePath) fs
+                       else maximum <$> mapM getFileNumCopies fs
                return (NumCopies (length have), numcopies, S.fromList untrusted)
 
        {- Check that we have enough copies still to drop the content.

diff --git a/Annex/Import.hs b/Annex/Import.hs
index 716c2981d3c936d23947e59afab6ca7bfc19127a..2869427fbe094de0eec0346e0e5c0e4c1cfe3952 100644 (file)
--- a/Annex/Import.hs
+++ b/Annex/Import.hs
@@ -271,7 +271,7 @@ buildImportTrees basetree msubdir importable = History
        mktreeitem (loc, v) = case v of
                Right k -> do
                        relf <- fromRepo $ fromTopFilePath topf
-                       symlink <- calcRepo $ gitAnnexLink (fromRawFilePath relf) k
+                       symlink <- calcRepo $ gitAnnexLink relf k
                        linksha <- hashSymlink symlink
                        return $ TreeItem treepath (fromTreeItemType TreeSymlink) linksha
                Left sha -> 
@@ -538,7 +538,7 @@ importKeys remote importtreeconfig importcontent importablecontents = do
                                        backend <- chooseBackend (fromRawFilePath f)
                                        let ks = KeySource
                                                { keyFilename = f
-                                               , contentLocation = toRawFilePath tmpfile
+                                               , contentLocation = tmpfile
                                                , inodeCache = Nothing
                                                }
                                        fst <$> genKey ks nullMeterUpdate backend
@@ -671,7 +671,7 @@ matchesImportLocation matcher loc sz = checkMatcher' matcher mi mempty
 notIgnoredImportLocation :: ImportTreeConfig -> CheckGitIgnore -> ImportLocation -> Annex Bool
 notIgnoredImportLocation importtreeconfig ci loc = not <$> checkIgnored ci f
   where
-       f = fromRawFilePath $ case importtreeconfig of
+       f = case importtreeconfig of
                ImportSubTree dir _ ->
                        getTopFilePath dir P.</> fromImportLocation loc
                ImportTree ->

diff --git a/Annex/Locations.hs b/Annex/Locations.hs
index 058fd109d977186f44f609b34394dac71f3b68a6..79c9f2f1ec0924604063161eb4878a4488b35fd5 100644 (file)
--- a/Annex/Locations.hs
+++ b/Annex/Locations.hs
@@ -428,12 +428,12 @@ gitAnnexWebPrivKey :: Git.Repo -> FilePath
 gitAnnexWebPrivKey r = fromRawFilePath $ gitAnnexDir r P.</> "privkey.pem"
 
 {- .git/annex/feeds/ is used to record per-key (url) state by importfeeds -}
-gitAnnexFeedStateDir :: Git.Repo -> FilePath
-gitAnnexFeedStateDir r = fromRawFilePath $
-       P.addTrailingPathSeparator $ gitAnnexDir r P.</> "feedstate"
+gitAnnexFeedStateDir :: Git.Repo -> RawFilePath
+gitAnnexFeedStateDir r = P.addTrailingPathSeparator $
+       gitAnnexDir r P.</> "feedstate"
 
-gitAnnexFeedState :: Key -> Git.Repo -> FilePath
-gitAnnexFeedState k r = gitAnnexFeedStateDir r </> fromRawFilePath (keyFile k)
+gitAnnexFeedState :: Key -> Git.Repo -> RawFilePath
+gitAnnexFeedState k r = gitAnnexFeedStateDir r P.</> keyFile k
 
 {- .git/annex/merge/ is used as a empty work tree for direct mode merges and
  - merges in adjusted branches. -}

diff --git a/Assistant/Install.hs b/Assistant/Install.hs
index 67204d0a0a5ad1817081d5692489bd3eec68c8c3..3b64526515efd9a98aa04c6b5941d6753be03f26 100644 (file)
--- a/Assistant/Install.hs
+++ b/Assistant/Install.hs
@@ -51,7 +51,8 @@ ensureInstalled = ifM (isJust <$> getEnv "GIT_ANNEX_PACKAGE_INSTALL")
        go (Just base) = do
                let program = base </> "git-annex"
                programfile <- programFile
-               createDirectoryIfMissing True (parentDir programfile)
+               createDirectoryIfMissing True $
+                       fromRawFilePath (parentDir (toRawFilePath programfile))
                writeFile programfile program
 
 #ifdef darwin_HOST_OS
@@ -100,7 +101,7 @@ installWrapper :: FilePath -> String -> IO ()
 installWrapper file content = do
        curr <- catchDefaultIO "" $ readFileStrict file
        when (curr /= content) $ do
-               createDirectoryIfMissing True (parentDir file)
+               createDirectoryIfMissing True (fromRawFilePath (parentDir (toRawFilePath file)))
                viaTmp writeFile file content
                modifyFileMode file $ addModes [ownerExecuteMode]
 

diff --git a/Assistant/MakeRepo.hs b/Assistant/MakeRepo.hs
index f1dac121d26e602260559de1a59a4a4f17214d01..f5c2f8631c70a69f082c8e12f7a86ce832c91e6e 100644 (file)
--- a/Assistant/MakeRepo.hs
+++ b/Assistant/MakeRepo.hs
@@ -46,7 +46,9 @@ makeRepo path bare = ifM (probeRepoExists path)
 {- Runs an action in the git repository in the specified directory. -}
 inDir :: FilePath -> Annex a -> IO a
 inDir dir a = do
-       state <- Annex.new =<< Git.Config.read =<< Git.Construct.fromPath dir
+       state <- Annex.new
+               =<< Git.Config.read
+               =<< Git.Construct.fromPath (toRawFilePath dir)
        Annex.eval state $ a `finally` stopCoProcesses
 
 {- Creates a new repository, and returns its UUID. -}

diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs
index 94adc31803566342f74c54267081e20fc5f1c542..0ab8855a778f384138ce5ed18508c09347e335a8 100644 (file)
--- a/Assistant/Threads/Watcher.hs
+++ b/Assistant/Threads/Watcher.hs
@@ -335,7 +335,8 @@ addLink file link mk = do
                        Just (currlink, sha, _type)
                                | s2w8 link == L.unpack currlink ->
                                        stageSymlink (toRawFilePath file) sha
-                       _ -> stageSymlink (toRawFilePath file) =<< hashSymlink link
+                       _ -> stageSymlink (toRawFilePath file)
+                               =<< hashSymlink (toRawFilePath link)
        madeChange file $ LinkChange mk
 
 onDel :: Handler

diff --git a/Assistant/WebApp/Configurators/Preferences.hs b/Assistant/WebApp/Configurators/Preferences.hs
index e16b9c8b16c3473e61baa7a127f5c853e3832f8d..92074986fef4e7a8af64ad275cd58de58838e9c3 100644 (file)
--- a/Assistant/WebApp/Configurators/Preferences.hs
+++ b/Assistant/WebApp/Configurators/Preferences.hs
@@ -118,5 +118,6 @@ postPreferencesR = page "Preferences" (Just Configuration) $ do
 
 inAutoStartFile :: Annex Bool
 inAutoStartFile = do
-       here <- liftIO . absPath . fromRawFilePath =<< fromRepo Git.repoPath
-       any (`equalFilePath` here) <$> liftIO readAutoStartFile
+       here <- liftIO . absPath =<< fromRepo Git.repoPath
+       any (`equalFilePath` here) . toRawFilePath
+               <$> liftIO readAutoStartFile

diff --git a/CmdLine/GitAnnexShell/Checks.hs b/CmdLine/GitAnnexShell/Checks.hs
index 9e7c8a189df1e56ba3438fee179f02f3b7e5cfe9..5eb8aac42c0b32117748f4c7efbee9926279d0ed 100644 (file)
--- a/CmdLine/GitAnnexShell/Checks.hs
+++ b/CmdLine/GitAnnexShell/Checks.hs
@@ -71,7 +71,9 @@ checkDirectory mdir = do
        canondir home d
                | "~/" `isPrefixOf` d = return d
                | "/~/" `isPrefixOf` d = return $ drop 1 d
-               | otherwise = relHome $ absPathFrom home d
+               | otherwise = relHome $ fromRawFilePath <$> absPathFrom
+                       (toRawFilePath home)
+                       (toRawFilePath d)
 
 {- Modifies a Command to check that it is run in either a git-annex
  - repository, or a repository with a gcrypt-id set. -}

diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index 90026e536b0e516b1085fbb4976d4132527bd93a..6217d3fc75c7f95ef480a8c0364c34fe7907e154 100644 (file)
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -165,14 +165,15 @@ checkUrl addunlockedmatcher r o si u = do
 startRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> SeekInput -> FilePath -> URLString -> Maybe Integer -> CommandStart
 startRemote addunlockedmatcher r o si file uri sz = do
        pathmax <- liftIO $ fileNameLengthLimit "."
-       let file' = joinPath $ map (truncateFilePath pathmax) $ splitDirectories file
+       let file' = joinPath $ map (truncateFilePath pathmax) $
+               splitDirectories file
        startingAddUrl si uri o $ do
                showNote $ "from " ++ Remote.name r 
                showDestinationFile file'
-               performRemote addunlockedmatcher r o uri file' sz
+               performRemote addunlockedmatcher r o uri (toRawFilePath file') sz
 
-performRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> URLString -> FilePath -> Maybe Integer -> CommandPerform
-performRemote addunlockedmatcher r o uri file sz = ifAnnexed (toRawFilePath file) adduri geturi
+performRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> URLString -> RawFilePath -> Maybe Integer -> CommandPerform
+performRemote addunlockedmatcher r o uri file sz = ifAnnexed file adduri geturi
   where
        loguri = setDownloader uri OtherDownloader
        adduri = addUrlChecked o loguri file (Remote.uuid r) checkexistssize
@@ -181,10 +182,10 @@ performRemote addunlockedmatcher r o uri file sz = ifAnnexed (toRawFilePath file
                Just n -> (True, n == fromMaybe n (fromKey keySize key), loguri)
        geturi = next $ isJust <$> downloadRemoteFile addunlockedmatcher r (downloadOptions o) uri file sz
 
-downloadRemoteFile :: AddUnlockedMatcher -> Remote -> DownloadOptions -> URLString -> FilePath -> Maybe Integer -> Annex (Maybe Key)
+downloadRemoteFile :: AddUnlockedMatcher -> Remote -> DownloadOptions -> URLString -> RawFilePath -> Maybe Integer -> Annex (Maybe Key)
 downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd o file $ \canadd -> do
        let urlkey = Backend.URL.fromUrl uri sz
-       createWorkTreeDirectory (parentDir (toRawFilePath file))
+       createWorkTreeDirectory (parentDir file)
        ifM (Annex.getState Annex.fast <||> pure (relaxedOption o))
                ( do
                        addWorkTree canadd addunlockedmatcher (Remote.uuid r) loguri file urlkey Nothing
@@ -202,7 +203,7 @@ downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd o file $ \ca
                )
   where
        loguri = setDownloader uri OtherDownloader
-       af = AssociatedFile (Just (toRawFilePath file))
+       af = AssociatedFile (Just file)
 
 startWeb :: AddUnlockedMatcher -> AddUrlOptions -> SeekInput -> URLString -> CommandStart
 startWeb addunlockedmatcher o si urlstring = go $ fromMaybe bad $ parseURI urlstring
@@ -231,7 +232,7 @@ startWeb addunlockedmatcher o si urlstring = go $ fromMaybe bad $ parseURI urlst
                                                        , pure f
                                                        )
                                _ -> pure $ url2file url (pathdepthOption o) pathmax
-               performWeb addunlockedmatcher o urlstring file urlinfo
+               performWeb addunlockedmatcher o urlstring (toRawFilePath file) urlinfo
 
 sanitizeOrPreserveFilePath :: AddUrlOptions -> FilePath -> Annex FilePath
 sanitizeOrPreserveFilePath o f
@@ -257,8 +258,8 @@ checkPreserveFileNameSecurity f = do
                        , "has a security problem (" ++ d ++ "), not adding."
                        ]
 
-performWeb :: AddUnlockedMatcher -> AddUrlOptions -> URLString -> FilePath -> Url.UrlInfo -> CommandPerform
-performWeb addunlockedmatcher o url file urlinfo = ifAnnexed (toRawFilePath file) addurl geturl
+performWeb :: AddUnlockedMatcher -> AddUrlOptions -> URLString -> RawFilePath -> Url.UrlInfo -> CommandPerform
+performWeb addunlockedmatcher o url file urlinfo = ifAnnexed file addurl geturl
   where
        geturl = next $ isJust <$> addUrlFile addunlockedmatcher (downloadOptions o) url urlinfo file
        addurl = addUrlChecked o url file webUUID $ \k ->
@@ -269,11 +270,11 @@ performWeb addunlockedmatcher o url file urlinfo = ifAnnexed (toRawFilePath file
 
 {- Check that the url exists, and has the same size as the key,
  - and add it as an url to the key. -}
-addUrlChecked :: AddUrlOptions -> URLString -> FilePath -> UUID -> (Key -> Annex (Bool, Bool, URLString)) -> Key -> CommandPerform
+addUrlChecked :: AddUrlOptions -> URLString -> RawFilePath -> UUID -> (Key -> Annex (Bool, Bool, URLString)) -> Key -> CommandPerform
 addUrlChecked o url file u checkexistssize key =
        ifM ((elem url <$> getUrls key) <&&> (elem u <$> loggedLocations key))
                ( do
-                       showDestinationFile file
+                       showDestinationFile (fromRawFilePath file)
                        next $ return True
                , do
                        (exists, samesize, url') <- checkexistssize key
@@ -295,35 +296,35 @@ addUrlChecked o url file u checkexistssize key =
  - different file, based on the title of the media. Unless the user
  - specified fileOption, which then forces using the FilePath.
  -}
-addUrlFile :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key)
+addUrlFile :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> RawFilePath -> Annex (Maybe Key)
 addUrlFile addunlockedmatcher o url urlinfo file =
        ifM (Annex.getState Annex.fast <||> pure (relaxedOption o))
                ( nodownloadWeb addunlockedmatcher o url urlinfo file
                , downloadWeb addunlockedmatcher o url urlinfo file
                )
 
-downloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key)
+downloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> RawFilePath -> Annex (Maybe Key)
 downloadWeb addunlockedmatcher o url urlinfo file =
-       go =<< downloadWith' downloader urlkey webUUID url (AssociatedFile (Just (toRawFilePath file)))
+       go =<< downloadWith' downloader urlkey webUUID url (AssociatedFile (Just file))
   where
        urlkey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing
        downloader f p = Url.withUrlOptions $ downloadUrl urlkey p [url] f
        go Nothing = return Nothing
-       go (Just tmp) = ifM (pure (not (rawOption o)) <&&> liftIO (isHtml <$> readFile tmp))
+       go (Just tmp) = ifM (pure (not (rawOption o)) <&&> liftIO (isHtml <$> readFile (fromRawFilePath tmp)))
                ( tryyoutubedl tmp
                , normalfinish tmp
                )
        normalfinish tmp = checkCanAdd o file $ \canadd -> do
-               showDestinationFile file
-               createWorkTreeDirectory (parentDir (toRawFilePath file))
+               showDestinationFile (fromRawFilePath file)
+               createWorkTreeDirectory (parentDir file)
                Just <$> finishDownloadWith canadd addunlockedmatcher tmp webUUID url file
        -- Ask youtube-dl what filename it will download first, 
        -- so it's only used when the file contains embedded media.
        tryyoutubedl tmp = youtubeDlFileNameHtmlOnly url >>= \case
                Right mediafile -> 
-                       let f = youtubeDlDestFile o file mediafile
-                       in ifAnnexed (toRawFilePath f)
-                               (alreadyannexed f)
+                       let f = youtubeDlDestFile o file (toRawFilePath mediafile)
+                       in ifAnnexed f
+                               (alreadyannexed (fromRawFilePath f))
                                (dl f)
                Left _ -> normalfinish tmp
          where
@@ -332,12 +333,12 @@ downloadWeb addunlockedmatcher o url urlinfo file =
                        showNote "using youtube-dl"
                        Transfer.notifyTransfer Transfer.Download url $
                                Transfer.download webUUID mediakey (AssociatedFile Nothing) Transfer.noRetry $ \p ->
-                                       youtubeDl url workdir p >>= \case
+                                       youtubeDl url (fromRawFilePath workdir) p >>= \case
                                                Right (Just mediafile) -> do
                                                        cleanuptmp
                                                        checkCanAdd o dest $ \canadd -> do
-                                                               showDestinationFile dest
-                                                               addWorkTree canadd addunlockedmatcher webUUID mediaurl dest mediakey (Just mediafile)
+                                                               showDestinationFile (fromRawFilePath dest)
+                                                               addWorkTree canadd addunlockedmatcher webUUID mediaurl dest mediakey (Just (toRawFilePath mediafile))
                                                                return $ Just mediakey
                                                Right Nothing -> normalfinish tmp
                                                Left msg -> do
@@ -380,24 +381,24 @@ showDestinationFile file = do
  - Downloads the url, sets up the worktree file, and returns the
  - real key.
  -}
-downloadWith :: CanAddFile -> AddUnlockedMatcher -> (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> FilePath -> Annex (Maybe Key)
+downloadWith :: CanAddFile -> AddUnlockedMatcher -> (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> RawFilePath -> Annex (Maybe Key)
 downloadWith canadd addunlockedmatcher downloader dummykey u url file =
        go =<< downloadWith' downloader dummykey u url afile
   where
-       afile = AssociatedFile (Just (toRawFilePath file))
+       afile = AssociatedFile (Just file)
        go Nothing = return Nothing
        go (Just tmp) = Just <$> finishDownloadWith canadd addunlockedmatcher tmp u url file
 
 {- Like downloadWith, but leaves the dummy key content in
  - the returned location. -}
-downloadWith' :: (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> AssociatedFile -> Annex (Maybe FilePath)
+downloadWith' :: (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLString -> AssociatedFile -> Annex (Maybe RawFilePath)
 downloadWith' downloader dummykey u url afile =
        checkDiskSpaceToGet dummykey Nothing $ do
                tmp <- fromRepo $ gitAnnexTmpObjectLocation dummykey
                ok <- Transfer.notifyTransfer Transfer.Download url $
                        Transfer.download u dummykey afile Transfer.stdRetry $ \p -> do
                                createAnnexDirectory (parentDir tmp)
-                               downloader tmp p
+                               downloader (fromRawFilePath tmp) p
                if ok
                        then return (Just tmp)
                        else return Nothing
@@ -406,8 +407,8 @@ finishDownloadWith :: CanAddFile -> AddUnlockedMatcher -> RawFilePath -> UUID ->
 finishDownloadWith canadd addunlockedmatcher tmp u url file = do
        backend <- chooseBackend file
        let source = KeySource
-               { keyFilename = toRawFilePath file
-               , contentLocation = toRawFilePath tmp
+               { keyFilename = file
+               , contentLocation = tmp
                , inodeCache = Nothing
                }
        key <- fst <$> genKey source nullMeterUpdate backend

diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs
index 2387a07d5fc07008c4a3860b0c476f14d498ff05..3207676a9888b7a6149350965b845448fb9b742b 100644 (file)
--- a/Command/ImportFeed.hs
+++ b/Command/ImportFeed.hs
@@ -454,9 +454,10 @@ feedProblem url message = ifM (checkFeedBroken url)
  - least 23 hours. -}
 checkFeedBroken :: URLString -> Annex Bool
 checkFeedBroken url = checkFeedBroken' url =<< feedState url
-checkFeedBroken' :: URLString -> FilePath -> Annex Bool
+checkFeedBroken' :: URLString -> RawFilePath -> Annex Bool
 checkFeedBroken' url f = do
-       prev <- maybe Nothing readish <$> liftIO (catchMaybeIO $ readFile f)
+       prev <- maybe Nothing readish
+               <$> liftIO (catchMaybeIO $ readFile (fromRawFlePath f))
        now <- liftIO getCurrentTime
        case prev of
                Nothing -> do
@@ -471,7 +472,9 @@ checkFeedBroken' url f = do
                        return broken
 
 clearFeedProblem :: URLString -> Annex ()
-clearFeedProblem url = void $ liftIO . tryIO . removeFile =<< feedState url
+clearFeedProblem url =
+       void $ liftIO . tryIO . removeFile . fromRawFilePath
+               =<< feedState url
 
-feedState :: URLString -> Annex FilePath
+feedState :: URLString -> Annex RawFilePath
 feedState url = fromRepo $ gitAnnexFeedState $ fromUrl url Nothing