filter out control characters in all other Messages
This does, as a side effect, make long notes in json output not be indented. The indentation is only needed to offset them underneath the display of the file they apply to, so that's ok. Sponsored-by: Brock Spratlen on Patreon
This commit is contained in:
parent
a0e6fa18eb
commit
8b6c7bdbcc
54 changed files with 183 additions and 164 deletions
|
@ -182,8 +182,8 @@ startRemote addunlockedmatcher r o si file uri sz = do
|
|||
let file' = joinPath $ map (truncateFilePath pathmax) $
|
||||
splitDirectories file
|
||||
startingAddUrl si uri o $ do
|
||||
showNote $ "from " ++ Remote.name r
|
||||
showDestinationFile file'
|
||||
showNote $ UnquotedString $ "from " ++ Remote.name r
|
||||
showDestinationFile (toRawFilePath file')
|
||||
performRemote addunlockedmatcher r o uri (toRawFilePath file') sz
|
||||
|
||||
performRemote :: AddUnlockedMatcher -> Remote -> AddUrlOptions -> URLString -> RawFilePath -> Maybe Integer -> CommandPerform
|
||||
|
@ -296,7 +296,7 @@ addUrlChecked :: AddUrlOptions -> URLString -> RawFilePath -> UUID -> (Key -> An
|
|||
addUrlChecked o url file u checkexistssize key =
|
||||
ifM ((elem url <$> getUrls key) <&&> (elem u <$> loggedLocations key))
|
||||
( do
|
||||
showDestinationFile (fromRawFilePath file)
|
||||
showDestinationFile file
|
||||
next $ return True
|
||||
, checkexistssize key >>= \case
|
||||
Just (exists, samesize, url')
|
||||
|
@ -337,7 +337,7 @@ downloadWeb addunlockedmatcher o url urlinfo file =
|
|||
, normalfinish tmp backend
|
||||
)
|
||||
normalfinish tmp backend = checkCanAdd o file $ \canadd -> do
|
||||
showDestinationFile (fromRawFilePath file)
|
||||
showDestinationFile file
|
||||
createWorkTreeDirectory (parentDir file)
|
||||
Just <$> finishDownloadWith canadd addunlockedmatcher tmp backend webUUID url file
|
||||
-- Ask youtube-dl what filename it will download first,
|
||||
|
@ -359,7 +359,7 @@ downloadWeb addunlockedmatcher o url urlinfo file =
|
|||
Right (Just mediafile) -> do
|
||||
cleanuptmp
|
||||
checkCanAdd o dest $ \canadd -> do
|
||||
showDestinationFile (fromRawFilePath dest)
|
||||
showDestinationFile dest
|
||||
addWorkTree canadd addunlockedmatcher webUUID mediaurl dest mediakey (Just (toRawFilePath mediafile))
|
||||
return $ Just mediakey
|
||||
Right Nothing -> checkRaw Nothing o Nothing (normalfinish tmp backend)
|
||||
|
@ -409,10 +409,10 @@ startingAddUrl si url o p = starting "addurl" ai si $ do
|
|||
ai = OnlyActionOn urlkey (ActionItemOther (Just (UnquotedString url)))
|
||||
urlkey = Backend.URL.fromUrl url Nothing
|
||||
|
||||
showDestinationFile :: FilePath -> Annex ()
|
||||
showDestinationFile :: RawFilePath -> Annex ()
|
||||
showDestinationFile file = do
|
||||
showNote ("to " ++ file)
|
||||
maybeShowJSON $ JSONChunk [("file", file)]
|
||||
showNote ("to " <> QuotedPath file)
|
||||
maybeShowJSON $ JSONChunk [("file", fromRawFilePath file)]
|
||||
|
||||
{- The Key should be a dummy key, based on the URL, which is used
|
||||
- for this download, before we can examine the file and find its real key.
|
||||
|
@ -525,7 +525,7 @@ youtubeDlDestFile o destfile mediafile
|
|||
|
||||
nodownloadWeb' :: DownloadOptions -> AddUnlockedMatcher -> URLString -> Key -> RawFilePath -> Annex (Maybe Key)
|
||||
nodownloadWeb' o addunlockedmatcher url key file = checkCanAdd o file $ \canadd -> do
|
||||
showDestinationFile (fromRawFilePath file)
|
||||
showDestinationFile file
|
||||
createWorkTreeDirectory (parentDir file)
|
||||
addWorkTree canadd addunlockedmatcher webUUID url file key Nothing
|
||||
return (Just key)
|
||||
|
|
|
@ -233,10 +233,10 @@ checkRequiredContent (PreferredContentChecked False) u k afile =
|
|||
if afile == afile'
|
||||
then showLongNote "That file is required content. It cannot be dropped!"
|
||||
else showLongNote $ "That file has the same content as another file"
|
||||
++ case afile' of
|
||||
AssociatedFile (Just f) -> " (" ++ fromRawFilePath f ++ "),"
|
||||
<> case afile' of
|
||||
AssociatedFile (Just f) -> " (" <> QuotedPath f <> "),"
|
||||
AssociatedFile Nothing -> ""
|
||||
++ " which is required content. It cannot be dropped!"
|
||||
<> " which is required content. It cannot be dropped!"
|
||||
showLongNote "(Use --force to override this check, or adjust required content configuration.)"
|
||||
return False
|
||||
|
||||
|
|
|
@ -50,7 +50,7 @@ start from numcopies mincopies = startUnused "dropunused"
|
|||
perform :: Maybe Remote -> NumCopies -> MinCopies -> Key -> CommandPerform
|
||||
perform from numcopies mincopies key = case from of
|
||||
Just r -> do
|
||||
showAction $ "from " ++ Remote.name r
|
||||
showAction $ UnquotedString $ "from " ++ Remote.name r
|
||||
Command.Drop.performRemote pcc key (AssociatedFile Nothing) numcopies mincopies r ud
|
||||
Nothing -> ifM (inAnnex key)
|
||||
( droplocal
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings, CPP #-}
|
||||
|
||||
module Command.EnableTor where
|
||||
|
||||
|
@ -61,7 +61,7 @@ start _os = do
|
|||
let ps = [Param (cmdname cmd), Param (show curruserid)]
|
||||
sucommand <- liftIO $ mkSuCommand gitannex ps
|
||||
cleanenv <- liftIO $ cleanStandaloneEnvironment
|
||||
maybe noop showLongNote
|
||||
maybe noop (showLongNote . UnquotedString)
|
||||
(describePasswordPrompt' sucommand)
|
||||
ifM (liftIO $ runSuCommand sucommand cleanenv)
|
||||
( next checkHiddenService
|
||||
|
|
|
@ -61,13 +61,13 @@ start (Expire expire) noact actlog descs u =
|
|||
case lastact of
|
||||
Just ent | notexpired ent -> checktrust (== DeadTrusted) $
|
||||
starting "unexpire" ai si $ do
|
||||
showNote =<< whenactive
|
||||
showNote . UnquotedString =<< whenactive
|
||||
unless noact $
|
||||
trustSet u SemiTrusted
|
||||
next $ return True
|
||||
_ -> checktrust (/= DeadTrusted) $
|
||||
starting "expire" ai si $ do
|
||||
showNote =<< whenactive
|
||||
showNote . UnquotedString =<< whenactive
|
||||
unless noact $
|
||||
trustSet u DeadTrusted
|
||||
next $ return True
|
||||
|
|
|
@ -5,6 +5,8 @@
|
|||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Command.Forget where
|
||||
|
||||
import Command
|
||||
|
|
|
@ -159,15 +159,15 @@ performRemote key afile backend numcopies remote =
|
|||
dispatch =<< Remote.hasKey remote key
|
||||
where
|
||||
dispatch (Left err) = do
|
||||
showNote err
|
||||
showNote (UnquotedString err)
|
||||
return False
|
||||
dispatch (Right True) = withtmp $ \tmpfile ->
|
||||
getfile tmpfile >>= \case
|
||||
Nothing -> go True Nothing
|
||||
Just (Right verification) -> go True (Just (tmpfile, verification))
|
||||
Just (Left _) -> do
|
||||
qp <- coreQuotePath <$> Annex.getGitConfig
|
||||
warning $ UnquotedString (decodeBS (actionItemDesc qp ai)) <> ": failed to download file from remote"
|
||||
warning $ actionItemDesc ai
|
||||
<> ": failed to download file from remote"
|
||||
void $ go True Nothing
|
||||
return False
|
||||
dispatch (Right False) = go False Nothing
|
||||
|
@ -350,10 +350,9 @@ verifyLocationLog' key ai present u updatestatus = do
|
|||
return True
|
||||
(False, True) -> do
|
||||
fix InfoMissing
|
||||
qp <- coreQuotePath <$> Annex.getGitConfig
|
||||
warning $
|
||||
"** Based on the location log, " <>
|
||||
QuotedPath (actionItemDesc qp ai) <>
|
||||
actionItemDesc ai <>
|
||||
"\n** was expected to be present, " <>
|
||||
"but its content is missing."
|
||||
return False
|
||||
|
@ -390,11 +389,10 @@ verifyRequiredContent key ai@(ActionItemAssociatedFile afile _) = case afile of
|
|||
if null missinglocs
|
||||
then return True
|
||||
else do
|
||||
qp <- coreQuotePath <$> Annex.getGitConfig
|
||||
missingrequired <- Remote.prettyPrintUUIDs "missingrequired" missinglocs
|
||||
warning $
|
||||
"** Required content " <>
|
||||
QuotedPath (actionItemDesc qp ai) <>
|
||||
actionItemDesc ai <>
|
||||
" is missing from these repositories:\n" <>
|
||||
UnquotedString missingrequired
|
||||
return False
|
||||
|
@ -467,9 +465,7 @@ checkKeySizeOr bad key file ai = case fromKey keySize key of
|
|||
return same
|
||||
badsize a b = do
|
||||
msg <- bad key
|
||||
qp <- coreQuotePath <$> Annex.getGitConfig
|
||||
warning $
|
||||
QuotedPath (actionItemDesc qp ai)
|
||||
warning $ actionItemDesc ai
|
||||
<> ": Bad file size ("
|
||||
<> UnquotedString (compareSizes storageUnits True a b)
|
||||
<> "); "
|
||||
|
@ -485,12 +481,10 @@ checkKeyUpgrade :: Backend -> Key -> ActionItem -> AssociatedFile -> Annex Bool
|
|||
checkKeyUpgrade backend key ai (AssociatedFile (Just file)) =
|
||||
case Types.Backend.canUpgradeKey backend of
|
||||
Just a | a key -> do
|
||||
qp <- coreQuotePath <$> Annex.getGitConfig
|
||||
warning $
|
||||
QuotedPath (actionItemDesc qp ai)
|
||||
warning $ actionItemDesc ai
|
||||
<> ": Can be upgraded to an improved key format. "
|
||||
<> "You can do so by running: git annex migrate --backend="
|
||||
<> UnquotedString (decodeBS (formatKeyVariety (fromKey keyVariety key)))
|
||||
<> UnquotedByteString (formatKeyVariety (fromKey keyVariety key))
|
||||
<> " "
|
||||
<> QuotedPath file
|
||||
return True
|
||||
|
@ -537,9 +531,7 @@ checkBackendOr bad backend key file ai =
|
|||
ok <- verifier key file
|
||||
unless ok $ do
|
||||
msg <- bad key
|
||||
qp <- coreQuotePath <$> Annex.getGitConfig
|
||||
warning $
|
||||
QuotedPath (actionItemDesc qp ai)
|
||||
warning $ actionItemDesc ai
|
||||
<> ": Bad file content; "
|
||||
<> UnquotedString msg
|
||||
return ok
|
||||
|
@ -565,9 +557,7 @@ checkInodeCache key content mic ai = case mic of
|
|||
withTSDelta (liftIO . genInodeCache content) >>= \case
|
||||
Nothing -> noop
|
||||
Just ic' -> whenM (compareInodeCaches ic ic') $ do
|
||||
qp <- coreQuotePath <$> Annex.getGitConfig
|
||||
warning $
|
||||
QuotedPath (actionItemDesc qp ai)
|
||||
warning $ actionItemDesc ai
|
||||
<> ": Stale or missing inode cache; updating."
|
||||
Database.Keys.addInodeCaches key [ic]
|
||||
|
||||
|
|
|
@ -93,7 +93,7 @@ getKey' :: Key -> AssociatedFile -> [Remote] -> Annex Bool
|
|||
getKey' key afile = dispatch
|
||||
where
|
||||
dispatch [] = do
|
||||
showNote "not available"
|
||||
showNote (UnquotedString "not available")
|
||||
showlocs []
|
||||
return False
|
||||
dispatch remotes = notifyTransfer Download afile $ \witness -> do
|
||||
|
@ -116,6 +116,6 @@ getKey' key afile = dispatch
|
|||
either (const False) id <$> Remote.hasKey r key
|
||||
| otherwise = return True
|
||||
docopy r witness = do
|
||||
showAction $ "from " ++ Remote.name r
|
||||
showAction $ UnquotedString $ "from " ++ Remote.name r
|
||||
logStatusAfter key $
|
||||
download r key afile stdRetry witness
|
||||
|
|
|
@ -154,7 +154,7 @@ startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) =
|
|||
si = SeekInput []
|
||||
|
||||
deletedup k = do
|
||||
showNote $ "duplicate of " ++ serializeKey k
|
||||
showNote $ UnquotedString $ "duplicate of " ++ serializeKey k
|
||||
verifyExisting k destfile
|
||||
( do
|
||||
liftIO $ R.removeLink srcfile
|
||||
|
@ -300,7 +300,9 @@ startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) =
|
|||
(reinject k)
|
||||
(importfile ld k)
|
||||
_ -> importfile ld k
|
||||
skipbecause s = showNote (s ++ "; skipping") >> next (return True)
|
||||
skipbecause s = do
|
||||
showNote (s <> "; skipping")
|
||||
next (return True)
|
||||
|
||||
verifyExisting :: Key -> RawFilePath -> (CommandPerform, CommandPerform) -> CommandPerform
|
||||
verifyExisting key destfile (yes, no) = do
|
||||
|
|
|
@ -16,7 +16,6 @@ import Text.Feed.Query
|
|||
import Text.Feed.Types
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Map as M
|
||||
import Data.Char
|
||||
import Data.Time.Clock
|
||||
import Data.Time.Format
|
||||
import Data.Time.Calendar
|
||||
|
@ -95,9 +94,9 @@ getFeed addunlockedmatcher opts cache url = do
|
|||
go tmpf = liftIO (parseFeedFromFile' tmpf) >>= \case
|
||||
Nothing -> debugfeedcontent tmpf "parsing the feed failed"
|
||||
Just f -> do
|
||||
case map sanitizetitle $ decodeBS $ fromFeedText $ getFeedTitle f of
|
||||
case decodeBS $ fromFeedText $ getFeedTitle f of
|
||||
"" -> noop
|
||||
t -> showNote ('"' : t ++ "\"")
|
||||
t -> showNote (UnquotedString ('"' : t ++ "\""))
|
||||
case findDownloads url f of
|
||||
[] -> debugfeedcontent tmpf "bad feed content; no enclosures to download"
|
||||
l -> do
|
||||
|
@ -107,9 +106,6 @@ getFeed addunlockedmatcher opts cache url = do
|
|||
, void $ feedProblem url
|
||||
"problem downloading some item(s) from feed"
|
||||
)
|
||||
sanitizetitle c
|
||||
| isControl c = '_'
|
||||
| otherwise = c
|
||||
debugfeedcontent tmpf msg = do
|
||||
feedcontent <- liftIO $ readFile tmpf
|
||||
fastDebug "Command.ImportFeed" $ unlines
|
||||
|
|
|
@ -183,7 +183,7 @@ itemInfo o (si, p) = ifM (isdir (toRawFilePath p))
|
|||
noInfo :: String -> SeekInput -> String -> Annex ()
|
||||
noInfo s si msg = do
|
||||
showStartMessage (StartMessage "info" (ActionItemOther (Just (UnquotedString s))) si)
|
||||
showNote msg
|
||||
showNote (UnquotedString msg)
|
||||
showEndFail
|
||||
Annex.incError
|
||||
|
||||
|
@ -463,7 +463,7 @@ transfer_list = stat desc $ nojson $ lift $ do
|
|||
desc = "transfers in progress"
|
||||
line qp uuidmap t i = unwords
|
||||
[ fromRawFilePath (formatDirection (transferDirection t)) ++ "ing"
|
||||
, fromRawFilePath $ actionItemDesc qp $ mkActionItem
|
||||
, fromRawFilePath $ quote qp $ actionItemDesc $ mkActionItem
|
||||
(transferKey t, associatedFile i)
|
||||
, if transferDirection t == Upload then "to" else "from"
|
||||
, maybe (fromUUID $ transferUUID t) Remote.name $
|
||||
|
|
|
@ -5,6 +5,8 @@
|
|||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Command.Map where
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
@ -62,11 +64,11 @@ start = startingNoMessage (ActionItemOther Nothing) $ do
|
|||
|
||||
runViewer :: FilePath -> [(String, [CommandParam])] -> Annex Bool
|
||||
runViewer file [] = do
|
||||
showLongNote $ "left map in " ++ file
|
||||
showLongNote $ UnquotedString $ "left map in " ++ file
|
||||
return True
|
||||
runViewer file ((c, ps):rest) = ifM (liftIO $ inSearchPath c)
|
||||
( do
|
||||
showLongNote $ "running: " ++ c ++ unwords (toCommand ps)
|
||||
showLongNote $ UnquotedString $ "running: " ++ c ++ unwords (toCommand ps)
|
||||
showOutput
|
||||
liftIO $ boolSystem c ps
|
||||
, runViewer file rest
|
||||
|
|
|
@ -129,7 +129,7 @@ cleanup k = do
|
|||
case toJSON' (AddJSONActionItemFields m) of
|
||||
Object o -> maybeShowJSON $ AesonObject o
|
||||
_ -> noop
|
||||
showLongNote $ unlines $ concatMap showmeta $
|
||||
showLongNote $ UnquotedString $ unlines $ concatMap showmeta $
|
||||
map unwrapmeta (fromMetaData m)
|
||||
return True
|
||||
where
|
||||
|
|
|
@ -157,10 +157,10 @@ toPerform' mcontentlock dest removewhen key afile fastcheck isthere = do
|
|||
srcuuid <- getUUID
|
||||
case isthere of
|
||||
Left err -> do
|
||||
showNote err
|
||||
showNote (UnquotedString err)
|
||||
stop
|
||||
Right False -> logMove srcuuid destuuid False key $ \deststartedwithcopy -> do
|
||||
showAction $ "to " ++ Remote.name dest
|
||||
showAction $ UnquotedString $ "to " ++ Remote.name dest
|
||||
ok <- notifyTransfer Upload afile $
|
||||
upload dest key afile stdRetry
|
||||
if ok
|
||||
|
@ -260,7 +260,7 @@ fromPerform src removewhen key afile = do
|
|||
|
||||
fromPerform' :: Bool -> Bool -> Remote -> Key -> AssociatedFile -> Annex (RemoveWhen -> CommandPerform)
|
||||
fromPerform' present updatelocationlog src key afile = do
|
||||
showAction $ "from " ++ Remote.name src
|
||||
showAction $ UnquotedString $ "from " ++ Remote.name src
|
||||
destuuid <- getUUID
|
||||
logMove (Remote.uuid src) destuuid present key $ \deststartedwithcopy ->
|
||||
if present
|
||||
|
@ -314,7 +314,7 @@ fromDrop src destuuid deststartedwithcopy key afile adjusttocheck =
|
|||
|
||||
faileddropremote = do
|
||||
showLongNote "(Use --force to override this check, or adjust numcopies.)"
|
||||
showLongNote $ "Content not dropped from " ++ Remote.name src ++ "."
|
||||
showLongNote $ UnquotedString $ "Content not dropped from " ++ Remote.name src ++ "."
|
||||
logMoveCleanup deststartedwithcopy
|
||||
next $ return False
|
||||
|
||||
|
@ -394,11 +394,13 @@ fromToPerform src dest removewhen key afile = do
|
|||
haskey <- Remote.hasKey dest key
|
||||
case haskey of
|
||||
Left err -> do
|
||||
showNote err
|
||||
showNote (UnquotedString err)
|
||||
stop
|
||||
Right True -> do
|
||||
showAction $ "from " ++ Remote.name src
|
||||
showAction $ "to " ++ Remote.name dest
|
||||
showAction $ UnquotedString $
|
||||
"from " ++ Remote.name src
|
||||
showAction $ UnquotedString $
|
||||
"to " ++ Remote.name dest
|
||||
-- The log may not indicate dest's copy
|
||||
-- yet, so make sure it does.
|
||||
logChange key (Remote.uuid dest) InfoPresent
|
||||
|
|
|
@ -72,7 +72,7 @@ changeMetaData k metadata = do
|
|||
return True
|
||||
|
||||
showMetaDataChange :: MetaData -> Annex ()
|
||||
showMetaDataChange = showLongNote . unlines . concatMap showmeta . fromMetaData
|
||||
showMetaDataChange = showLongNote . UnquotedString . unlines . concatMap showmeta . fromMetaData
|
||||
where
|
||||
showmeta (f, vs) = map (showmetavalue f) $ S.toList vs
|
||||
showmetavalue f v = T.unpack (fromMetaField f) <> showset v <> "=" <> decodeBS (fromMetaValue v)
|
||||
|
|
|
@ -73,7 +73,7 @@ perform a o key url = do
|
|||
_ -> Remote.claimingUrl url
|
||||
case needremote of
|
||||
Just nr | nr /= r -> do
|
||||
showNote $ "The url " ++ url ++ " is claimed by remote " ++ Remote.name r
|
||||
showNote $ UnquotedString $ "The url " ++ url ++ " is claimed by remote " ++ Remote.name r
|
||||
next $ return False
|
||||
_ -> do
|
||||
a r key (setDownloader' url r)
|
||||
|
|
|
@ -948,14 +948,14 @@ seekExportContent o rs (currbranch, _) = or <$> forM rs go
|
|||
warncannotupdateexport r mtb exported currb = case mtb of
|
||||
Nothing -> inRepo (Git.Ref.tree currb) >>= \case
|
||||
Just currt | not (any (== currt) (exportedTreeishes exported)) ->
|
||||
showLongNote $ unwords
|
||||
showLongNote $ UnquotedString $ unwords
|
||||
[ notupdating
|
||||
, "to reflect changes to the tree, because export"
|
||||
, "tracking is not enabled. "
|
||||
, "(Set " ++ gitconfig ++ " to enable it.)"
|
||||
]
|
||||
_ -> noop
|
||||
Just b -> showLongNote $ unwords
|
||||
Just b -> showLongNote $ UnquotedString $ unwords
|
||||
[ notupdating
|
||||
, "because " ++ Git.fromRef b ++ " does not exist."
|
||||
, "(As configured by " ++ gitconfig ++ ")"
|
||||
|
|
|
@ -109,7 +109,8 @@ check :: FilePath -> ([(Int, Key)] -> String) -> Annex [Key] -> Int -> Annex Int
|
|||
check file msg a c = do
|
||||
l <- a
|
||||
let unusedlist = number c l
|
||||
unless (null l) $ showLongNote $ msg unusedlist
|
||||
unless (null l) $
|
||||
showLongNote $ UnquotedString $ msg unusedlist
|
||||
updateUnusedLog (toRawFilePath file) (M.fromList unusedlist)
|
||||
return $ c + length l
|
||||
|
||||
|
@ -249,7 +250,7 @@ withKeysReferencedDiffGitRefs refspec a = do
|
|||
- differ from those referenced in the index. -}
|
||||
withKeysReferencedDiffGitRef :: (Key -> Annex ()) -> Git.Ref -> Annex ()
|
||||
withKeysReferencedDiffGitRef a ref = do
|
||||
showAction $ "checking " ++ Git.Ref.describe ref
|
||||
showAction $ UnquotedString $ "checking " ++ Git.Ref.describe ref
|
||||
withKeysReferencedDiff a
|
||||
(inRepo $ DiffTree.diffIndex ref)
|
||||
DiffTree.srcsha
|
||||
|
|
|
@ -5,6 +5,8 @@
|
|||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Command.VAdd where
|
||||
|
||||
import Command
|
||||
|
|
|
@ -5,6 +5,8 @@
|
|||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Command.VCycle where
|
||||
|
||||
import Command
|
||||
|
|
|
@ -120,7 +120,7 @@ checkoutViewBranch view madj mkbranch = do
|
|||
forM_ l (removeemptydir top)
|
||||
liftIO $ void cleanup
|
||||
unlessM (liftIO $ doesDirectoryExist here) $ do
|
||||
showLongNote (cwdmissing (fromRawFilePath top))
|
||||
showLongNote $ UnquotedString $ cwdmissing (fromRawFilePath top)
|
||||
return ok
|
||||
where
|
||||
removeemptydir top d = do
|
||||
|
|
|
@ -87,12 +87,14 @@ perform o remotemap key ai = do
|
|||
case formatOption o of
|
||||
Nothing -> do
|
||||
let num = length safelocations
|
||||
showNote $ show num ++ " " ++ copiesplural num
|
||||
showNote $ UnquotedString $ show num ++ " " ++ copiesplural num
|
||||
pp <- ppwhereis "whereis" safelocations urls
|
||||
unless (null safelocations) $ showLongNote pp
|
||||
unless (null safelocations) $
|
||||
showLongNote (UnquotedString pp)
|
||||
pp' <- ppwhereis "untrusted" untrustedlocations urls
|
||||
unless (null untrustedlocations) $ showLongNote $ untrustedheader ++ pp'
|
||||
|
||||
unless (null untrustedlocations) $
|
||||
showLongNote $ UnquotedString $
|
||||
untrustedheader ++ pp'
|
||||
mapM_ (showRemoteUrls remotemap) urls
|
||||
Just formatter -> liftIO $ do
|
||||
let vs = Command.Find.formatVars key
|
||||
|
@ -160,6 +162,6 @@ showRemoteUrls :: M.Map UUID Remote -> (UUID, [URLString]) -> Annex ()
|
|||
showRemoteUrls remotemap (uu, us)
|
||||
| null us = noop
|
||||
| otherwise = case M.lookup uu remotemap of
|
||||
Just r -> showLongNote $
|
||||
Just r -> showLongNote $ UnquotedString $
|
||||
unlines $ map (\u -> name r ++ ": " ++ u) us
|
||||
Nothing -> noop
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue