all commands building except for assistant
also, changed ConfigValue to a newtype, and moved it into Git.Config.
This commit is contained in:
parent
718fa83da6
commit
c20f4704a7
40 changed files with 187 additions and 174 deletions
|
@ -156,7 +156,7 @@ startRemote r o file uri sz = do
|
|||
performRemote r o uri file' sz
|
||||
|
||||
performRemote :: Remote -> AddUrlOptions -> URLString -> FilePath -> Maybe Integer -> CommandPerform
|
||||
performRemote r o uri file sz = ifAnnexed file adduri geturi
|
||||
performRemote r o uri file sz = ifAnnexed (toRawFilePath file) adduri geturi
|
||||
where
|
||||
loguri = setDownloader uri OtherDownloader
|
||||
adduri = addUrlChecked o loguri file (Remote.uuid r) checkexistssize
|
||||
|
@ -180,7 +180,7 @@ downloadRemoteFile r o uri file sz = checkCanAdd file $ do
|
|||
setTempUrl urlkey loguri
|
||||
let downloader = \dest p -> fst
|
||||
<$> Remote.retrieveKeyFile r urlkey
|
||||
(AssociatedFile (Just file)) dest p
|
||||
(AssociatedFile (Just (toRawFilePath file))) dest p
|
||||
ret <- downloadWith downloader urlkey (Remote.uuid r) loguri file
|
||||
removeTempUrl urlkey
|
||||
return ret
|
||||
|
@ -212,7 +212,7 @@ startWeb o urlstring = go $ fromMaybe bad $ parseURI urlstring
|
|||
performWeb o urlstring file urlinfo
|
||||
|
||||
performWeb :: AddUrlOptions -> URLString -> FilePath -> Url.UrlInfo -> CommandPerform
|
||||
performWeb o url file urlinfo = ifAnnexed file addurl geturl
|
||||
performWeb o url file urlinfo = ifAnnexed (toRawFilePath file) addurl geturl
|
||||
where
|
||||
geturl = next $ isJust <$> addUrlFile (downloadOptions o) url urlinfo file
|
||||
addurl = addUrlChecked o url file webUUID $ \k ->
|
||||
|
@ -258,7 +258,7 @@ addUrlFile o url urlinfo file =
|
|||
|
||||
downloadWeb :: DownloadOptions -> URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key)
|
||||
downloadWeb o url urlinfo file =
|
||||
go =<< downloadWith' downloader urlkey webUUID url (AssociatedFile (Just file))
|
||||
go =<< downloadWith' downloader urlkey webUUID url (AssociatedFile (Just (toRawFilePath file)))
|
||||
where
|
||||
urlkey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing
|
||||
downloader f p = downloadUrl urlkey p [url] f
|
||||
|
@ -278,7 +278,7 @@ downloadWeb o url urlinfo file =
|
|||
-- first, and check if that is already an annexed file,
|
||||
-- to avoid unnecessary work in that case.
|
||||
| otherwise = youtubeDlFileNameHtmlOnly url >>= \case
|
||||
Right dest -> ifAnnexed dest
|
||||
Right dest -> ifAnnexed (toRawFilePath dest)
|
||||
(alreadyannexed dest)
|
||||
(dl dest)
|
||||
Left _ -> normalfinish tmp
|
||||
|
@ -345,7 +345,7 @@ downloadWith :: (FilePath -> MeterUpdate -> Annex Bool) -> Key -> UUID -> URLStr
|
|||
downloadWith downloader dummykey u url file =
|
||||
go =<< downloadWith' downloader dummykey u url afile
|
||||
where
|
||||
afile = AssociatedFile (Just file)
|
||||
afile = AssociatedFile (Just (toRawFilePath file))
|
||||
go Nothing = return Nothing
|
||||
go (Just tmp) = finishDownloadWith tmp u url file
|
||||
|
||||
|
@ -401,7 +401,7 @@ addWorkTree u url file key mtmp = case mtmp of
|
|||
-- than the work tree file.
|
||||
liftIO $ renameFile file tmp
|
||||
go
|
||||
else void $ Command.Add.addSmall file
|
||||
else void $ Command.Add.addSmall (toRawFilePath file)
|
||||
where
|
||||
go = do
|
||||
maybeShowJSON $ JSONChunk [("key", serializeKey key)]
|
||||
|
|
|
@ -10,6 +10,9 @@ module Command.Config where
|
|||
import Command
|
||||
import Logs.Config
|
||||
import Config
|
||||
import Git.Types (ConfigKey(..), fromConfigValue)
|
||||
|
||||
import qualified Data.ByteString as S
|
||||
|
||||
cmd :: Command
|
||||
cmd = noMessages $ command "config" SectionSetup
|
||||
|
@ -17,9 +20,9 @@ cmd = noMessages $ command "config" SectionSetup
|
|||
paramNothing (seek <$$> optParser)
|
||||
|
||||
data Action
|
||||
= SetConfig ConfigName ConfigValue
|
||||
| GetConfig ConfigName
|
||||
| UnsetConfig ConfigName
|
||||
= SetConfig ConfigKey ConfigValue
|
||||
| GetConfig ConfigKey
|
||||
| UnsetConfig ConfigKey
|
||||
|
||||
type Name = String
|
||||
type Value = String
|
||||
|
@ -48,19 +51,19 @@ optParser _ = setconfig <|> getconfig <|> unsetconfig
|
|||
)
|
||||
|
||||
seek :: Action -> CommandSeek
|
||||
seek (SetConfig name val) = commandAction $
|
||||
startingUsualMessages name (ActionItemOther (Just val)) $ do
|
||||
setGlobalConfig name val
|
||||
setConfig (ConfigKey name) val
|
||||
seek (SetConfig ck@(ConfigKey name) val) = commandAction $
|
||||
startingUsualMessages (decodeBS' name) (ActionItemOther (Just (fromConfigValue val))) $ do
|
||||
setGlobalConfig ck val
|
||||
setConfig ck (fromConfigValue val)
|
||||
next $ return True
|
||||
seek (UnsetConfig name) = commandAction $
|
||||
startingUsualMessages name (ActionItemOther (Just "unset")) $do
|
||||
unsetGlobalConfig name
|
||||
unsetConfig (ConfigKey name)
|
||||
seek (UnsetConfig ck@(ConfigKey name)) = commandAction $
|
||||
startingUsualMessages (decodeBS' name) (ActionItemOther (Just "unset")) $do
|
||||
unsetGlobalConfig ck
|
||||
unsetConfig ck
|
||||
next $ return True
|
||||
seek (GetConfig name) = commandAction $
|
||||
seek (GetConfig ck) = commandAction $
|
||||
startingCustomOutput (ActionItemOther Nothing) $ do
|
||||
getGlobalConfig name >>= \case
|
||||
getGlobalConfig ck >>= \case
|
||||
Nothing -> return ()
|
||||
Just v -> liftIO $ putStrLn v
|
||||
Just (ConfigValue v) -> liftIO $ S.putStrLn v
|
||||
next $ return True
|
||||
|
|
|
@ -30,7 +30,7 @@ start :: CommandStart
|
|||
start = do
|
||||
u <- findOrGenUUID
|
||||
showConfig configkeyUUID $ fromUUID u
|
||||
showConfig coreGCryptId . decodeBS'
|
||||
showConfig coreGCryptId . fromConfigValue
|
||||
=<< fromRepo (Git.Config.get coreGCryptId mempty)
|
||||
stop
|
||||
where
|
||||
|
|
|
@ -85,9 +85,9 @@ fixupReq req@(Req {}) =
|
|||
check rOldFile rOldMode (\r f -> r { rOldFile = f }) req
|
||||
>>= check rNewFile rNewMode (\r f -> r { rNewFile = f })
|
||||
where
|
||||
check getfile getmode setfile r = case readTreeItemType (getmode r) of
|
||||
check getfile getmode setfile r = case readTreeItemType (encodeBS' (getmode r)) of
|
||||
Just TreeSymlink -> do
|
||||
v <- getAnnexLinkTarget' (getfile r) False
|
||||
v <- getAnnexLinkTarget' (toRawFilePath (getfile r)) False
|
||||
case parseLinkTargetOrPointer =<< v of
|
||||
Nothing -> return r
|
||||
Just k -> withObjectLoc k (pure . setfile r)
|
||||
|
|
|
@ -5,6 +5,8 @@
|
|||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Command.FuzzTest where
|
||||
|
||||
import Command
|
||||
|
@ -13,6 +15,7 @@ import qualified Git.Config
|
|||
import Config
|
||||
import Utility.ThreadScheduler
|
||||
import Utility.DiskFree
|
||||
import Git.Types (fromConfigKey)
|
||||
|
||||
import Data.Time.Clock
|
||||
import System.Random (getStdRandom, random, randomR)
|
||||
|
@ -32,25 +35,23 @@ start :: CommandStart
|
|||
start = do
|
||||
guardTest
|
||||
logf <- fromRepo gitAnnexFuzzTestLogFile
|
||||
showStart "fuzztest" logf
|
||||
showStart "fuzztest" (toRawFilePath logf)
|
||||
logh <- liftIO $ openFile logf WriteMode
|
||||
void $ forever $ fuzz logh
|
||||
stop
|
||||
|
||||
guardTest :: Annex ()
|
||||
guardTest = unlessM (fromMaybe False . Git.Config.isTrue <$> getConfig key "") $
|
||||
guardTest = unlessM (fromMaybe False . Git.Config.isTrue' <$> getConfig key mempty) $
|
||||
giveup $ unlines
|
||||
[ "Running fuzz tests *writes* to and *deletes* files in"
|
||||
, "this repository, and pushes those changes to other"
|
||||
, "repositories! This is a developer tool, not something"
|
||||
, "to play with."
|
||||
, ""
|
||||
, "Refusing to run fuzz tests, since " ++ keyname ++ " is not set!"
|
||||
, "Refusing to run fuzz tests, since " ++ fromConfigKey key ++ " is not set!"
|
||||
]
|
||||
where
|
||||
key = annexConfig "eat-my-repository"
|
||||
(ConfigKey keyname) = key
|
||||
|
||||
|
||||
fuzz :: Handle -> Annex ()
|
||||
fuzz logh = do
|
||||
|
|
|
@ -67,7 +67,7 @@ seek o = do
|
|||
|
||||
getFeed :: ImportFeedOptions -> Cache -> URLString -> CommandSeek
|
||||
getFeed opts cache url = do
|
||||
showStart "importfeed" url
|
||||
showStart' "importfeed" (Just url)
|
||||
downloadFeed url >>= \case
|
||||
Nothing -> showEndResult =<< feedProblem url
|
||||
"downloading the feed failed"
|
||||
|
@ -222,7 +222,7 @@ performDownload opts cache todownload = case location todownload of
|
|||
case dest of
|
||||
Nothing -> return True
|
||||
Just f -> do
|
||||
showStart "addurl" url
|
||||
showStart' "addurl" (Just url)
|
||||
ks <- getter f
|
||||
if null ks
|
||||
then do
|
||||
|
@ -244,7 +244,7 @@ performDownload opts cache todownload = case location todownload of
|
|||
- to be re-downloaded. -}
|
||||
makeunique url n file = ifM alreadyexists
|
||||
( ifM forced
|
||||
( ifAnnexed f checksameurl tryanother
|
||||
( ifAnnexed (toRawFilePath f) checksameurl tryanother
|
||||
, tryanother
|
||||
)
|
||||
, return $ Just f
|
||||
|
|
|
@ -152,7 +152,7 @@ itemInfo o p = ifM (isdir p)
|
|||
v' <- Remote.nameToUUID' p
|
||||
case v' of
|
||||
Right u -> uuidInfo o u
|
||||
Left _ -> ifAnnexed p
|
||||
Left _ -> ifAnnexed (toRawFilePath p)
|
||||
(fileInfo o p)
|
||||
(treeishInfo o p)
|
||||
)
|
||||
|
@ -161,7 +161,7 @@ itemInfo o p = ifM (isdir p)
|
|||
|
||||
noInfo :: String -> Annex ()
|
||||
noInfo s = do
|
||||
showStart "info" s
|
||||
showStart "info" (encodeBS' s)
|
||||
showNote $ "not a directory or an annexed file or a treeish or a remote or a uuid"
|
||||
showEndFail
|
||||
|
||||
|
@ -311,8 +311,8 @@ showStat :: Stat -> StatState ()
|
|||
showStat s = maybe noop calc =<< s
|
||||
where
|
||||
calc (desc, a) = do
|
||||
(lift . showHeader) desc
|
||||
lift . showRaw =<< a
|
||||
(lift . showHeader . encodeBS') desc
|
||||
lift . showRaw . encodeBS' =<< a
|
||||
|
||||
repo_list :: TrustLevel -> Stat
|
||||
repo_list level = stat n $ nojson $ lift $ do
|
||||
|
@ -435,7 +435,7 @@ transfer_list = stat desc $ nojson $ lift $ do
|
|||
desc = "transfers in progress"
|
||||
line uuidmap t i = unwords
|
||||
[ formatDirection (transferDirection t) ++ "ing"
|
||||
, actionItemDesc $ mkActionItem
|
||||
, fromRawFilePath $ actionItemDesc $ mkActionItem
|
||||
(transferKey t, associatedFile i)
|
||||
, if transferDirection t == Upload then "to" else "from"
|
||||
, maybe (fromUUID $ transferUUID t) Remote.name $
|
||||
|
@ -444,7 +444,7 @@ transfer_list = stat desc $ nojson $ lift $ do
|
|||
jsonify t i = object $ map (\(k, v) -> (packString k, v)) $
|
||||
[ ("transfer", toJSON' (formatDirection (transferDirection t)))
|
||||
, ("key", toJSON' (transferKey t))
|
||||
, ("file", toJSON' afile)
|
||||
, ("file", toJSON' (fromRawFilePath <$> afile))
|
||||
, ("remote", toJSON' (fromUUID (transferUUID t) :: String))
|
||||
]
|
||||
where
|
||||
|
@ -566,7 +566,7 @@ getDirStatInfo o dir = do
|
|||
where
|
||||
initial = (emptyKeyInfo, emptyKeyInfo, emptyNumCopiesStats, M.empty)
|
||||
update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats, repodata) =
|
||||
ifM (matcher $ MatchingFile $ FileInfo file file)
|
||||
ifM (matcher $ MatchingFile $ FileInfo file' file')
|
||||
( do
|
||||
!presentdata' <- ifM (inAnnex key)
|
||||
( return $ addKey key presentdata
|
||||
|
@ -577,11 +577,13 @@ getDirStatInfo o dir = do
|
|||
then return (numcopiesstats, repodata)
|
||||
else do
|
||||
locs <- Remote.keyLocations key
|
||||
nc <- updateNumCopiesStats file numcopiesstats locs
|
||||
nc <- updateNumCopiesStats file' numcopiesstats locs
|
||||
return (nc, updateRepoData key locs repodata)
|
||||
return $! (presentdata', referenceddata', numcopiesstats', repodata')
|
||||
, return vs
|
||||
)
|
||||
where
|
||||
file' = fromRawFilePath file
|
||||
|
||||
getTreeStatInfo :: InfoOptions -> Git.Ref -> Annex (Maybe StatInfo)
|
||||
getTreeStatInfo o r = do
|
||||
|
|
|
@ -42,7 +42,7 @@ seek o = do
|
|||
(commandAction . (whenAnnexed (start s)))
|
||||
=<< workTreeItems (inprogressFiles o)
|
||||
|
||||
start :: S.Set Key -> FilePath -> Key -> CommandStart
|
||||
start :: S.Set Key -> RawFilePath -> Key -> CommandStart
|
||||
start s _file k
|
||||
| S.member k s = start' k
|
||||
| otherwise = stop
|
||||
|
|
|
@ -72,7 +72,7 @@ getList o
|
|||
printHeader :: [(UUID, RemoteName, TrustLevel)] -> Annex ()
|
||||
printHeader l = liftIO $ putStrLn $ lheader $ map (\(_, n, t) -> (n, t)) l
|
||||
|
||||
start :: [(UUID, RemoteName, TrustLevel)] -> FilePath -> Key -> CommandStart
|
||||
start :: [(UUID, RemoteName, TrustLevel)] -> RawFilePath -> Key -> CommandStart
|
||||
start l file key = do
|
||||
ls <- S.fromList <$> keyLocations key
|
||||
liftIO $ putStrLn $ format (map (\(u, _, t) -> (t, S.member u ls)) l) file
|
||||
|
@ -88,8 +88,8 @@ lheader remotes = unlines (zipWith formatheader [0..] remotes) ++ pipes (length
|
|||
trust UnTrusted = " (untrusted)"
|
||||
trust _ = ""
|
||||
|
||||
format :: [(TrustLevel, Present)] -> FilePath -> String
|
||||
format remotes file = thereMap ++ " " ++ file
|
||||
format :: [(TrustLevel, Present)] -> RawFilePath -> String
|
||||
format remotes file = thereMap ++ " " ++ fromRawFilePath file
|
||||
where
|
||||
thereMap = concatMap there remotes
|
||||
there (UnTrusted, True) = "x"
|
||||
|
|
|
@ -92,10 +92,10 @@ seek o = do
|
|||
([], True) -> commandAction (startAll o outputter)
|
||||
(_, True) -> giveup "Cannot specify both files and --all"
|
||||
|
||||
start :: LogOptions -> (FilePath -> Outputter) -> FilePath -> Key -> CommandStart
|
||||
start :: LogOptions -> (FilePath -> Outputter) -> RawFilePath -> Key -> CommandStart
|
||||
start o outputter file key = do
|
||||
(changes, cleanup) <- getKeyLog key (passthruOptions o)
|
||||
showLogIncremental (outputter file) changes
|
||||
showLogIncremental (outputter (fromRawFilePath file)) changes
|
||||
void $ liftIO cleanup
|
||||
stop
|
||||
|
||||
|
@ -201,7 +201,7 @@ getKeyLog key os = do
|
|||
top <- fromRepo Git.repoPath
|
||||
p <- liftIO $ relPathCwdToFile top
|
||||
config <- Annex.getGitConfig
|
||||
let logfile = p </> locationLogFile config key
|
||||
let logfile = p </> fromRawFilePath (locationLogFile config key)
|
||||
getGitLog [logfile] (Param "--remove-empty" : os)
|
||||
|
||||
{- Streams the git log for all git-annex branch changes. -}
|
||||
|
@ -220,7 +220,7 @@ getGitLog fs os = do
|
|||
[ Param $ Git.fromRef Annex.Branch.fullname
|
||||
, Param "--"
|
||||
] ++ map Param fs
|
||||
return (parseGitRawLog ls, cleanup)
|
||||
return (parseGitRawLog (map decodeBL' ls), cleanup)
|
||||
|
||||
-- Parses chunked git log --raw output, which looks something like:
|
||||
--
|
||||
|
@ -250,7 +250,7 @@ parseGitRawLog = parse epoch
|
|||
(tss, cl') -> (parseTimeStamp tss, cl')
|
||||
mrc = do
|
||||
(old, new) <- parseRawChangeLine cl
|
||||
key <- locationLogFileKey c2
|
||||
key <- locationLogFileKey (toRawFilePath c2)
|
||||
return $ RefChange
|
||||
{ changetime = ts
|
||||
, oldref = old
|
||||
|
|
|
@ -28,16 +28,16 @@ cmd = withGlobalOptions [annexedMatchingOptions] $
|
|||
seek :: CmdParams -> CommandSeek
|
||||
seek = withFilesInGit (commandAction . (whenAnnexed start)) <=< workTreeItems
|
||||
|
||||
start :: FilePath -> Key -> CommandStart
|
||||
start :: RawFilePath -> Key -> CommandStart
|
||||
start file key = do
|
||||
forced <- Annex.getState Annex.force
|
||||
v <- Backend.getBackend file key
|
||||
v <- Backend.getBackend (fromRawFilePath file) key
|
||||
case v of
|
||||
Nothing -> stop
|
||||
Just oldbackend -> do
|
||||
exists <- inAnnex key
|
||||
newbackend <- maybe defaultBackend return
|
||||
=<< chooseBackend file
|
||||
=<< chooseBackend (fromRawFilePath file)
|
||||
if (newbackend /= oldbackend || upgradableKey oldbackend key || forced) && exists
|
||||
then starting "migrate" (mkActionItem (key, file)) $
|
||||
perform file key oldbackend newbackend
|
||||
|
@ -63,7 +63,7 @@ upgradableKey backend key = isNothing (fromKey keySize key) || backendupgradable
|
|||
- data cannot get corrupted after the fsck but before the new key is
|
||||
- generated.
|
||||
-}
|
||||
perform :: FilePath -> Key -> Backend -> Backend -> CommandPerform
|
||||
perform :: RawFilePath -> Key -> Backend -> Backend -> CommandPerform
|
||||
perform file oldkey oldbackend newbackend = go =<< genkey (fastMigrate oldbackend)
|
||||
where
|
||||
go Nothing = stop
|
||||
|
@ -85,7 +85,7 @@ perform file oldkey oldbackend newbackend = go =<< genkey (fastMigrate oldbacken
|
|||
genkey Nothing = do
|
||||
content <- calcRepo $ gitAnnexLocation oldkey
|
||||
let source = KeySource
|
||||
{ keyFilename = file
|
||||
{ keyFilename = fromRawFilePath file
|
||||
, contentLocation = content
|
||||
, inodeCache = Nothing
|
||||
}
|
||||
|
|
|
@ -47,7 +47,7 @@ seek o = startConcurrency transferStages $
|
|||
(withFilesInGit (commandAction . (whenAnnexed $ start o)))
|
||||
=<< workTreeItems (mirrorFiles o)
|
||||
|
||||
start :: MirrorOptions -> FilePath -> Key -> CommandStart
|
||||
start :: MirrorOptions -> RawFilePath -> Key -> CommandStart
|
||||
start o file k = startKey o afile (k, ai)
|
||||
where
|
||||
afile = AssociatedFile (Just file)
|
||||
|
@ -75,4 +75,4 @@ startKey o afile (key, ai) = case fromToOptions o of
|
|||
where
|
||||
getnumcopies = case afile of
|
||||
AssociatedFile Nothing -> getNumCopies
|
||||
AssociatedFile (Just af) -> getFileNumCopies af
|
||||
AssociatedFile (Just af) -> getFileNumCopies (fromRawFilePath af)
|
||||
|
|
|
@ -5,6 +5,8 @@
|
|||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Command.P2P where
|
||||
|
||||
import Command
|
||||
|
|
|
@ -42,9 +42,11 @@ batchParser s = case separate (== ' ') (reverse s) of
|
|||
| otherwise -> Right (reverse rf, reverse ru)
|
||||
|
||||
start :: (FilePath, URLString) -> CommandStart
|
||||
start (file, url) = flip whenAnnexed file $ \_ key ->
|
||||
starting "rmurl" (mkActionItem (key, AssociatedFile (Just file))) $
|
||||
start (file, url) = flip whenAnnexed file' $ \_ key ->
|
||||
starting "rmurl" (mkActionItem (key, AssociatedFile (Just file'))) $
|
||||
next $ cleanup url key
|
||||
where
|
||||
file' = toRawFilePath file
|
||||
|
||||
cleanup :: String -> Key -> CommandCleanup
|
||||
cleanup url key = do
|
||||
|
|
|
@ -236,7 +236,7 @@ testExportTree st (Just _) ea k1 k2 =
|
|||
]
|
||||
where
|
||||
testexportdirectory = "testremote-export"
|
||||
testexportlocation = mkExportLocation (testexportdirectory </> "location")
|
||||
testexportlocation = mkExportLocation (toRawFilePath (testexportdirectory </> "location"))
|
||||
check desc a = testCase desc $
|
||||
Annex.eval st (Annex.setOutput QuietOutput >> a) @? "failed"
|
||||
storeexport k = do
|
||||
|
@ -252,7 +252,7 @@ testExportTree st (Just _) ea k1 k2 =
|
|||
removeexport k = Remote.removeExport ea k testexportlocation
|
||||
removeexportdirectory = case Remote.removeExportDirectory ea of
|
||||
Nothing -> return True
|
||||
Just a -> a (mkExportDirectory testexportdirectory)
|
||||
Just a -> a (mkExportDirectory (toRawFilePath testexportdirectory))
|
||||
|
||||
testUnavailable :: Annex.AnnexState -> Remote -> Key -> [TestTree]
|
||||
testUnavailable st r k =
|
||||
|
@ -326,7 +326,7 @@ randKey sz = withTmpFile "randkey" $ \f h -> do
|
|||
return k
|
||||
|
||||
getReadonlyKey :: Remote -> FilePath -> Annex Key
|
||||
getReadonlyKey r f = lookupFile f >>= \case
|
||||
getReadonlyKey r f = lookupFile (toRawFilePath f) >>= \case
|
||||
Nothing -> giveup $ f ++ " is not an annexed file"
|
||||
Just k -> do
|
||||
unlessM (inAnnex k) $
|
||||
|
|
|
@ -27,9 +27,9 @@ seek :: CmdParams -> CommandSeek
|
|||
seek ps = do
|
||||
-- Safety first; avoid any undo that would touch files that are not
|
||||
-- in the index.
|
||||
(fs, cleanup) <- inRepo $ LsFiles.notInRepo False ps
|
||||
(fs, cleanup) <- inRepo $ LsFiles.notInRepo False (map toRawFilePath ps)
|
||||
unless (null fs) $
|
||||
giveup $ "Cannot undo changes to files that are not checked into git: " ++ unwords fs
|
||||
giveup $ "Cannot undo changes to files that are not checked into git: " ++ unwords (map fromRawFilePath fs)
|
||||
void $ liftIO $ cleanup
|
||||
|
||||
-- Committing staged changes before undo allows later
|
||||
|
|
|
@ -31,6 +31,7 @@ import Types.StandardGroups
|
|||
import Types.ScheduledActivity
|
||||
import Types.NumCopies
|
||||
import Remote
|
||||
import Git.Types (ConfigKey(..), fromConfigKey, fromConfigValue)
|
||||
|
||||
cmd :: Command
|
||||
cmd = command "vicfg" SectionSetup "edit configuration in git-annex branch"
|
||||
|
@ -70,7 +71,7 @@ data Cfg = Cfg
|
|||
, cfgRequiredContentMap :: M.Map UUID PreferredContentExpression
|
||||
, cfgGroupPreferredContentMap :: M.Map Group PreferredContentExpression
|
||||
, cfgScheduleMap :: M.Map UUID [ScheduledActivity]
|
||||
, cfgGlobalConfigs :: M.Map ConfigName ConfigValue
|
||||
, cfgGlobalConfigs :: M.Map ConfigKey ConfigValue
|
||||
, cfgNumCopies :: Maybe NumCopies
|
||||
}
|
||||
|
||||
|
@ -218,9 +219,9 @@ genCfg cfg descs = unlines $ intercalate [""]
|
|||
[ com "Other global configuration"
|
||||
]
|
||||
(\(s, g) -> gline g s)
|
||||
(\g -> gline g "")
|
||||
(\g -> gline g mempty)
|
||||
where
|
||||
gline g val = [ unwords ["config", g, "=", val] ]
|
||||
gline k v = [ unwords ["config", fromConfigKey k, "=", fromConfigValue v] ]
|
||||
|
||||
line setting u val =
|
||||
[ com $ "(for " ++ fromUUIDDesc (fromMaybe mempty (M.lookup u descs)) ++ ")"
|
||||
|
@ -308,7 +309,7 @@ parseCfg defcfg = go [] defcfg . lines
|
|||
let m = M.insert u l (cfgScheduleMap cfg)
|
||||
in Right $ cfg { cfgScheduleMap = m }
|
||||
| setting == "config" =
|
||||
let m = M.insert f val (cfgGlobalConfigs cfg)
|
||||
let m = M.insert (ConfigKey (encodeBS' f)) (ConfigValue (encodeBS' val)) (cfgGlobalConfigs cfg)
|
||||
in Right $ cfg { cfgGlobalConfigs = m }
|
||||
| setting == "numcopies" = case readish val of
|
||||
Nothing -> Left "parse error (expected an integer)"
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue