diff --git a/Annex/Drop.hs b/Annex/Drop.hs index f41118d10f..2ad9c78d49 100644 --- 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 716c2981d3..2869427fbe 100644 --- 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 058fd109d9..79c9f2f1ec 100644 --- 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 67204d0a0a..3b64526515 100644 --- 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 f1dac121d2..f5c2f8631c 100644 --- 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 94adc31803..0ab8855a77 100644 --- 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 e16b9c8b16..92074986fe 100644 --- 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 9e7c8a189d..5eb8aac42c 100644 --- 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 90026e536b..6217d3fc75 100644 --- 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 2387a07d5f..3207676a98 100644 --- 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