get many more commands building again

about half are building now
This commit is contained in:
Joey Hess 2019-12-05 11:40:10 -04:00
parent 6535aea49a
commit 3c7fd09ec8
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
19 changed files with 100 additions and 92 deletions

View file

@ -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

View file

@ -5,6 +5,8 @@
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Command.EnableRemote where
import Command

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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."

View file

@ -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)