get many more commands building again
about half are building now
This commit is contained in:
parent
6535aea49a
commit
3c7fd09ec8
19 changed files with 100 additions and 92 deletions
|
@ -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
|
||||
|
|
|
@ -5,6 +5,8 @@
|
|||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Command.EnableRemote where
|
||||
|
||||
import Command
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in a new issue