From 3c7fd09ec820bae90dcc783b2533a2915a9caf8c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 5 Dec 2019 11:40:10 -0400 Subject: [PATCH] get many more commands building again about half are building now --- CmdLine/GitAnnex.hs | 20 +++++++++----------- Command/EnableRemote.hs | 2 ++ Command/ExamineKey.hs | 2 +- Command/Find.hs | 3 ++- Command/Fix.hs | 17 +++++++++-------- Command/FromKey.hs | 6 +++--- Command/InitRemote.hs | 2 ++ Command/Lock.hs | 22 +++++++++++----------- Command/LookupKey.hs | 7 ++++--- Command/MetaData.hs | 10 +++++----- Command/Multicast.hs | 2 +- Command/PreCommit.hs | 4 ++-- Command/ReKey.hs | 32 ++++++++++++++++---------------- Command/Smudge.hs | 14 +++++++------- Command/TransferKeys.hs | 4 ++-- Command/Unlock.hs | 15 ++++++++------- Command/Unused.hs | 11 ++++++----- Command/View.hs | 5 +++-- Git/Repair.hs | 14 +++++++------- 19 files changed, 100 insertions(+), 92 deletions(-) diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs index fd1953faf2..daef02d85f 100644 --- a/CmdLine/GitAnnex.hs +++ b/CmdLine/GitAnnex.hs @@ -20,15 +20,12 @@ import Types.Benchmark import qualified Command.Help import qualified Command.Add -{- import qualified Command.Unannex --} import qualified Command.Drop import qualified Command.Move import qualified Command.Copy import qualified Command.Get import qualified Command.Fsck -{- import qualified Command.LookupKey import qualified Command.CalcKey import qualified Command.ContentLocation @@ -51,9 +48,7 @@ import qualified Command.VAdd import qualified Command.VFilter import qualified Command.VPop import qualified Command.VCycle --} import qualified Command.Reinject -{- import qualified Command.Fix import qualified Command.Init import qualified Command.Describe @@ -70,6 +65,7 @@ import qualified Command.AddUnused import qualified Command.Unlock import qualified Command.Lock import qualified Command.PreCommit +{- import qualified Command.PostReceive -} import qualified Command.Find @@ -120,7 +116,9 @@ import qualified Command.Forget import qualified Command.P2P import qualified Command.Proxy import qualified Command.DiffDriver +-} import qualified Command.Smudge +{- import qualified Command.Undo import qualified Command.Version import qualified Command.RemoteDaemon @@ -146,11 +144,9 @@ cmds testoptparser testrunner mkbenchmarkgenerator = , Command.Move.cmd , Command.Copy.cmd , Command.Fsck.cmd -{- , Command.Unlock.cmd , Command.Unlock.editcmd , Command.Lock.cmd --} , Command.Sync.cmd {- , Command.Mirror.cmd @@ -160,7 +156,6 @@ cmds testoptparser testrunner mkbenchmarkgenerator = -} , Command.Import.cmd , Command.Export.cmd -{- , Command.Init.cmd , Command.Describe.cmd , Command.InitRemote.cmd @@ -168,13 +163,14 @@ cmds testoptparser testrunner mkbenchmarkgenerator = , Command.RenameRemote.cmd , Command.EnableTor.cmd , Command.Multicast.cmd --} , Command.Reinject.cmd -{- , Command.Unannex.cmd +{- , Command.Uninit.cmd , Command.Reinit.cmd +-} , Command.PreCommit.cmd +{- , Command.PostReceive.cmd , Command.NumCopies.cmd , Command.Trust.cmd @@ -189,6 +185,7 @@ cmds testoptparser testrunner mkbenchmarkgenerator = , Command.Ungroup.cmd , Command.Config.cmd , Command.Vicfg.cmd +-} , Command.LookupKey.cmd , Command.CalcKey.cmd , Command.ContentLocation.cmd @@ -217,7 +214,6 @@ cmds testoptparser testrunner mkbenchmarkgenerator = , Command.Unused.cmd , Command.DropUnused.cmd , Command.AddUnused.cmd --} , Command.Find.cmd {- , Command.FindRef.cmd @@ -240,7 +236,9 @@ cmds testoptparser testrunner mkbenchmarkgenerator = , Command.P2P.cmd , Command.Proxy.cmd , Command.DiffDriver.cmd +-} , Command.Smudge.cmd +{- , Command.Undo.cmd , Command.Version.cmd , Command.RemoteDaemon.cmd diff --git a/Command/EnableRemote.hs b/Command/EnableRemote.hs index 8cf86ea5ed..f43ab68f8b 100644 --- a/Command/EnableRemote.hs +++ b/Command/EnableRemote.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Command.EnableRemote where import Command diff --git a/Command/ExamineKey.hs b/Command/ExamineKey.hs index 9cb8defb9c..040fd15f32 100644 --- a/Command/ExamineKey.hs +++ b/Command/ExamineKey.hs @@ -22,5 +22,5 @@ cmd = noCommit $ noMessages $ dontCheck repoExists $ run :: Maybe Utility.Format.Format -> String -> Annex Bool run format p = do let k = fromMaybe (giveup "bad key") $ deserializeKey p - showFormatted format (serializeKey k) (keyVars k) + showFormatted format (serializeKey' k) (keyVars k) return True diff --git a/Command/Find.hs b/Command/Find.hs index 06dcd86fd7..9ed9583c6b 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -9,6 +9,7 @@ module Command.Find where import Data.Default import qualified Data.Map as M +import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import Command @@ -76,7 +77,7 @@ startKeys o (key, ActionItemBranchFilePath (BranchFilePath _ topf) _) = start o (toRawFilePath (getTopFilePath topf)) key startKeys _ _ = stop -showFormatted :: Maybe Utility.Format.Format -> RawFilePath -> [(String, String)] -> Annex () +showFormatted :: Maybe Utility.Format.Format -> S.ByteString -> [(String, String)] -> Annex () showFormatted format unformatted vars = unlessM (showFullJSON $ JSONChunk vars) $ case format of diff --git a/Command/Fix.hs b/Command/Fix.hs index c3f818b01b..537a66f6d3 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -37,13 +37,14 @@ seek ps = unlessM crippledFileSystem $ do data FixWhat = FixSymlinks | FixAll -start :: FixWhat -> FilePath -> Key -> CommandStart +start :: FixWhat -> RawFilePath -> Key -> CommandStart start fixwhat file key = do - currlink <- liftIO $ catchMaybeIO $ readSymbolicLink file - wantlink <- calcRepo $ gitAnnexLink file key + currlink <- liftIO $ catchMaybeIO $ readSymbolicLink $ fromRawFilePath file + wantlink <- calcRepo $ gitAnnexLink (fromRawFilePath file) key case currlink of Just l - | l /= wantlink -> fixby $ fixSymlink file wantlink + | l /= wantlink -> fixby $ + fixSymlink (fromRawFilePath file) wantlink | otherwise -> stop Nothing -> case fixwhat of FixAll -> fixthin @@ -52,15 +53,15 @@ start fixwhat file key = do fixby = starting "fix" (mkActionItem (key, file)) fixthin = do obj <- calcRepo $ gitAnnexLocation key - stopUnless (isUnmodified key file <&&> isUnmodified key obj) $ do + stopUnless (isUnmodified key (fromRawFilePath file) <&&> isUnmodified key obj) $ do thin <- annexThin <$> Annex.getGitConfig - fs <- liftIO $ catchMaybeIO $ getFileStatus file + fs <- liftIO $ catchMaybeIO $ getFileStatus (fromRawFilePath file) os <- liftIO $ catchMaybeIO $ getFileStatus obj case (linkCount <$> fs, linkCount <$> os, thin) of (Just 1, Just 1, True) -> - fixby $ makeHardLink file key + fixby $ makeHardLink (fromRawFilePath file) key (Just n, Just n', False) | n > 1 && n == n' -> - fixby $ breakHardLink file key obj + fixby $ breakHardLink (fromRawFilePath file) key obj _ -> stop breakHardLink :: FilePath -> Key -> FilePath -> CommandPerform diff --git a/Command/FromKey.hs b/Command/FromKey.hs index 45b37f94d9..f3e7487272 100644 --- a/Command/FromKey.hs +++ b/Command/FromKey.hs @@ -51,7 +51,7 @@ seekBatch fmt = batchInput fmt parse commandAction in if not (null keyname) && not (null file) then Right $ go file (keyOpt keyname) else Left "Expected pairs of key and filename" - go file key = starting "fromkey" (mkActionItem (key, file)) $ + go file key = starting "fromkey" (mkActionItem (key, toRawFilePath file)) $ perform key file start :: Bool -> (String, FilePath) -> CommandStart @@ -61,7 +61,7 @@ start force (keyname, file) = do inbackend <- inAnnex key unless inbackend $ giveup $ "key ("++ keyname ++") is not present in backend (use --force to override this sanity check)" - starting "fromkey" (mkActionItem (key, file)) $ + starting "fromkey" (mkActionItem (key, toRawFilePath file)) $ perform key file -- From user input to a Key. @@ -80,7 +80,7 @@ keyOpt s = case parseURI s of Nothing -> giveup $ "bad key/url " ++ s perform :: Key -> FilePath -> CommandPerform -perform key file = lookupFileNotHidden file >>= \case +perform key file = lookupFileNotHidden (toRawFilePath file) >>= \case Nothing -> ifM (liftIO $ doesFileExist file) ( hasothercontent , do diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index 00ba46dc90..09aee869dc 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Command.InitRemote where import qualified Data.Map as M diff --git a/Command/Lock.hs b/Command/Lock.hs index 2f2eab21b4..cb104225f6 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -32,7 +32,7 @@ seek ps = do l <- workTreeItems ps withFilesInGit (commandAction . (whenAnnexed startNew)) l -startNew :: FilePath -> Key -> CommandStart +startNew :: RawFilePath -> Key -> CommandStart startNew file key = ifM (isJust <$> isAnnexLink file) ( stop , starting "lock" (mkActionItem (key, file)) $ @@ -43,7 +43,7 @@ startNew file key = ifM (isJust <$> isAnnexLink file) | key' == key = cont | otherwise = errorModified go Nothing = - ifM (isUnmodified key file) + ifM (isUnmodified key (fromRawFilePath file)) ( cont , ifM (Annex.getState Annex.force) ( cont @@ -52,11 +52,11 @@ startNew file key = ifM (isJust <$> isAnnexLink file) ) cont = performNew file key -performNew :: FilePath -> Key -> CommandPerform +performNew :: RawFilePath -> Key -> CommandPerform performNew file key = do lockdown =<< calcRepo (gitAnnexLocation key) - addLink file key - =<< withTSDelta (liftIO . genInodeCache file) + addLink (fromRawFilePath file) key + =<< withTSDelta (liftIO . genInodeCache (fromRawFilePath file)) next $ cleanupNew file key where lockdown obj = do @@ -70,7 +70,7 @@ performNew file key = do -- It's ok if the file is hard linked to obj, but if some other -- associated file is, we need to break that link to lock down obj. breakhardlink obj = whenM (catchBoolIO $ (> 1) . linkCount <$> liftIO (getFileStatus obj)) $ do - mfc <- withTSDelta (liftIO . genInodeCache file) + mfc <- withTSDelta (liftIO . genInodeCache (fromRawFilePath file)) unlessM (sameInodeCache obj (maybeToList mfc)) $ do modifyContent obj $ replaceFile obj $ \tmp -> do unlessM (checkedCopyFile key obj tmp Nothing) $ @@ -92,21 +92,21 @@ performNew file key = do lostcontent = logStatus key InfoMissing -cleanupNew :: FilePath -> Key -> CommandCleanup +cleanupNew :: RawFilePath -> Key -> CommandCleanup cleanupNew file key = do - Database.Keys.removeAssociatedFile key =<< inRepo (toTopFilePath file) + Database.Keys.removeAssociatedFile key =<< inRepo (toTopFilePath (fromRawFilePath file)) return True -startOld :: FilePath -> CommandStart +startOld :: RawFilePath -> CommandStart startOld file = do unlessM (Annex.getState Annex.force) errorModified starting "lock" (ActionItemWorkTreeFile file) $ performOld file -performOld :: FilePath -> CommandPerform +performOld :: RawFilePath -> CommandPerform performOld file = do - Annex.Queue.addCommand "checkout" [Param "--"] [file] + Annex.Queue.addCommand "checkout" [Param "--"] [fromRawFilePath file] next $ return True errorModified :: a diff --git a/Command/LookupKey.hs b/Command/LookupKey.hs index 11fa0c9461..1525046f2d 100644 --- a/Command/LookupKey.hs +++ b/Command/LookupKey.hs @@ -29,11 +29,12 @@ run _ file = seekSingleGitFile file >>= \case -- To support absolute filenames, pass through git ls-files. -- But, this plumbing command does not recurse through directories. -seekSingleGitFile :: FilePath -> Annex (Maybe FilePath) +seekSingleGitFile :: FilePath -> Annex (Maybe RawFilePath) seekSingleGitFile file = do - (l, cleanup) <- inRepo (Git.LsFiles.inRepo [file]) + (l, cleanup) <- inRepo (Git.LsFiles.inRepo [toRawFilePath file]) r <- case l of - (f:[]) | takeFileName f == takeFileName file -> return (Just f) + (f:[]) | takeFileName (fromRawFilePath f) == takeFileName file -> + return (Just f) _ -> return Nothing void $ liftIO cleanup return r diff --git a/Command/MetaData.hs b/Command/MetaData.hs index d1c7e50607..e0b86e5302 100644 --- a/Command/MetaData.hs +++ b/Command/MetaData.hs @@ -92,7 +92,7 @@ seek o = case batchOption o of ) _ -> giveup "--batch is currently only supported in --json mode" -start :: VectorClock -> MetaDataOptions -> FilePath -> Key -> CommandStart +start :: VectorClock -> MetaDataOptions -> RawFilePath -> Key -> CommandStart start c o file k = startKeys c o (k, mkActionItem (k, afile)) where afile = AssociatedFile (Just file) @@ -147,7 +147,7 @@ instance FromJSON MetaDataFields where fieldsField :: T.Text fieldsField = T.pack "fields" -parseJSONInput :: String -> Either String (Either FilePath Key, MetaData) +parseJSONInput :: String -> Either String (Either RawFilePath Key, MetaData) parseJSONInput i = do v <- eitherDecode (BU.fromString i) let m = case itemAdded v of @@ -155,16 +155,16 @@ parseJSONInput i = do Just (MetaDataFields m') -> m' case (itemKey v, itemFile v) of (Just k, _) -> Right (Right k, m) - (Nothing, Just f) -> Right (Left f, m) + (Nothing, Just f) -> Right (Left (toRawFilePath f), m) (Nothing, Nothing) -> Left "JSON input is missing either file or key" -startBatch :: (Either FilePath Key, MetaData) -> CommandStart +startBatch :: (Either RawFilePath Key, MetaData) -> CommandStart startBatch (i, (MetaData m)) = case i of Left f -> do mk <- lookupFile f case mk of Just k -> go k (mkActionItem (k, AssociatedFile (Just f))) - Nothing -> giveup $ "not an annexed file: " ++ f + Nothing -> giveup $ "not an annexed file: " ++ fromRawFilePath f Right k -> go k (mkActionItem k) where go k ai = starting "metadata" ai $ do diff --git a/Command/Multicast.hs b/Command/Multicast.hs index 6c6d2c418b..97966984a1 100644 --- a/Command/Multicast.hs +++ b/Command/Multicast.hs @@ -137,7 +137,7 @@ send ups fs = do mk <- lookupFile f case mk of Nothing -> noop - Just k -> withObjectLoc k (addlist f) + Just k -> withObjectLoc k (addlist (fromRawFilePath f)) liftIO $ hClose h serverkey <- uftpKey diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index 8c366ec14b..ad39953e3c 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -53,11 +53,11 @@ seek ps = lockPreCommitHook $ do (removeViewMetaData v) addViewMetaData :: View -> ViewedFile -> Key -> CommandStart -addViewMetaData v f k = starting "metadata" (mkActionItem (k, f)) $ +addViewMetaData v f k = starting "metadata" (mkActionItem (k, toRawFilePath f)) $ next $ changeMetaData k $ fromView v f removeViewMetaData :: View -> ViewedFile -> Key -> CommandStart -removeViewMetaData v f k = starting "metadata" (mkActionItem (k, f)) $ +removeViewMetaData v f k = starting "metadata" (mkActionItem (k, toRawFilePath f)) $ next $ changeMetaData k $ unsetMetaData $ fromView v f changeMetaData :: Key -> MetaData -> CommandCleanup diff --git a/Command/ReKey.hs b/Command/ReKey.hs index 6670298ae5..b9eac59232 100644 --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -38,13 +38,13 @@ optParser desc = ReKeyOptions -- Split on the last space, since a FilePath can contain whitespace, -- but a Key very rarely does. -batchParser :: String -> Either String (FilePath, Key) +batchParser :: String -> Either String (RawFilePath, Key) batchParser s = case separate (== ' ') (reverse s) of (rk, rf) | null rk || null rf -> Left "Expected: \"file key\"" | otherwise -> case deserializeKey (reverse rk) of Nothing -> Left "bad key" - Just k -> Right (reverse rf, k) + Just k -> Right (toRawFilePath (reverse rf), k) seek :: ReKeyOptions -> CommandSeek seek o = case batchOption o of @@ -52,9 +52,9 @@ seek o = case batchOption o of NoBatch -> withPairs (commandAction . start . parsekey) (reKeyThese o) where parsekey (file, skey) = - (file, fromMaybe (giveup "bad key") (deserializeKey skey)) + (toRawFilePath file, fromMaybe (giveup "bad key") (deserializeKey skey)) -start :: (FilePath, Key) -> CommandStart +start :: (RawFilePath, Key) -> CommandStart start (file, newkey) = ifAnnexed file go stop where go oldkey @@ -62,19 +62,19 @@ start (file, newkey) = ifAnnexed file go stop | otherwise = starting "rekey" (ActionItemWorkTreeFile file) $ perform file oldkey newkey -perform :: FilePath -> Key -> Key -> CommandPerform +perform :: RawFilePath -> Key -> Key -> CommandPerform perform file oldkey newkey = do ifM (inAnnex oldkey) ( unlessM (linkKey file oldkey newkey) $ giveup "failed creating link from old to new key" , unlessM (Annex.getState Annex.force) $ - giveup $ file ++ " is not available (use --force to override)" + giveup $ fromRawFilePath file ++ " is not available (use --force to override)" ) next $ cleanup file oldkey newkey {- Make a hard link to the old key content (when supported), - to avoid wasting disk space. -} -linkKey :: FilePath -> Key -> Key -> Annex Bool +linkKey :: RawFilePath -> Key -> Key -> Annex Bool linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file) {- If the object file is already hardlinked to elsewhere, a hard - link won't be made by getViaTmpFromDisk, but a copy instead. @@ -89,40 +89,40 @@ linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file) - it's hard linked to the old key, that link must be broken. -} oldobj <- calcRepo (gitAnnexLocation oldkey) v <- tryNonAsync $ do - st <- liftIO $ getFileStatus file + st <- liftIO $ getFileStatus (fromRawFilePath file) when (linkCount st > 1) $ do freezeContent oldobj - replaceFile file $ \tmp -> do + replaceFile (fromRawFilePath file) $ \tmp -> do unlessM (checkedCopyFile oldkey oldobj tmp Nothing) $ error "can't lock old key" thawContent tmp - ic <- withTSDelta (liftIO . genInodeCache file) + ic <- withTSDelta (liftIO . genInodeCache (fromRawFilePath file)) case v of Left e -> do warning (show e) return False Right () -> do - r <- linkToAnnex newkey file ic + r <- linkToAnnex newkey (fromRawFilePath file) ic return $ case r of LinkAnnexFailed -> False LinkAnnexOk -> True LinkAnnexNoop -> True ) -cleanup :: FilePath -> Key -> Key -> CommandCleanup +cleanup :: RawFilePath -> Key -> Key -> CommandCleanup cleanup file oldkey newkey = do ifM (isJust <$> isAnnexLink file) ( do -- Update symlink to use the new key. - liftIO $ removeFile file - addLink file newkey Nothing + liftIO $ removeFile (fromRawFilePath file) + addLink (fromRawFilePath file) newkey Nothing , do - mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file + mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus (fromRawFilePath file) liftIO $ whenM (isJust <$> isPointerFile file) $ writePointerFile file newkey mode stagePointerFile file mode =<< hashPointerFile newkey Database.Keys.removeAssociatedFile oldkey - =<< inRepo (toTopFilePath file) + =<< inRepo (toTopFilePath (fromRawFilePath file)) ) whenM (inAnnex newkey) $ logStatus newkey InfoPresent diff --git a/Command/Smudge.hs b/Command/Smudge.hs index 7191461bd2..30e2f2d168 100644 --- a/Command/Smudge.hs +++ b/Command/Smudge.hs @@ -86,9 +86,9 @@ clean file = do ( liftIO $ L.hPut stdout b , case parseLinkTargetOrPointerLazy b of Just k -> do - getMoveRaceRecovery k file + getMoveRaceRecovery k (toRawFilePath file) liftIO $ L.hPut stdout b - Nothing -> go b =<< catKeyFile file + Nothing -> go b =<< catKeyFile (toRawFilePath file) ) stop where @@ -187,10 +187,10 @@ emitPointer = S.putStr . formatPointer -- This also handles the case where a copy of a pointer file is made, -- then git-annex gets the content, and later git add is run on -- the pointer copy. It will then be populated with the content. -getMoveRaceRecovery :: Key -> FilePath -> Annex () +getMoveRaceRecovery :: Key -> RawFilePath -> Annex () getMoveRaceRecovery k file = void $ tryNonAsync $ whenM (inAnnex k) $ do - obj <- calcRepo (gitAnnexLocation k) + obj <- toRawFilePath <$> calcRepo (gitAnnexLocation k) -- Cannot restage because git add is running and has -- the index locked. populatePointerFile (Restage False) k obj file >>= \case @@ -204,11 +204,11 @@ update = do updateSmudged :: Restage -> Annex () updateSmudged restage = streamSmudged $ \k topf -> do - f <- fromRepo $ fromTopFilePath topf + f <- toRawFilePath <$> fromRepo (fromTopFilePath topf) whenM (inAnnex k) $ do - obj <- calcRepo (gitAnnexLocation k) + obj <- toRawFilePath <$> calcRepo (gitAnnexLocation k) unlessM (isJust <$> populatePointerFile restage k obj f) $ liftIO (isPointerFile f) >>= \case Just k' | k' == k -> toplevelWarning False $ - "unable to populate worktree file " ++ f + "unable to populate worktree file " ++ fromRawFilePath f _ -> noop diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs index 2d3cbaef49..9fa233fb90 100644 --- a/Command/TransferKeys.hs +++ b/Command/TransferKeys.hs @@ -116,10 +116,10 @@ instance TCSerialized Direction where deserialize _ = Nothing instance TCSerialized AssociatedFile where - serialize (AssociatedFile (Just f)) = f + serialize (AssociatedFile (Just f)) = fromRawFilePath f serialize (AssociatedFile Nothing) = "" deserialize "" = Just (AssociatedFile Nothing) - deserialize f = Just (AssociatedFile (Just f)) + deserialize f = Just (AssociatedFile (Just (toRawFilePath f))) instance TCSerialized RemoteName where serialize n = n diff --git a/Command/Unlock.hs b/Command/Unlock.hs index 2fc605c6de..31f8a26cf5 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -31,17 +31,18 @@ seek ps = withFilesInGit (commandAction . whenAnnexed start) =<< workTreeItems p {- Before v6, the unlock subcommand replaces the symlink with a copy of - the file's content. In v6 and above, it converts the file from a symlink - to a pointer. -} -start :: FilePath -> Key -> CommandStart +start :: RawFilePath -> Key -> CommandStart start file key = ifM (isJust <$> isAnnexLink file) ( starting "unlock" (mkActionItem (key, AssociatedFile (Just file))) $ perform file key , stop ) -perform :: FilePath -> Key -> CommandPerform +perform :: RawFilePath -> Key -> CommandPerform perform dest key = do - destmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus dest - replaceFile dest $ \tmp -> + destmode <- liftIO $ catchMaybeIO $ fileMode + <$> getFileStatus (fromRawFilePath dest) + replaceFile (fromRawFilePath dest) $ \tmp -> ifM (inAnnex key) ( do r <- linkFromAnnex key tmp destmode @@ -49,12 +50,12 @@ perform dest key = do LinkAnnexOk -> return () LinkAnnexNoop -> return () LinkAnnexFailed -> error "unlock failed" - , liftIO $ writePointerFile tmp key destmode + , liftIO $ writePointerFile (toRawFilePath tmp) key destmode ) next $ cleanup dest key destmode -cleanup :: FilePath -> Key -> Maybe FileMode -> CommandCleanup +cleanup :: RawFilePath -> Key -> Maybe FileMode -> CommandCleanup cleanup dest key destmode = do stagePointerFile dest destmode =<< hashPointerFile key - Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath dest) + Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath (fromRawFilePath dest)) return True diff --git a/Command/Unused.hs b/Command/Unused.hs index 95f953395d..345111ec81 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -192,10 +192,10 @@ withKeysReferencedM a = withKeysReferenced' Nothing () calla calla k _ _ = a k {- Folds an action over keys and files referenced in a particular directory. -} -withKeysFilesReferencedIn :: FilePath -> v -> (Key -> FilePath -> v -> Annex v) -> Annex v +withKeysFilesReferencedIn :: FilePath -> v -> (Key -> RawFilePath -> v -> Annex v) -> Annex v withKeysFilesReferencedIn = withKeysReferenced' . Just -withKeysReferenced' :: Maybe FilePath -> v -> (Key -> FilePath -> v -> Annex v) -> Annex v +withKeysReferenced' :: Maybe FilePath -> v -> (Key -> RawFilePath -> v -> Annex v) -> Annex v withKeysReferenced' mdir initial a = do (files, clean) <- getfiles r <- go initial files @@ -207,9 +207,9 @@ withKeysReferenced' mdir initial a = do ( return ([], return True) , do top <- fromRepo Git.repoPath - inRepo $ LsFiles.allFiles [top] + inRepo $ LsFiles.allFiles [toRawFilePath top] ) - Just dir -> inRepo $ LsFiles.inRepo [dir] + Just dir -> inRepo $ LsFiles.inRepo [toRawFilePath dir] go v [] = return v go v (f:fs) = do mk <- lookupFile f @@ -221,7 +221,8 @@ withKeysReferenced' mdir initial a = do withKeysReferencedDiffGitRefs :: RefSpec -> (Key -> Annex ()) -> Annex () withKeysReferencedDiffGitRefs refspec a = do - rs <- relevantrefs <$> inRepo (Git.Command.pipeReadStrict [Param "show-ref"]) + rs <- relevantrefs . decodeBS' + <$> inRepo (Git.Command.pipeReadStrict [Param "show-ref"]) shaHead <- maybe (return Nothing) (inRepo . Git.Ref.sha) =<< inRepo Git.Branch.currentUnsafe let haveHead = any (\(shaRef, _) -> Just shaRef == shaHead) rs diff --git a/Command/View.hs b/Command/View.hs index 88b9a4866d..58e7a8c8b0 100644 --- a/Command/View.hs +++ b/Command/View.hs @@ -101,7 +101,8 @@ checkoutViewBranch view mkbranch = do - removed.) -} top <- liftIO . absPath =<< fromRepo Git.repoPath (l, cleanup) <- inRepo $ - LsFiles.notInRepoIncludingEmptyDirectories False [top] + LsFiles.notInRepoIncludingEmptyDirectories False + [toRawFilePath top] forM_ l (removeemptydir top) liftIO $ void cleanup unlessM (liftIO $ doesDirectoryExist here) $ do @@ -109,7 +110,7 @@ checkoutViewBranch view mkbranch = do return ok where removeemptydir top d = do - p <- inRepo $ toTopFilePath d + p <- inRepo $ toTopFilePath $ fromRawFilePath d liftIO $ tryIO $ removeDirectory (top getTopFilePath p) cwdmissing top = unlines [ "This view does not include the subdirectory you are currently in." diff --git a/Git/Repair.hs b/Git/Repair.hs index 734c884f60..6031f4dd73 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -284,7 +284,7 @@ findUncorruptedCommit missing goodcommits branch r = do , Param "--format=%H" , Param (fromRef branch) ] r - let branchshas = catMaybes $ map (extractSha . decodeBS) ls + let branchshas = catMaybes $ map (extractSha . decodeBL) ls reflogshas <- RefLog.get branch r -- XXX Could try a bit harder here, and look -- for uncorrupted old commits in branches in the @@ -313,7 +313,7 @@ verifyCommit missing goodcommits commit r , Param "--format=%H %T" , Param (fromRef commit) ] r - let committrees = map (parse . decodeBS) ls + let committrees = map (parse . decodeBL) ls if any isNothing committrees || null committrees then do void cleanup @@ -342,7 +342,7 @@ verifyTree missing treesha r | S.member treesha missing = return False | otherwise = do (ls, cleanup) <- pipeNullSplit (LsTree.lsTreeParams LsTree.LsTreeRecursive treesha []) r - let objshas = map (LsTree.sha . LsTree.parseLsTree) ls + let objshas = mapMaybe (LsTree.sha <$$> eitherToMaybe . LsTree.parseLsTree) ls if any (`S.member` missing) objshas then do void cleanup @@ -366,7 +366,7 @@ checkIndex r = do - itself is not corrupt. -} checkIndexFast :: Repo -> IO Bool checkIndexFast r = do - (indexcontents, cleanup) <- LsFiles.stagedDetails [repoPath r] r + (indexcontents, cleanup) <- LsFiles.stagedDetails [toRawFilePath (repoPath r)] r length indexcontents `seq` cleanup missingIndex :: Repo -> IO Bool @@ -375,7 +375,7 @@ missingIndex r = not <$> doesFileExist (localGitDir r "index") {- Finds missing and ok files staged in the index. -} partitionIndex :: Repo -> IO ([LsFiles.StagedDetails], [LsFiles.StagedDetails], IO Bool) partitionIndex r = do - (indexcontents, cleanup) <- LsFiles.stagedDetails [repoPath r] r + (indexcontents, cleanup) <- LsFiles.stagedDetails [toRawFilePath (repoPath r)] r l <- forM indexcontents $ \i -> case i of (_file, Just sha, Just _mode) -> (,) <$> isMissing sha r <*> pure i _ -> pure (False, i) @@ -394,12 +394,12 @@ rewriteIndex r UpdateIndex.streamUpdateIndex r =<< (catMaybes <$> mapM reinject good) void cleanup - return $ map fst3 bad + return $ map (fromRawFilePath . fst3) bad where reinject (file, Just sha, Just mode) = case toTreeItemType mode of Nothing -> return Nothing Just treeitemtype -> Just <$> - UpdateIndex.stageFile sha treeitemtype file r + UpdateIndex.stageFile sha treeitemtype (fromRawFilePath file) r reinject _ = return Nothing newtype GoodCommits = GoodCommits (S.Set Sha)