more RawFilePath conversion
authorJoey Hess <joeyh@joeyh.name>
Tue, 3 Nov 2020 14:11:04 +0000 (10:11 -0400)
committerJoey Hess <joeyh@joeyh.name>
Tue, 3 Nov 2020 14:11:04 +0000 (10:11 -0400)
535/645

This commit was sponsored by Brett Eisenberg on Patreon.

23 files changed:
Annex/CheckIgnore.hs
Annex/Content/PointerFile.hs
Annex/Ingest.hs
Annex/Locations.hs
Annex/Perms.hs
Command/Add.hs
Command/AddUnused.hs
Command/AddUrl.hs
Command/Copy.hs
Command/DropUnused.hs
Command/Fix.hs
Command/FromKey.hs
Command/Fsck.hs
Command/Get.hs
Command/Lock.hs
Command/Migrate.hs
Command/Mirror.hs
Command/Move.hs
Command/ReKey.hs
Git/CheckIgnore.hs
Logs/File.hs
Logs/Smudge.hs
Utility/Touch.hs

index e3252d8cd9f8f35c5575ea0289922ca5c6c0ef1b..42e635b6670199c11c2130c7b2b9ecee12afd16f 100644 (file)
@@ -22,7 +22,7 @@ import Annex.Concurrent.Utility
 
 newtype CheckGitIgnore = CheckGitIgnore Bool
 
-checkIgnored :: CheckGitIgnore -> FilePath -> Annex Bool
+checkIgnored :: CheckGitIgnore -> RawFilePath -> Annex Bool
 checkIgnored (CheckGitIgnore False) _ = pure False
 checkIgnored (CheckGitIgnore True) file =
        ifM (Annex.getState Annex.force)
index 7c7881e0cbfacea5cd4306bd249c9fe88f0ab532..e13f2ad1ae5ba16cb8a4d33f0f5ed5b8e612ea17 100644 (file)
@@ -64,12 +64,13 @@ depopulatePointerFile key file = do
        secureErase file
        liftIO $ removeWhenExistsWith R.removeLink file
        ic <- replaceWorkTreeFile file' $ \tmp -> do
-               liftIO $ writePointerFile (toRawFilePath tmp) key mode
+               let tmp' = toRawFilePath tmp
+               liftIO $ writePointerFile tmp' key mode
 #if ! defined(mingw32_HOST_OS)
                -- Don't advance mtime; this avoids unncessary re-smudging
                -- by git in some cases.
                liftIO $ maybe noop
-                       (\t -> touch tmp t False)
+                       (\t -> touch tmp' t False)
                        (fmap modificationTimeHiRes st)
 #endif
                withTSDelta (liftIO . genInodeCache (toRawFilePath tmp))
index 5f6ec948f7021228b855c86d049665f48307c446..c83af52f91b6a4c69dcad34cf0d41c5c104d9159 100644 (file)
@@ -61,7 +61,7 @@ data LockedDown = LockedDown
 data LockDownConfig = LockDownConfig
        { lockingFile :: Bool
        -- ^ write bit removed during lock down
-       , hardlinkFileTmpDir :: Maybe FilePath
+       , hardlinkFileTmpDir :: Maybe RawFilePath
        -- ^ hard link to temp directory
        }
        deriving (Show)
@@ -109,7 +109,7 @@ lockDown' cfg file = tryIO $ ifM crippledFileSystem
                when (lockingFile cfg) $
                        freezeContent file
                withTSDelta $ \delta -> liftIO $ do
-                       (tmpfile, h) <- openTempFile tmpdir $
+                       (tmpfile, h) <- openTempFile (fromRawFilePath tmpdir) $
                                relatedTemplate $ "ingest-" ++ takeFileName file
                        hClose h
                        removeWhenExistsWith removeLink tmpfile
@@ -139,7 +139,7 @@ ingestAdd' ci meterupdate ld@(Just (LockedDown cfg source)) mk = do
                Just k -> do
                        let f = keyFilename source
                        if lockingFile cfg
-                               then addLink ci (fromRawFilePath f) k mic
+                               then addLink ci f k mic
                                else do
                                        mode <- liftIO $ catchMaybeIO $
                                                fileMode <$> R.getFileStatus (contentLocation source)
@@ -272,10 +272,10 @@ restoreFile file key e = do
        throwM e
 
 {- Creates the symlink to the annexed content, returns the link target. -}
-makeLink :: FilePath -> Key -> Maybe InodeCache -> Annex LinkTarget
-makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do
-       l <- calcRepo $ gitAnnexLink (toRawFilePath file) key
-       replaceWorkTreeFile file $ makeAnnexLink l . toRawFilePath
+makeLink :: RawFilePath -> Key -> Maybe InodeCache -> Annex LinkTarget
+makeLink file key mcache = flip catchNonAsync (restoreFile file' key) $ do
+       l <- calcRepo $ gitAnnexLink file key
+       replaceWorkTreeFile file' $ makeAnnexLink l . toRawFilePath
 
        -- touch symlink to have same time as the original file,
        -- as provided in the InodeCache
@@ -284,6 +284,8 @@ makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do
                Nothing -> noop
 
        return l
+  where
+       file' = fromRawFilePath file
 
 {- Creates the symlink to the annexed content, and stages it in git.
  -
@@ -294,15 +296,15 @@ makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do
  - Also, using git add allows it to skip gitignored files, unless forced
  - to include them.
  -}
-addLink :: CheckGitIgnore -> FilePath -> Key -> Maybe InodeCache -> Annex ()
+addLink :: CheckGitIgnore -> RawFilePath -> Key -> Maybe InodeCache -> Annex ()
 addLink ci file key mcache = ifM (coreSymlinks <$> Annex.getGitConfig)
        ( do
                _ <- makeLink file key mcache
                ps <- gitAddParams ci
-               Annex.Queue.addCommand "add" (ps++[Param "--"]) [file]
+               Annex.Queue.addCommand "add" (ps++[Param "--"]) [fromRawFilePath file]
        , do
                l <- makeLink file key mcache
-               addAnnexLink l (toRawFilePath file)
+               addAnnexLink l file
        )
 
 {- Parameters to pass to git add, forcing addition of ignored files.
@@ -339,17 +341,17 @@ addUnlocked matcher mi =
  -
  - When the content of the key is not accepted into the annex, returns False.
  -}
-addAnnexedFile :: CheckGitIgnore -> AddUnlockedMatcher -> FilePath -> Key -> Maybe FilePath -> Annex Bool
+addAnnexedFile :: CheckGitIgnore -> AddUnlockedMatcher -> RawFilePath -> Key -> Maybe RawFilePath -> Annex Bool
 addAnnexedFile ci matcher file key mtmp = ifM (addUnlocked matcher mi)
        ( do
                mode <- maybe
                        (pure Nothing)
-                       (\tmp -> liftIO $ catchMaybeIO $ fileMode <$> getFileStatus tmp)
+                       (\tmp -> liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus tmp)
                        mtmp
-               stagePointerFile file' mode =<< hashPointerFile key
-               Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file')
+               stagePointerFile file mode =<< hashPointerFile key
+               Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file)
                case mtmp of
-                       Just tmp -> ifM (moveAnnex key (toRawFilePath tmp))
+                       Just tmp -> ifM (moveAnnex key tmp)
                                ( linkunlocked mode >> return True
                                , writepointer mode >> return False
                                )
@@ -360,19 +362,19 @@ addAnnexedFile ci matcher file key mtmp = ifM (addUnlocked matcher mi)
        , do
                addLink ci file key Nothing
                case mtmp of
-                       Just tmp -> moveAnnex key (toRawFilePath tmp)
+                       Just tmp -> moveAnnex key tmp
                        Nothing -> return True
        )
   where
        mi = case mtmp of
                Just tmp -> MatchingFile $ FileInfo
-                       { contentFile = Just (toRawFilePath tmp)
-                       , matchFile = file'
+                       { contentFile = Just tmp
+                       , matchFile = file
                        }
                -- Provide as much info as we can without access to the
                -- file's content.
                Nothing -> MatchingInfo $ ProvidedInfo
-                       { providedFilePath = file'
+                       { providedFilePath = file
                        , providedKey = Just key
                        , providedFileSize = fromMaybe 0 $
                                keySize `fromKey` key
@@ -380,10 +382,8 @@ addAnnexedFile ci matcher file key mtmp = ifM (addUnlocked matcher mi)
                        , providedMimeEncoding = Nothing
                        }
        
-       linkunlocked mode = linkFromAnnex key file' mode >>= \case
-               LinkAnnexFailed -> liftIO $
-                       writePointerFile file' key mode
+       linkunlocked mode = linkFromAnnex key file mode >>= \case
+               LinkAnnexFailed -> liftIO $ writepointer mode
                _ -> return ()
-       writepointer mode = liftIO $ writePointerFile file' key mode
-
-       file' = toRawFilePath file
+       
+       writepointer mode = liftIO $ writePointerFile file key mode
index ffb9763f9d91ec82ee98c9917b9992dc2d708723..058fd109d977186f44f609b34394dac71f3b68a6 100644 (file)
@@ -362,19 +362,19 @@ gitAnnexFsckResultsLog u r =
 
 {- .git/annex/smudge.log is used to log smudges worktree files that need to
  - be updated. -}
-gitAnnexSmudgeLog :: Git.Repo -> FilePath
-gitAnnexSmudgeLog r = fromRawFilePath $ gitAnnexDir r P.</> "smudge.log"
+gitAnnexSmudgeLog :: Git.Repo -> RawFilePath
+gitAnnexSmudgeLog r = gitAnnexDir r P.</> "smudge.log"
 
 gitAnnexSmudgeLock :: Git.Repo -> RawFilePath
 gitAnnexSmudgeLock r = gitAnnexDir r P.</> "smudge.lck"
 
 {- .git/annex/move.log is used to log moves that are in progress,
  - to better support resuming an interrupted move. -}
-gitAnnexMoveLog :: Git.Repo -> FilePath
-gitAnnexMoveLog r = fromRawFilePath $ gitAnnexDir r P.</> "move.log"
+gitAnnexMoveLog :: Git.Repo -> RawFilePath
+gitAnnexMoveLog r = gitAnnexDir r P.</> "move.log"
 
-gitAnnexMoveLock :: Git.Repo -> FilePath
-gitAnnexMoveLock r = fromRawFilePath $ gitAnnexDir r P.</> "move.lck"
+gitAnnexMoveLock :: Git.Repo -> RawFilePath
+gitAnnexMoveLock r = gitAnnexDir r P.</> "move.lck"
 
 {- .git/annex/export/ is used to store information about
  - exports to special remotes. -}
index ffeb910bb281544609d2b01d69bc0ef33d3a66bc..26e30a147008fb23078e1828b05f1ad7c8735590 100644 (file)
@@ -143,7 +143,7 @@ freezeContent file = unlessM crippledFileSystem $
                removeModes writeModes .
                addModes [ownerReadMode]
 
-isContentWritePermOk :: FilePath -> Annex Bool
+isContentWritePermOk :: RawFilePath -> Annex Bool
 isContentWritePermOk file = ifM crippledFileSystem
        ( return True
        , withShared go
@@ -153,7 +153,7 @@ isContentWritePermOk file = ifM crippledFileSystem
        go AllShared = want writeModes
        go _ = return True
        want wantmode =
-               liftIO (catchMaybeIO $ fileMode <$> getFileStatus file) >>= return . \case
+               liftIO (catchMaybeIO $ fileMode <$> R.getFileStatus file) >>= return . \case
                        Nothing -> True
                        Just havemode -> havemode == combineModes (havemode:wantmode)
 
index 6aecce8d0c40210fa38521b3d180a361da40b79b..3b411c8f10094f3f0f282dd41ac2208ba39ac825 100644 (file)
@@ -81,8 +81,9 @@ seek o = startConcurrency commandStages $ do
        annexdotfiles <- getGitConfigVal annexDotFiles 
        let gofile (si, file) = case largeFilesOverride o of
                Nothing -> 
-                       let file' = fromRawFilePath file
-                       in ifM (pure (annexdotfiles || not (dotfile file')) <&&> (checkFileMatcher largematcher file' <||> Annex.getState Annex.force))
+                       ifM (pure (annexdotfiles || not (dotfile file))
+                               <&&> (checkFileMatcher largematcher file 
+                               <||> Annex.getState Annex.force))
                                ( start o si file addunlockedmatcher
                                , ifM (annexAddSmallFiles <$> Annex.getGitConfig)
                                        ( startSmall o si file
@@ -128,20 +129,19 @@ startSmallOverridden o si file =
 addSmallOverridden :: AddOptions -> RawFilePath -> Annex Bool
 addSmallOverridden o file = do
        showNote "adding content to git repository"
-       let file' = fromRawFilePath file
-       s <- liftIO $ getSymbolicLinkStatus file'
+       s <- liftIO $ R.getSymbolicLinkStatus file
        if not (isRegularFile s)
                then addFile (checkGitIgnoreOption o) file
                else do
                        -- Can't use addFile because the clean filter will
                        -- honor annex.largefiles and it has been overridden.
                        -- Instead, hash the file and add to the index.
-                       sha <- hashFile file'
+                       sha <- hashFile file
                        let ty = if isExecutable (fileMode s)
                                then TreeExecutable
                                else TreeFile
                        Annex.Queue.addUpdateIndex =<<
-                               inRepo (Git.UpdateIndex.stageFile sha ty file')
+                               inRepo (Git.UpdateIndex.stageFile sha ty (fromRawFilePath file))
                        return True
 
 addFile :: CheckGitIgnore -> RawFilePath -> Annex Bool
@@ -172,7 +172,7 @@ start o si file addunlockedmatcher = do
        fixuplink key = starting "add" (ActionItemWorkTreeFile file) si $ do
                -- the annexed symlink is present but not yet added to git
                liftIO $ removeFile (fromRawFilePath file)
-               addLink (checkGitIgnoreOption o) (fromRawFilePath file) key Nothing
+               addLink (checkGitIgnoreOption o) file key Nothing
                next $
                        cleanup key =<< inAnnex key
        fixuppointer key = starting "add" (ActionItemWorkTreeFile file) si $ do
index 23ff4aed005bcef4172b85a38da3e2c57bee5e6f..828e53d8a333cfa6b4e46e4cad0fba99b134dc27 100644 (file)
@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Command.AddUnused where
 
 import Logs.Location
@@ -33,7 +35,7 @@ perform key = next $ do
        addLink (CheckGitIgnore False) file key Nothing
        return True
   where
-       file = "unused." ++ fromRawFilePath (keyFile key)
+       file = "unused." <> keyFile key
 
 {- The content is not in the annex, but in another directory, and
  - it seems better to error out, rather than moving bad/tmp content into
index d39e9cd5836715a71ece99ad1f5effc7e4a6f74a..90026e536b0e516b1085fbb4976d4132527bd93a 100644 (file)
@@ -7,8 +7,6 @@
 
 module Command.AddUrl where
 
-import Network.URI
-
 import Command
 import Backend
 import qualified Annex
@@ -32,8 +30,12 @@ import Logs.Location
 import Utility.Metered
 import Utility.HtmlDetect
 import Utility.Path.Max
+import qualified Utility.RawFilePath as R
 import qualified Annex.Transfer as Transfer
 
+import Network.URI
+import qualified System.FilePath.ByteString as P
+
 cmd :: Command
 cmd = notBareRepo $ withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption] $
        command "addurl" SectionCommon "add urls to annex"
@@ -182,7 +184,7 @@ performRemote addunlockedmatcher r o uri file sz = ifAnnexed (toRawFilePath file
 downloadRemoteFile :: AddUnlockedMatcher -> Remote -> DownloadOptions -> URLString -> FilePath -> 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 file)
+       createWorkTreeDirectory (parentDir (toRawFilePath file))
        ifM (Annex.getState Annex.fast <||> pure (relaxedOption o))
                ( do
                        addWorkTree canadd addunlockedmatcher (Remote.uuid r) loguri file urlkey Nothing
@@ -313,7 +315,7 @@ downloadWeb addunlockedmatcher o url urlinfo file =
                )
        normalfinish tmp = checkCanAdd o file $ \canadd -> do
                showDestinationFile file
-               createWorkTreeDirectory (parentDir file)
+               createWorkTreeDirectory (parentDir (toRawFilePath 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.
@@ -326,7 +328,7 @@ downloadWeb addunlockedmatcher o url urlinfo file =
                Left _ -> normalfinish tmp
          where
                dl dest = withTmpWorkDir mediakey $ \workdir -> do
-                       let cleanuptmp = pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith removeLink)
+                       let cleanuptmp = pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith R.removeLink)
                        showNote "using youtube-dl"
                        Transfer.notifyTransfer Transfer.Download url $
                                Transfer.download webUUID mediakey (AssociatedFile Nothing) Transfer.noRetry $ \p ->
@@ -400,7 +402,7 @@ downloadWith' downloader dummykey u url afile =
                        then return (Just tmp)
                        else return Nothing
 
-finishDownloadWith :: CanAddFile -> AddUnlockedMatcher -> FilePath -> UUID -> URLString -> FilePath -> Annex Key
+finishDownloadWith :: CanAddFile -> AddUnlockedMatcher -> RawFilePath -> UUID -> URLString -> RawFilePath -> Annex Key
 finishDownloadWith canadd addunlockedmatcher tmp u url file = do
        backend <- chooseBackend file
        let source = KeySource
@@ -419,14 +421,16 @@ addSizeUrlKey urlinfo key = alterKey key $ \d -> d
        }
 
 {- Adds worktree file to the repository. -}
-addWorkTree :: CanAddFile -> AddUnlockedMatcher -> UUID -> URLString -> FilePath -> Key -> Maybe FilePath -> Annex ()
+addWorkTree :: CanAddFile -> AddUnlockedMatcher -> UUID -> URLString -> RawFilePath -> Key -> Maybe RawFilePath -> Annex ()
 addWorkTree _ addunlockedmatcher u url file key mtmp = case mtmp of
        Nothing -> go
        Just tmp -> do
                -- Move to final location for large file check.
                pruneTmpWorkDirBefore tmp $ \_ -> do
-                       createWorkTreeDirectory (takeDirectory file)
-                       liftIO $ renameFile tmp file
+                       createWorkTreeDirectory (P.takeDirectory file)
+                       liftIO $ renameFile 
+                               (fromRawFilePath tmp)
+                               (fromRawFilePath file)
                largematcher <- largeFilesMatcher
                large <- checkFileMatcher largematcher file
                if large
@@ -434,9 +438,11 @@ addWorkTree _ addunlockedmatcher u url file key mtmp = case mtmp of
                                -- Move back to tmp because addAnnexedFile
                                -- needs the file in a different location
                                -- than the work tree file.
-                               liftIO $ renameFile file tmp
+                               liftIO $ renameFile
+                                       (fromRawFilePath file)
+                                       (fromRawFilePath tmp)
                                go
-                       else void $ Command.Add.addSmall noci (toRawFilePath file)
+                       else void $ Command.Add.addSmall noci file
   where
        go = do
                maybeShowJSON $ JSONChunk [("key", serializeKey key)]
@@ -446,18 +452,18 @@ addWorkTree _ addunlockedmatcher u url file key mtmp = case mtmp of
                        ( do
                                when (isJust mtmp) $
                                        logStatus key InfoPresent
-                       , maybe noop (\tmp -> pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith removeLink)) mtmp
+                       , maybe noop (\tmp -> pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith R.removeLink)) mtmp
                        )
        
        -- git does not need to check ignores, because that has already
        -- been done, as witnessed by the CannAddFile.
        noci = CheckGitIgnore False
 
-nodownloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key)
+nodownloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> RawFilePath -> Annex (Maybe Key)
 nodownloadWeb addunlockedmatcher o url urlinfo file
        | Url.urlExists urlinfo = if rawOption o
                then nomedia
-               else either (const nomedia) usemedia
+               else either (const nomedia) (usemedia . toRawFilePath)
                        =<< youtubeDlFileName url
        | otherwise = do
                warning $ "unable to access url: " ++ url
@@ -472,14 +478,14 @@ nodownloadWeb addunlockedmatcher o url urlinfo file
                let mediakey = Backend.URL.fromUrl mediaurl Nothing
                nodownloadWeb' o addunlockedmatcher mediaurl mediakey dest
 
-youtubeDlDestFile :: DownloadOptions -> FilePath -> FilePath -> FilePath
+youtubeDlDestFile :: DownloadOptions -> RawFilePath -> RawFilePath -> RawFilePath
 youtubeDlDestFile o destfile mediafile
        | isJust (fileOption o) = destfile
-       | otherwise = takeFileName mediafile
+       | otherwise = P.takeFileName mediafile
 
-nodownloadWeb' :: DownloadOptions -> AddUnlockedMatcher -> URLString -> Key -> FilePath -> Annex (Maybe Key)
+nodownloadWeb' :: DownloadOptions -> AddUnlockedMatcher -> URLString -> Key -> RawFilePath -> Annex (Maybe Key)
 nodownloadWeb' o addunlockedmatcher url key file = checkCanAdd o file $ \canadd -> do
-       showDestinationFile file
+       showDestinationFile (fromRawFilePath file)
        createWorkTreeDirectory (parentDir file)
        addWorkTree canadd addunlockedmatcher webUUID url file key Nothing
        return (Just key)
@@ -515,14 +521,14 @@ adjustFile o = addprefix . addsuffix
 
 data CanAddFile = CanAddFile
 
-checkCanAdd :: DownloadOptions -> FilePath -> (CanAddFile -> Annex (Maybe a)) -> Annex (Maybe a)
-checkCanAdd o file a = ifM (isJust <$> (liftIO $ catchMaybeIO $ getSymbolicLinkStatus file))
+checkCanAdd :: DownloadOptions -> RawFilePath -> (CanAddFile -> Annex (Maybe a)) -> Annex (Maybe a)
+checkCanAdd o file a = ifM (isJust <$> (liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus file))
        ( do
-               warning $ file ++ " already exists; not overwriting"
+               warning $ fromRawFilePath file ++ " already exists; not overwriting"
                return Nothing
        , ifM (checkIgnored (checkGitIgnoreOption o) file)
                ( do
-                       warning $ "not adding " ++ file ++ " which is .gitignored (use --no-check-gitignore to override)"
+                       warning $ "not adding " ++ fromRawFilePath file ++ " which is .gitignored (use --no-check-gitignore to override)"
                        return Nothing
                , a CanAddFile
                )
index 2fe56c0dad5540520cb0290c3887ce66faefd9c2..15f2ea4f167b485c23a1b140beeee4129c17860a 100644 (file)
@@ -72,7 +72,7 @@ start o si file key = stopUnless shouldCopy $
        Command.Move.start (fromToOptions o) Command.Move.RemoveNever si file key
   where
        shouldCopy
-               | autoMode o = want <||> numCopiesCheck (fromRawFilePath file) key (<)
+               | autoMode o = want <||> numCopiesCheck file key (<)
                | otherwise = return True
        want = case fromToOptions o of
                Right (ToRemote dest) ->
index f0415eaa9039124c40e1b13838c451f62de79ca2..17067b7d573fa9457f9efbf12446d63dbcacade3 100644 (file)
@@ -15,6 +15,7 @@ import qualified Git
 import Command.Unused (withUnusedMaps, UnusedMaps(..), startUnused)
 import Annex.NumCopies
 import Annex.Content
+import qualified Utility.RawFilePath as R
 
 cmd :: Command
 cmd = command "dropunused" SectionMaintenance
@@ -63,8 +64,8 @@ perform from numcopies key = case from of
   where
        droplocal = Command.Drop.performLocal key (AssociatedFile Nothing) numcopies []
 
-performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform
+performOther :: (Key -> Git.Repo -> RawFilePath) -> Key -> CommandPerform
 performOther filespec key = do
        f <- fromRepo $ filespec key
-       pruneTmpWorkDirBefore f (liftIO . removeWhenExistsWith removeLink)
+       pruneTmpWorkDirBefore f (liftIO . removeWhenExistsWith R.removeLink)
        next $ return True
index 210370071d9c7cab5cd15a61db49ba685f6fb442..73401e726f4671a535f2120c457ba699d39cdd8b 100644 (file)
@@ -46,11 +46,10 @@ data FixWhat = FixSymlinks | FixAll
 start :: FixWhat -> SeekInput -> RawFilePath -> Key -> CommandStart
 start fixwhat si file key = do
        currlink <- liftIO $ catchMaybeIO $ R.readSymbolicLink file
-       wantlink <- calcRepo $ gitAnnexLink (fromRawFilePath file) key
+       wantlink <- calcRepo $ gitAnnexLink file key
        case currlink of
                Just l
-                       | l /= toRawFilePath wantlink -> fixby $
-                               fixSymlink (fromRawFilePath file) wantlink
+                       | l /=  wantlink -> fixby $ fixSymlink file wantlink
                        | otherwise -> stop
                Nothing -> case fixwhat of
                        FixAll -> fixthin
@@ -78,7 +77,7 @@ breakHardLink file key obj = do
                unlessM (checkedCopyFile key obj' tmp mode) $
                        error "unable to break hard link"
                thawContent tmp
-               modifyContent obj' $ freezeContent obj'
+               modifyContent obj $ freezeContent obj'
        Database.Keys.storeInodeCaches key [file]
        next $ return True
 
@@ -86,25 +85,25 @@ makeHardLink :: RawFilePath -> Key -> CommandPerform
 makeHardLink file key = do
        replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do
                mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
-               linkFromAnnex key tmp mode >>= \case
+               linkFromAnnex key (toRawFilePath tmp) mode >>= \case
                        LinkAnnexFailed -> error "unable to make hard link"
                        _ -> noop
        next $ return True
 
-fixSymlink :: FilePath -> FilePath -> CommandPerform
+fixSymlink :: RawFilePath -> RawFilePath -> CommandPerform
 fixSymlink file link = do
 #if ! defined(mingw32_HOST_OS)
        -- preserve mtime of symlink
        mtime <- liftIO $ catchMaybeIO $ modificationTimeHiRes
-               <$> getSymbolicLinkStatus file
+               <$> R.getSymbolicLinkStatus file
 #endif
        createWorkTreeDirectory (parentDir file)
-       liftIO $ removeFile file
-       liftIO $ createSymbolicLink link file
+       liftIO $ R.removeLink file
+       liftIO $ R.createSymbolicLink link file
 #if ! defined(mingw32_HOST_OS)
        liftIO $ maybe noop (\t -> touch file t False) mtime
 #endif
-       next $ cleanupSymlink file
+       next $ cleanupSymlink (fromRawFilePath file)
 
 cleanupSymlink :: FilePath -> CommandCleanup
 cleanupSymlink file = do
index 85a2f48965dec7dd7c3e3e2836088996ef1ee534..32bfd2ba08c4df8d094505f02d2821925874f3be 100644 (file)
@@ -16,6 +16,7 @@ import Annex.WorkTree
 import Annex.Perms
 import qualified Annex
 import qualified Backend.URL
+import qualified Utility.RawFilePath as R
 
 import Network.URI
 
@@ -51,12 +52,12 @@ seekBatch fmt = batchInput fmt parse (commandAction . go)
                let (keyname, file) = separate (== ' ') s
                if not (null keyname) && not (null file)
                        then do
-                               file' <- liftIO $ relPathCwdToFile file
+                               file' <- liftIO $ relPathCwdToFile (toRawFilePath file)
                                return $ Right (file', keyOpt keyname)
                        else return $
                                Left "Expected pairs of key and filename"
        go (si, (file, key)) = 
-               let ai = mkActionItem (key, toRawFilePath file)
+               let ai = mkActionItem (key, file)
                in starting "fromkey" ai si $
                        perform key file
 
@@ -67,9 +68,11 @@ start force (si, (keyname, file)) = do
                inbackend <- inAnnex key
                unless inbackend $ giveup $
                        "key ("++ keyname ++") is not present in backend (use --force to override this sanity check)"
-       let ai = mkActionItem (key, toRawFilePath file)
+       let ai = mkActionItem (key, file')
        starting "fromkey" ai si $
-               perform key file
+               perform key file'
+  where
+       file' = toRawFilePath file
 
 -- From user input to a Key.
 -- User can input either a serialized key, or an url.
@@ -86,15 +89,15 @@ keyOpt s = case parseURI s of
                Just k -> k
                Nothing -> giveup $ "bad key/url " ++ s
 
-perform :: Key -> FilePath -> CommandPerform
-perform key file = lookupKeyNotHidden (toRawFilePath file) >>= \case
-       Nothing -> ifM (liftIO $ doesFileExist file)
+perform :: Key -> RawFilePath -> CommandPerform
+perform key file = lookupKeyNotHidden file >>= \case
+       Nothing -> ifM (liftIO $ doesFileExist (fromRawFilePath file))
                ( hasothercontent
                , do
                        link <- calcRepo $ gitAnnexLink file key
                        createWorkTreeDirectory (parentDir file)
-                       liftIO $ createSymbolicLink link file
-                       Annex.Queue.addCommand "add" [Param "--"] [file]
+                       liftIO $ R.createSymbolicLink link file
+                       Annex.Queue.addCommand "add" [Param "--"] [fromRawFilePath file]
                        next $ return True
                )
        Just k
@@ -102,5 +105,5 @@ perform key file = lookupKeyNotHidden (toRawFilePath file) >>= \case
                | otherwise -> hasothercontent
   where
        hasothercontent = do
-               warning $ file ++ " already exists with different content"
+               warning $ fromRawFilePath file ++ " already exists with different content"
                next $ return False
index 7a9800694d4e7a1b7a1b2f69ca1e3a8fc1795777..6aa25c50c6e312206b9a33e3a27ccbdf1882b7c6 100644 (file)
@@ -6,6 +6,7 @@
  -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Command.Fsck where
 
@@ -42,6 +43,7 @@ import System.Posix.Types (EpochTime)
 import qualified Data.Set as S
 import qualified Data.Map as M
 import Data.Either
+import qualified System.FilePath.ByteString as P
 
 cmd :: Command
 cmd = withGlobalOptions [jobsOption, jsonOptions, annexedMatchingOptions] $
@@ -115,7 +117,7 @@ start :: Maybe Remote -> Incremental -> SeekInput -> RawFilePath -> Key -> Comma
 start from inc si file key = Backend.getBackend (fromRawFilePath file) key >>= \case
        Nothing -> stop
        Just backend -> do
-               numcopies <- getFileNumCopies (fromRawFilePath file)
+               numcopies <- getFileNumCopies file
                case from of
                        Nothing -> go $ perform key file backend numcopies
                        Just r -> go $ performRemote key afile backend numcopies r
@@ -177,11 +179,11 @@ performRemote key afile backend numcopies remote =
                pid <- liftIO getPID
                t <- fromRepo gitAnnexTmpObjectDir
                createAnnexDirectory t
-               let tmp = t </> "fsck" ++ show pid ++ "." ++ fromRawFilePath (keyFile key)
-               let cleanup = liftIO $ catchIO (removeFile tmp) (const noop)
+               let tmp = t P.</> "fsck" <> toRawFilePath (show pid) <> "." <> keyFile key
+               let cleanup = liftIO $ catchIO (R.removeLink tmp) (const noop)
                cleanup
                cleanup `after` a tmp
-       getfile tmp = ifM (checkDiskSpace (Just (takeDirectory tmp)) key 0 True)
+       getfile tmp = ifM (checkDiskSpace (Just (fromRawFilePath (P.takeDirectory tmp))) key 0 True)
                ( ifM (getcheap tmp)
                        ( return (Just True)
                        , ifM (Annex.getState Annex.fast)
@@ -191,10 +193,10 @@ performRemote key afile backend numcopies remote =
                        )
                , return (Just False)
                )
-       getfile' tmp = Remote.retrieveKeyFile remote key (AssociatedFile Nothing) tmp dummymeter
+       getfile' tmp = Remote.retrieveKeyFile remote key (AssociatedFile Nothing) (fromRawFilePath tmp) dummymeter
        dummymeter _ = noop
        getcheap tmp = case Remote.retrieveKeyFileCheap remote of
-               Just a -> isRight <$> tryNonAsync (a key afile tmp)
+               Just a -> isRight <$> tryNonAsync (a key afile (fromRawFilePath tmp))
                Nothing -> return False
 
 startKey :: Maybe Remote -> Incremental -> (SeekInput, Key, ActionItem) -> NumCopies -> CommandStart
@@ -222,16 +224,16 @@ check cs = and <$> sequence cs
 {- Checks that symlinks points correctly to the annexed content. -}
 fixLink :: Key -> RawFilePath -> Annex Bool
 fixLink key file = do
-       want <- calcRepo $ gitAnnexLink (fromRawFilePath file) key
+       want <- calcRepo $ gitAnnexLink file key
        have <- getAnnexLinkTarget file
        maybe noop (go want) have
        return True
   where
        go want have
-               | want /= fromRawFilePath (fromInternalGitPath have) = do
+               | want /= fromInternalGitPath have = do
                        showNote "fixing link"
-                       createWorkTreeDirectory (parentDir (fromRawFilePath file))
-                       liftIO $ removeFile (fromRawFilePath file)
+                       createWorkTreeDirectory (parentDir file)
+                       liftIO $ R.removeLink file
                        addAnnexLink want file
                | otherwise = noop
 
@@ -239,9 +241,9 @@ fixLink key file = do
  - in this repository only. -}
 verifyLocationLog :: Key -> KeyStatus -> ActionItem -> Annex Bool
 verifyLocationLog key keystatus ai = do
-       obj <- fromRawFilePath <$> calcRepo (gitAnnexLocation key)
+       obj <- calcRepo (gitAnnexLocation key)
        present <- if isKeyUnlockedThin keystatus
-               then liftIO (doesFileExist obj)
+               then liftIO (doesFileExist (fromRawFilePath obj))
                else inAnnex key
        u <- getUUID
        
@@ -249,12 +251,12 @@ verifyLocationLog key keystatus ai = do
         - in a permission fixup here too. -}
        when present $ do
                void $ tryIO $ case keystatus of
-                       KeyUnlockedThin -> thawContent obj
-                       KeyLockedThin -> thawContent obj
-                       _ -> freezeContent obj
+                       KeyUnlockedThin -> thawContent (fromRawFilePath obj)
+                       KeyLockedThin -> thawContent (fromRawFilePath obj)
+                       _ -> freezeContent (fromRawFilePath obj)
                unlessM (isContentWritePermOk obj) $
-                       warning $ "** Unable to set correct write mode for " ++ obj ++ " ; perhaps you don't own that file"
-       whenM (liftIO $ doesDirectoryExist $ parentDir obj) $
+                       warning $ "** Unable to set correct write mode for " ++ fromRawFilePath obj ++ " ; perhaps you don't own that file"
+       whenM (liftIO $ R.doesPathExist $ parentDir obj) $
                freezeContentDir obj
 
        {- Warn when annex.securehashesonly is set and content using an 
@@ -263,7 +265,7 @@ verifyLocationLog key keystatus ai = do
         - config was set. -}
        whenM (pure present <&&> (not <$> Backend.isCryptographicallySecure key)) $
                whenM (annexSecureHashesOnly <$> Annex.getGitConfig) $
-                       warning $ "** Despite annex.securehashesonly being set, " ++ obj ++ " has content present in the annex using an insecure " ++ decodeBS (formatKeyVariety (fromKey keyVariety key)) ++ " key"
+                       warning $ "** Despite annex.securehashesonly being set, " ++ fromRawFilePath obj ++ " has content present in the annex using an insecure " ++ decodeBS (formatKeyVariety (fromKey keyVariety key)) ++ " key"
 
        verifyLocationLog' key ai present u (logChange key u)
 
@@ -346,7 +348,7 @@ verifyWorkTree key file = do
                        replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do
                                mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
                                ifM (annexThin <$> Annex.getGitConfig)
-                                       ( void $ linkFromAnnex key tmp mode
+                                       ( void $ linkFromAnnex key (toRawFilePath tmp) mode
                                        , do
                                                obj <- fromRawFilePath <$> calcRepo (gitAnnexLocation key)
                                                void $ checkedCopyFile key obj tmp mode
@@ -366,23 +368,23 @@ checkKeySize _ KeyUnlockedThin _ = return True
 checkKeySize key _ ai = do
        file <- calcRepo $ gitAnnexLocation key
        ifM (liftIO $ R.doesPathExist file)
-               ( checkKeySizeOr badContent key (fromRawFilePath file) ai
+               ( checkKeySizeOr badContent key file ai
                , return True
                )
 
-withLocalCopy :: Maybe FilePath -> (FilePath -> Annex Bool) -> Annex Bool
+withLocalCopy :: Maybe RawFilePath -> (RawFilePath -> Annex Bool) -> Annex Bool
 withLocalCopy Nothing _ = return True
 withLocalCopy (Just localcopy) f = f localcopy
 
-checkKeySizeRemote :: Key -> Remote -> ActionItem -> FilePath -> Annex Bool
+checkKeySizeRemote :: Key -> Remote -> ActionItem -> RawFilePath -> Annex Bool
 checkKeySizeRemote key remote ai localcopy =
        checkKeySizeOr (badContentRemote remote localcopy) key localcopy ai
 
-checkKeySizeOr :: (Key -> Annex String) -> Key -> FilePath -> ActionItem -> Annex Bool
+checkKeySizeOr :: (Key -> Annex String) -> Key -> RawFilePath -> ActionItem -> Annex Bool
 checkKeySizeOr bad key file ai = case fromKey keySize key of
        Nothing -> return True
        Just size -> do
-               size' <- liftIO $ getFileSize file
+               size' <- liftIO $ getFileSize (fromRawFilePath file)
                comparesizes size size'
   where
        comparesizes a b = do
@@ -436,30 +438,30 @@ checkBackend backend key keystatus afile = do
        content <- calcRepo (gitAnnexLocation key)
        ifM (pure (isKeyUnlockedThin keystatus) <&&> (not <$> isUnmodified key content))
                ( nocheck
-               , checkBackendOr badContent backend key (fromRawFilePath content) ai
+               , checkBackendOr badContent backend key content ai
                )
   where
        nocheck = return True
 
        ai = mkActionItem (key, afile)
 
-checkBackendRemote :: Backend -> Key -> Remote -> ActionItem -> FilePath -> Annex Bool
+checkBackendRemote :: Backend -> Key -> Remote -> ActionItem -> RawFilePath -> Annex Bool
 checkBackendRemote backend key remote ai localcopy =
        checkBackendOr (badContentRemote remote localcopy) backend key localcopy ai
 
-checkBackendOr :: (Key -> Annex String) -> Backend -> Key -> FilePath -> ActionItem -> Annex Bool
+checkBackendOr :: (Key -> Annex String) -> Backend -> Key -> RawFilePath -> ActionItem -> Annex Bool
 checkBackendOr bad backend key file ai =
        checkBackendOr' bad backend key file ai (return True)
 
 -- The postcheck action is run after the content is verified,
 -- in order to detect situations where the file is changed while being
 -- verified.
-checkBackendOr' :: (Key -> Annex String) -> Backend -> Key -> FilePath -> ActionItem -> Annex Bool -> Annex Bool
+checkBackendOr' :: (Key -> Annex String) -> Backend -> Key -> RawFilePath -> ActionItem -> Annex Bool -> Annex Bool
 checkBackendOr' bad backend key file ai postcheck =
        case Types.Backend.verifyKeyContent backend of
                Nothing -> return True
                Just verifier -> do
-                       ok <- verifier key file
+                       ok <- verifier key (fromRawFilePath file)
                        ifM postcheck
                                ( do
                                        unless ok $ do
@@ -529,19 +531,20 @@ badContent key = do
  - symlink to a file in the remote). To avoid any further data loss,
  - that temp file is moved to the bad content directory unless 
  - the local annex has a copy of the content. -}
-badContentRemote :: Remote -> FilePath -> Key -> Annex String
+badContentRemote :: Remote -> RawFilePath -> Key -> Annex String
 badContentRemote remote localcopy key = do
        bad <- fromRepo gitAnnexBadDir
-       let destbad = bad </> fromRawFilePath (keyFile key)
-       movedbad <- ifM (inAnnex key <||> liftIO (doesFileExist destbad))
+       let destbad = bad P.</> keyFile key
+       let destbad' = fromRawFilePath destbad
+       movedbad <- ifM (inAnnex key <||> liftIO (doesFileExist destbad'))
                ( return False
                , do
                        createAnnexDirectory (parentDir destbad)
                        liftIO $ catchDefaultIO False $
-                               ifM (isSymbolicLink <$> getSymbolicLinkStatus localcopy)
-                                       ( copyFileExternal CopyTimeStamps localcopy destbad
+                               ifM (isSymbolicLink <$> R.getSymbolicLinkStatus localcopy)
+                                       ( copyFileExternal CopyTimeStamps (fromRawFilePath localcopy) destbad'
                                        , do
-                                               moveFile localcopy destbad
+                                               moveFile (fromRawFilePath localcopy) destbad'
                                                return True
                                        )
                )
@@ -551,7 +554,7 @@ badContentRemote remote localcopy key = do
                Remote.logStatus remote key InfoMissing
        return $ case (movedbad, dropped) of
                (True, Right ()) -> "moved from " ++ Remote.name remote ++
-                       " to " ++ destbad
+                       " to " ++ fromRawFilePath destbad
                (False, Right ()) -> "dropped from " ++ Remote.name remote
                (_, Left e) -> "failed to drop from" ++ Remote.name remote ++ ": " ++ show e
 
@@ -583,22 +586,23 @@ recordFsckTime inc key = withFsckDb inc $ \h -> liftIO $ FsckDb.addDb h key
 recordStartTime :: UUID -> Annex ()
 recordStartTime u = do
        f <- fromRepo (gitAnnexFsckState u)
+       let f' = fromRawFilePath f
        createAnnexDirectory $ parentDir f
-       liftIO $ removeWhenExistsWith removeLink f
-       liftIO $ withFile f WriteMode $ \h -> do
+       liftIO $ removeWhenExistsWith R.removeLink f
+       liftIO $ withFile f' WriteMode $ \h -> do
 #ifndef mingw32_HOST_OS
-               t <- modificationTime <$> getFileStatus f
+               t <- modificationTime <$> R.getFileStatus f
 #else
                t <- getPOSIXTime
 #endif
                hPutStr h $ showTime $ realToFrac t
-       setAnnexFilePerm f
+       setAnnexFilePerm f'
   where
        showTime :: POSIXTime -> String
        showTime = show
 
 resetStartTime :: UUID -> Annex ()
-resetStartTime u = liftIO . removeWhenExistsWith removeLink
+resetStartTime u = liftIO . removeWhenExistsWith R.removeLink
        =<< fromRepo (gitAnnexFsckState u)
 
 {- Gets the incremental fsck start time. -}
@@ -606,9 +610,9 @@ getStartTime :: UUID -> Annex (Maybe EpochTime)
 getStartTime u = do
        f <- fromRepo (gitAnnexFsckState u)
        liftIO $ catchDefaultIO Nothing $ do
-               timestamp <- modificationTime <$> getFileStatus f
+               timestamp <- modificationTime <$> R.getFileStatus f
                let fromstatus = Just (realToFrac timestamp)
-               fromfile <- parsePOSIXTime <$> readFile f
+               fromfile <- parsePOSIXTime <$> readFile (fromRawFilePath f)
                return $ if matchingtimestamp fromfile fromstatus
                        then Just timestamp
                        else Nothing
index a63644b85d0deed1ac61eae314b28f4472872256..ffb40df89c3ba9aa8b764bb38c7288e945f3ea36 100644 (file)
@@ -60,7 +60,7 @@ start o from si file key = start' expensivecheck from key afile ai si
        afile = AssociatedFile (Just file)
        ai = mkActionItem (key, afile)
        expensivecheck
-               | autoMode o = numCopiesCheck (fromRawFilePath file) key (<)
+               | autoMode o = numCopiesCheck file key (<)
                        <||> wantGet False (Just key) afile
                | otherwise = return True
 
@@ -118,5 +118,6 @@ getKey' key afile = dispatch
                download (Remote.uuid r) key afile stdRetry
                        (\p -> do
                                showAction $ "from " ++ Remote.name r
-                               Remote.verifiedAction (Remote.retrieveKeyFile r key afile dest p)
+                               Remote.verifiedAction $
+                                       Remote.retrieveKeyFile r key afile (fromRawFilePath dest) p
                        ) witness
index c084bc6e83edd970572b7f49e339e26b4044552f..3f8672c08e7004d8d96133814246d6f7ec8e89dc 100644 (file)
@@ -60,7 +60,7 @@ start si file key = ifM (isJust <$> isAnnexLink file)
 perform :: RawFilePath -> Key -> CommandPerform
 perform file key = do
        lockdown =<< calcRepo (gitAnnexLocation key)
-       addLink (CheckGitIgnore False) (fromRawFilePath file) key
+       addLink (CheckGitIgnore False) file key
                =<< withTSDelta (liftIO . genInodeCache file)
        next $ cleanup file key
   where
index 628fe6cc1f7a471832bb9401cf1a44c331b4ebd3..669be7f56cbfa52652b65577336587d592adbc0e 100644 (file)
@@ -44,7 +44,7 @@ start si file key = do
                Just oldbackend -> do
                        exists <- inAnnex key
                        newbackend <- maybe defaultBackend return 
-                               =<< chooseBackend (fromRawFilePath file)
+                               =<< chooseBackend file
                        if (newbackend /= oldbackend || upgradableKey oldbackend key || forced) && exists
                                then starting "migrate" (mkActionItem (key, file)) si $
                                        perform file key oldbackend newbackend
index 0028116daa33e73927c1d44bdb82513defaceb17..28f7c92968ea1ca83ad1f3cddf3fb3cb1cbdf531 100644 (file)
@@ -88,4 +88,4 @@ startKey o afile (si, key, ai) = case fromToOptions o of
   where
        getnumcopies = case afile of
                AssociatedFile Nothing -> getNumCopies
-               AssociatedFile (Just af) -> getFileNumCopies (fromRawFilePath af)
+               AssociatedFile (Just af) -> getFileNumCopies af
index cfab0725aa1d8c92ee8945e2ff5293a907e3c391..85ee923422217748f453c8f7181f97fa16ba3c41 100644 (file)
@@ -226,7 +226,7 @@ fromPerform src removewhen key afile = do
        get = notifyTransfer Download afile $ 
                download (Remote.uuid src) key afile stdRetry $ \p ->
                        getViaTmp (Remote.retrievalSecurityPolicy src) (RemoteVerify src) key $ \t ->
-                               Remote.verifiedAction $ Remote.retrieveKeyFile src key afile t p
+                               Remote.verifiedAction $ Remote.retrieveKeyFile src key afile (fromRawFilePath t) p
        
        dispatch _ _ False = stop -- failed
        dispatch RemoveNever _ True = next $ return True -- copy complete
@@ -363,7 +363,7 @@ logMove srcuuid destuuid deststartedwithcopy key a = bracket setup cleanup go
        go logf
                -- Only need to check log when there is a copy.
                | deststartedwithcopy = do
-                       wasnocopy <- checkLogFile logf gitAnnexMoveLock
+                       wasnocopy <- checkLogFile (fromRawFilePath logf) gitAnnexMoveLock
                                (== logline)
                        if wasnocopy
                                then go' False
index 6853507e10bbbb06156ddaf2ecc97f18ac7b67f5..3054eb26af9de1362f9fcf7f476ebb6d1889100f 100644 (file)
@@ -124,7 +124,7 @@ cleanup file oldkey newkey = do
                ( do
                        -- Update symlink to use the new key.
                        liftIO $ removeFile (fromRawFilePath file)
-                       addLink (CheckGitIgnore False) (fromRawFilePath file) newkey Nothing
+                       addLink (CheckGitIgnore False) file newkey Nothing
                , do
                        mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
                        liftIO $ whenM (isJust <$> isPointerFile file) $
index 67eef7abe17c06e37f00bdc953a89f5c0bc591bd..46a5b25cf3b57f82c851e101ccebd20d8432aee2 100644 (file)
@@ -18,6 +18,7 @@ import Git.Command
 import qualified Utility.CoProcess as CoProcess
 
 import System.IO.Error
+import qualified Data.ByteString as B
 
 type CheckIgnoreHandle = CoProcess.CoProcessHandle
 
@@ -51,11 +52,11 @@ checkIgnoreStop :: CheckIgnoreHandle -> IO ()
 checkIgnoreStop = void . tryIO . CoProcess.stop
 
 {- Returns True if a file is ignored. -}
-checkIgnored :: CheckIgnoreHandle -> FilePath -> IO Bool
+checkIgnored :: CheckIgnoreHandle -> RawFilePath -> IO Bool
 checkIgnored h file = CoProcess.query h send (receive "")
   where
        send to = do
-               hPutStr to $ file ++ "\0"
+               B.hPutStr to $ file `B.snoc` 0
                hFlush to
        receive c from = do
                s <- hGetSomeString from 1024
index e0c34b4c9e1ef30b1ad820a8342b59a66755673e..32162f75253b13c0e554edecbf1e7ca39c9c2406 100644 (file)
@@ -51,12 +51,15 @@ withLogHandle f a = do
 
 -- | Appends a line to a log file, first locking it to prevent
 -- concurrent writers.
-appendLogFile :: FilePath -> (Git.Repo -> RawFilePath) -> L.ByteString -> Annex ()
+appendLogFile :: RawFilePath -> (Git.Repo -> RawFilePath) -> L.ByteString -> Annex ()
 appendLogFile f lck c = 
-       createDirWhenNeeded (toRawFilePath f) $
+       createDirWhenNeeded f $
                withExclusiveLock lck $ do
-                       liftIO $ withFile f AppendMode $ \h -> L8.hPutStrLn h c
-                       setAnnexFilePerm f
+                       liftIO $ withFile f' AppendMode $
+                               \h -> L8.hPutStrLn h c
+                       setAnnexFilePerm f'
+  where
+       f' = fromRawFilePath f
 
 -- | Modifies a log file.
 --
@@ -66,18 +69,19 @@ appendLogFile f lck c =
 --
 -- The file is locked to prevent concurrent writers, and it is written
 -- atomically.
-modifyLogFile :: FilePath -> (Git.Repo -> RawFilePath) -> ([L.ByteString] -> [L.ByteString]) -> Annex ()
+modifyLogFile :: RawFilePath -> (Git.Repo -> RawFilePath) -> ([L.ByteString] -> [L.ByteString]) -> Annex ()
 modifyLogFile f lck modf = withExclusiveLock lck $ do
        ls <- liftIO $ fromMaybe []
-               <$> tryWhenExists (L8.lines <$> L.readFile f)
+               <$> tryWhenExists (L8.lines <$> L.readFile f')
        let ls' = modf ls
        when (ls' /= ls) $
-               createDirWhenNeeded (toRawFilePath f) $
-                       viaTmp writelog f (L8.unlines ls')
+               createDirWhenNeeded f $
+                       viaTmp writelog f' (L8.unlines ls')
   where
-       writelog f' b = do
-               liftIO $ L.writeFile f' b
-               setAnnexFilePerm f'
+       f' = fromRawFilePath f
+       writelog lf b = do
+               liftIO $ L.writeFile lf b
+               setAnnexFilePerm lf
 
 -- | Checks the content of a log file to see if any line matches.
 --
index 743c765d2a084482b8fc40591d5ac58b02b81bbe..90e5475f92a3f1081d7afd7033bf4a7d8b47328f 100644 (file)
@@ -32,7 +32,7 @@ smudgeLog k f = do
 streamSmudged :: (Key -> TopFilePath -> Annex ()) -> Annex ()
 streamSmudged a = do
        logf <- fromRepo gitAnnexSmudgeLog
-       streamLogFile logf gitAnnexSmudgeLock $ \l -> 
+       streamLogFile (fromRawFilePath logf) gitAnnexSmudgeLock $ \l -> 
                case parse l of
                        Nothing -> noop
                        Just (k, f) -> a k f
index 1b2511cc7986c091507f2d3122d9e91779d550b3..136091db42b362c546a5bfdb03e93fceeb9a458d 100644 (file)
@@ -14,19 +14,20 @@ module Utility.Touch (
 
 #if ! defined(mingw32_HOST_OS)
 
-import System.Posix.Files
+import System.FilePath.ByteString (RawFilePath)
+import System.Posix.Files.ByteString
 import Data.Time.Clock.POSIX
 
 {- Changes the access and modification times of an existing file.
    Can follow symlinks, or not. -}
-touchBoth :: FilePath -> POSIXTime -> POSIXTime -> Bool -> IO ()
+touchBoth :: RawFilePath -> POSIXTime -> POSIXTime -> Bool -> IO ()
 touchBoth file atime mtime follow
        | follow = setFileTimesHiRes file atime mtime
        | otherwise = setSymbolicLinkTimesHiRes file atime mtime
 
 {- Changes the access and modification times of an existing file
  - to the same value. Can follow symlinks, or not. -}
-touch :: FilePath -> POSIXTime -> Bool -> IO ()
+touch :: RawFilePath -> POSIXTime -> Bool -> IO ()
 touch file mtime = touchBoth file mtime mtime
 
 #else
@@ -34,10 +35,10 @@ touch file mtime = touchBoth file mtime mtime
 import Data.Time.Clock.POSIX
 
 {- Noop for Windows -}
-touchBoth :: FilePath -> POSIXTime -> POSIXTime -> Bool -> IO ()
+touchBoth :: RawFilePath -> POSIXTime -> POSIXTime -> Bool -> IO ()
 touchBoth _ _ _ _ = return ()
 
-touch :: FilePath -> POSIXTime -> Bool -> IO ()
+touch :: RawFilePath -> POSIXTime -> Bool -> IO ()
 touch _ _ _ = return ()
 
 #endif