diff --git a/Annex/AdjustedBranch/Merge.hs b/Annex/AdjustedBranch/Merge.hs index ee55cf8460..f9c4bd5d43 100644 --- a/Annex/AdjustedBranch/Merge.hs +++ b/Annex/AdjustedBranch/Merge.hs @@ -98,7 +98,7 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm -- (for an unknown reason). -- http://thread.gmane.org/gmane.comp.version-control.git/297237 inRepo $ Git.Command.run [Param "reset", Param "HEAD", Param "--quiet"] - showAction $ "Merging into " ++ fromRef (Git.Ref.base origbranch) + showAction $ UnquotedString $ "Merging into " ++ fromRef (Git.Ref.base origbranch) merged <- autoMergeFrom' tomerge Nothing mergeconfig commitmode True (const $ resolveMerge (Just updatedorig) tomerge True) if merged diff --git a/Annex/Branch.hs b/Annex/Branch.hs index d3caf08169..ab4b43df3c 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -243,7 +243,7 @@ updateTo' pairs = do " into " ++ fromRef name localtransitions <- getLocalTransitions unless (null tomerge) $ do - showSideAction merge_desc + showSideAction (UnquotedString merge_desc) mapM_ checkBranchDifferences refs mergeIndex jl refs let commitrefs = nub $ fullname:refs diff --git a/Annex/Init.hs b/Annex/Init.hs index a82deffd15..bb566ff9ad 100644 --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -404,8 +404,8 @@ checkSqliteWorks = do Right () -> return () Left e -> do showLongNote $ "Detected a filesystem where Sqlite does not work." - showLongNote $ "(" ++ show e ++ ")" - showLongNote $ "To work around this problem, you can set annex.dbdir " ++ + showLongNote $ UnquotedString $ "(" ++ show e ++ ")" + showLongNote $ "To work around this problem, you can set annex.dbdir " <> "to a directory on another filesystem." showLongNote $ "For example: git config annex.dbdir $HOME/cache/git-annex" giveup "Not initialized." diff --git a/Annex/NumCopies.hs b/Annex/NumCopies.hs index bcab47d1b6..82f963058c 100644 --- a/Annex/NumCopies.hs +++ b/Annex/NumCopies.hs @@ -5,7 +5,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} -{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-} +{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, OverloadedStrings #-} module Annex.NumCopies ( module Types.NumCopies, @@ -277,17 +277,17 @@ notEnoughCopies :: Key -> NumCopies -> MinCopies -> [VerifiedCopy] -> [UUID] -> notEnoughCopies key neednum needmin have skip bad nolocmsg lockunsupported = do showNote "unsafe" if length have < fromNumCopies neednum - then showLongNote $ + then showLongNote $ UnquotedString $ "Could only verify the existence of " ++ show (length have) ++ " out of " ++ show (fromNumCopies neednum) ++ " necessary " ++ pluralcopies (fromNumCopies neednum) else do - showLongNote $ "Unable to lock down " ++ show (fromMinCopies needmin) ++ + showLongNote $ UnquotedString $ "Unable to lock down " ++ show (fromMinCopies needmin) ++ " " ++ pluralcopies (fromMinCopies needmin) ++ " of file necessary to safely drop it." if null lockunsupported then showLongNote "(This could have happened because of a concurrent drop, or because a remote has too old a version of git-annex-shell installed.)" - else showLongNote $ "These remotes do not support locking: " + else showLongNote $ UnquotedString $ "These remotes do not support locking: " ++ Remote.listRemoteNames lockunsupported Remote.showTriedRemotes bad diff --git a/Annex/SpecialRemote.hs b/Annex/SpecialRemote.hs index d863f26055..aab29cf564 100644 --- a/Annex/SpecialRemote.hs +++ b/Annex/SpecialRemote.hs @@ -96,7 +96,7 @@ autoEnable = do Nothing -> cu case (lookupName c, findType c) of (Just name, Right t) -> do - showSideAction $ "Auto enabling special remote " ++ name + showSideAction $ UnquotedString $ "Auto enabling special remote " ++ name dummycfg <- liftIO dummyRemoteGitConfig tryNonAsync (setup t (AutoEnable c) (Just u) Nothing c dummycfg) >>= \case Left e -> warning (UnquotedString (show e)) diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs index 2ecf096b68..338104e24c 100644 --- a/Annex/Transfer.hs +++ b/Annex/Transfer.hs @@ -339,7 +339,7 @@ configuredRetry numretries _old new = do if numretries < maxretries then do let retrydelay = Seconds (initretrydelay * 2^(numretries-1)) - showSideAction $ "Delaying " ++ show (fromSeconds retrydelay) ++ "s before retrying." + showSideAction $ UnquotedString $ "Delaying " ++ show (fromSeconds retrydelay) ++ "s before retrying." liftIO $ threadDelaySeconds retrydelay return True else return False diff --git a/Annex/Verify.hs b/Annex/Verify.hs index 3b95bac30f..97f71297f9 100644 --- a/Annex/Verify.hs +++ b/Annex/Verify.hs @@ -128,7 +128,7 @@ resumeVerifyKeyContent k f iv = liftIO (positionIncrementalVerifier iv) >>= \cas liftIO $ catchDefaultIO (Just False) $ finalizeIncrementalVerifier iv | otherwise = do - showAction (descIncrementalVerifier iv) + showAction (UnquotedString (descIncrementalVerifier iv)) liftIO $ catchDefaultIO (Just False) $ withBinaryFile (fromRawFilePath f) ReadMode $ \h -> do hSeek h AbsoluteSeek endpos diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 60b143d224..1f5ebf80a0 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -5,7 +5,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} -{-# LANGUAGE DeriveDataTypeable, CPP #-} +{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, CPP #-} module Assistant.Threads.Watcher ( watchThread, diff --git a/Backend/Hash.hs b/Backend/Hash.hs index 86f9ea661a..3fcba6a1fb 100644 --- a/Backend/Hash.hs +++ b/Backend/Hash.hs @@ -124,7 +124,7 @@ checkKeyChecksum hash key file = catchIOErrorType HardwareFault hwfault $ do exists <- liftIO $ R.doesPathExist file case (exists, fast) of (True, False) -> do - showAction descChecksum + showAction (UnquotedString descChecksum) sameCheckSum key <$> hashFile hash file nullMeterUpdate _ -> return True diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 5997fba5f0..cfb40604b3 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -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) diff --git a/Command/Drop.hs b/Command/Drop.hs index 8c4f34f812..0a55b4937a 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -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 diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 33a54279ea..9fcd995be7 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -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 diff --git a/Command/EnableTor.hs b/Command/EnableTor.hs index 71a99f9865..8e837a27c6 100644 --- a/Command/EnableTor.hs +++ b/Command/EnableTor.hs @@ -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 diff --git a/Command/Expire.hs b/Command/Expire.hs index db634e0767..ad0f83f5d6 100644 --- a/Command/Expire.hs +++ b/Command/Expire.hs @@ -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 diff --git a/Command/Forget.hs b/Command/Forget.hs index 229148d9ff..fb8de396aa 100644 --- a/Command/Forget.hs +++ b/Command/Forget.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Command.Forget where import Command diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 3992503d55..f3b1814466 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -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] diff --git a/Command/Get.hs b/Command/Get.hs index f19f7daf01..f11296c76f 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -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 diff --git a/Command/Import.hs b/Command/Import.hs index 193a066deb..e00af9fdfc 100644 --- a/Command/Import.hs +++ b/Command/Import.hs @@ -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 diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs index 07c289d7ce..c254ee8f59 100644 --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -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 diff --git a/Command/Info.hs b/Command/Info.hs index b6d12841f1..2d57891b4c 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -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 $ diff --git a/Command/Map.hs b/Command/Map.hs index 2674fac501..2ea732ac5d 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -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 diff --git a/Command/MetaData.hs b/Command/MetaData.hs index 4568b1f8df..2bb0bd6b11 100644 --- a/Command/MetaData.hs +++ b/Command/MetaData.hs @@ -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 diff --git a/Command/Move.hs b/Command/Move.hs index 96f1b5c6a7..fb3cd03ffa 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -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 diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index f58a44f354..dbb2ce3e25 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -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) diff --git a/Command/RegisterUrl.hs b/Command/RegisterUrl.hs index dfe9ef359e..4cdac7c555 100644 --- a/Command/RegisterUrl.hs +++ b/Command/RegisterUrl.hs @@ -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) diff --git a/Command/Sync.hs b/Command/Sync.hs index 2f5d17ec71..3806184a9e 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -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 ++ ")" diff --git a/Command/Unused.hs b/Command/Unused.hs index 6af02c55ff..26e0f29bb3 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -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 diff --git a/Command/VAdd.hs b/Command/VAdd.hs index 3c002645c6..8712f7d13c 100644 --- a/Command/VAdd.hs +++ b/Command/VAdd.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Command.VAdd where import Command diff --git a/Command/VCycle.hs b/Command/VCycle.hs index e3b4a9fddc..b4d1c6df19 100644 --- a/Command/VCycle.hs +++ b/Command/VCycle.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Command.VCycle where import Command diff --git a/Command/View.hs b/Command/View.hs index 349688eb96..c510d3671b 100644 --- a/Command/View.hs +++ b/Command/View.hs @@ -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 diff --git a/Command/Whereis.hs b/Command/Whereis.hs index 1345ef7eb7..9052147249 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -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 diff --git a/Creds.hs b/Creds.hs index 1ec927bf94..cfc6c3dc83 100644 --- a/Creds.hs +++ b/Creds.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Creds ( module Types.Creds, CredPairStorage(..), diff --git a/Git/FilePath.hs b/Git/FilePath.hs index 5ad6f3aba1..37b046fc3f 100644 --- a/Git/FilePath.hs +++ b/Git/FilePath.hs @@ -30,13 +30,12 @@ module Git.FilePath ( import Common import Git -import qualified Git.Filename as Filename +import Git.Filename import qualified System.FilePath.ByteString as P import qualified System.FilePath.Posix.ByteString import GHC.Generics import Control.DeepSeq -import qualified Data.ByteString as S {- A RawFilePath, relative to the top of the git repository. -} newtype TopFilePath = TopFilePath { getTopFilePath :: RawFilePath } @@ -49,9 +48,9 @@ data BranchFilePath = BranchFilePath Ref TopFilePath deriving (Show, Eq, Ord) {- Git uses the branch:file form to refer to a BranchFilePath -} -descBranchFilePath :: Filename.QuotePath -> BranchFilePath -> S.ByteString -descBranchFilePath qp (BranchFilePath b f) = - fromRef' b <> ":" <> Filename.quote qp (getTopFilePath f) +descBranchFilePath :: BranchFilePath -> StringContainingQuotedPath +descBranchFilePath (BranchFilePath b f) = + UnquotedByteString (fromRef' b) <> ":" <> QuotedPath (getTopFilePath f) {- Path to a TopFilePath, within the provided git repo. -} fromTopFilePath :: TopFilePath -> Git.Repo -> RawFilePath diff --git a/Git/Filename.hs b/Git/Filename.hs index f515a68ef3..2e86e9efff 100644 --- a/Git/Filename.hs +++ b/Git/Filename.hs @@ -76,6 +76,7 @@ instance Quoteable RawFilePath where -- Eg: QuotedPath f <> ": not found" data StringContainingQuotedPath = UnquotedString String + | UnquotedByteString S.ByteString | QuotedPath RawFilePath | StringContainingQuotedPath :+: StringContainingQuotedPath deriving (Show, Eq) @@ -88,10 +89,12 @@ quotedPaths (p:ps) = QuotedPath p <> if null ps instance Quoteable StringContainingQuotedPath where quote _ (UnquotedString s) = safeOutput (encodeBS s) + quote _ (UnquotedByteString s) = safeOutput s quote qp (QuotedPath p) = quote qp p quote qp (a :+: b) = quote qp a <> quote qp b noquote (UnquotedString s) = encodeBS s + noquote (UnquotedByteString s) = s noquote (QuotedPath p) = p noquote (a :+: b) = noquote a <> noquote b @@ -100,10 +103,11 @@ instance IsString StringContainingQuotedPath where instance Sem.Semigroup StringContainingQuotedPath where UnquotedString a <> UnquotedString b = UnquotedString (a <> b) + UnquotedByteString a <> UnquotedByteString b = UnquotedByteString (a <> b) a <> b = a :+: b instance Monoid StringContainingQuotedPath where - mempty = UnquotedString mempty + mempty = UnquotedByteString mempty -- Encoding and then decoding roundtrips only when the string does not -- contain high unicode, because eg, both "\12345" and "\227\128\185" diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index 4ceb0f9959..a35474781d 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -36,7 +36,7 @@ describeTransfer :: Git.Filename.QuotePath -> Transfer -> TransferInfo -> String describeTransfer qp t info = unwords [ show $ transferDirection t , show $ transferUUID t - , decodeBS $ actionItemDesc qp $ ActionItemAssociatedFile + , decodeBS $ quote qp $ actionItemDesc $ ActionItemAssociatedFile (associatedFile info) (transferKey t) , show $ bytesComplete info diff --git a/Messages.hs b/Messages.hs index 5b6ed426f9..c9f4500a37 100644 --- a/Messages.hs +++ b/Messages.hs @@ -65,6 +65,8 @@ import Messages.Internal import Messages.Concurrent import Annex.Debug import Annex.Concurrent.Utility +import Utility.SafeOutput +import Git.Filename import qualified Messages.JSON as JSON import qualified Annex @@ -90,15 +92,13 @@ showStartMessage (CustomOutput _) = _ -> noop showStartActionItem :: String -> ActionItem -> SeekInput -> Annex () -showStartActionItem command ai si = do - qp <- coreQuotePath <$> Annex.getGitConfig - outputMessage json $ - encodeBS command <> " " <> actionItemDesc qp ai <> " " +showStartActionItem command ai si = outputMessage json id $ + UnquotedString command <> " " <> actionItemDesc ai <> " " where json = JSON.start command (actionItemFile ai) (actionItemKey ai) si showStartNothing :: String -> SeekInput -> Annex () -showStartNothing command si = outputMessage json $ encodeBS $ +showStartNothing command si = outputMessage json id $ UnquotedString $ command ++ " " where json = JSON.start command Nothing Nothing si @@ -110,13 +110,13 @@ showEndMessage (StartUsualMessages _ _ _) = showEndResult showEndMessage (StartNoMessage _) = const noop showEndMessage (CustomOutput _) = const noop -showNote :: String -> Annex () -showNote s = outputMessage (JSON.note s) $ encodeBS $ "(" ++ s ++ ") " +showNote :: StringContainingQuotedPath -> Annex () +showNote s = outputMessage (JSON.note (decodeBS (noquote s))) id $ "(" <> s <> ") " -showAction :: String -> Annex () -showAction s = showNote $ s ++ "..." +showAction :: StringContainingQuotedPath -> Annex () +showAction s = showNote $ s <> "..." -showSideAction :: String -> Annex () +showSideAction :: StringContainingQuotedPath -> Annex () showSideAction m = Annex.getState Annex.output >>= go where go st @@ -126,7 +126,7 @@ showSideAction m = Annex.getState Annex.output >>= go Annex.changeState $ \s -> s { Annex.output = st' } | sideActionBlock st == InBlock = return () | otherwise = go' - go' = outputMessage JSON.none $ encodeBS $ "(" ++ m ++ "...)\n" + go' = outputMessage JSON.none id $ "(" <> m <> "...)\n" showStoringStateAction :: Annex () showStoringStateAction = showSideAction "recording state in git" @@ -167,19 +167,18 @@ doQuietAction = bracket setup cleanup . const {- Make way for subsequent output of a command. -} showOutput :: Annex () showOutput = unlessM commandProgressDisabled $ - outputMessage JSON.none "\n" + outputMessage JSON.none id "\n" -showLongNote :: String -> Annex () -showLongNote s = outputMessage (JSON.note s) (formatLongNote (encodeBS s)) +showLongNote :: StringContainingQuotedPath -> Annex () +showLongNote s = outputMessage (JSON.note (decodeBS (noquote s))) formatLongNote s formatLongNote :: S.ByteString -> S.ByteString formatLongNote s = "\n" <> indent s <> "\n" -- Used by external special remote, displayed same as showLongNote -- to console, but json object containing the info is emitted immediately. -showInfo :: String -> Annex () -showInfo s = outputMessage' outputJSON (JSON.info s) $ - formatLongNote (encodeBS s) +showInfo :: StringContainingQuotedPath -> Annex () +showInfo s = outputMessage' outputJSON (JSON.info (decodeBS (noquote s))) formatLongNote s showEndOk :: Annex () showEndOk = showEndResult True @@ -188,7 +187,8 @@ showEndFail :: Annex () showEndFail = showEndResult False showEndResult :: Bool -> Annex () -showEndResult ok = outputMessage (JSON.end ok) $ endResult ok <> "\n" +showEndResult ok = outputMessage (JSON.end ok) id $ + UnquotedByteString (endResult ok) <> "\n" endResult :: Bool -> S.ByteString endResult True = "ok" @@ -206,7 +206,7 @@ earlyWarning = warning' False id warning' :: Bool -> (S.ByteString -> S.ByteString) -> StringContainingQuotedPath -> Annex () warning' makeway consolewhitespacef w = do when makeway $ - outputMessage JSON.none "\n" + outputMessage JSON.none id "\n" outputError consolewhitespacef (w <> "\n") {- Not concurrent output safe. -} @@ -214,7 +214,7 @@ warningIO :: String -> IO () warningIO w = do putStr "\n" hFlush stdout - hPutStrLn stderr w + hPutStrLn stderr (safeOutput w) indent :: S.ByteString -> S.ByteString indent = S.intercalate "\n" . map (" " <>) . S8.lines @@ -230,19 +230,19 @@ showFullJSON v = withMessageState $ bufferJSON (JSON.complete v) {- Performs an action that outputs nonstandard/customized output, and - in JSON mode wraps its output in JSON.start and JSON.end, so it's - a complete JSON document. - - This is only needed when showStart* and showEndOk is not used. + - This is only needed when showStartMessage and showEndOk is not used. -} showCustom :: String -> SeekInput -> Annex Bool -> Annex () showCustom command si a = do - outputMessage (JSON.start command Nothing Nothing si) "" + outputMessage (JSON.start command Nothing Nothing si) id "" r <- a - outputMessage (JSON.end r) "" + outputMessage (JSON.end r) id "" showHeader :: S.ByteString -> Annex () -showHeader h = outputMessage JSON.none (h <> ": ") +showHeader h = outputMessage JSON.none id (UnquotedByteString h <> ": ") showRaw :: S.ByteString -> Annex () -showRaw s = outputMessage JSON.none (s <> "\n") +showRaw s = outputMessage JSON.none id (UnquotedByteString s <> "\n") setupConsole :: IO () setupConsole = do @@ -267,7 +267,7 @@ debugDisplayer = do -- that are displayed at the same time from mixing together. lock <- newMVar () return $ \s -> withMVar lock $ \() -> do - S.hPutStr stderr (s <> "\n") + S.hPutStr stderr (safeOutput s <> "\n") hFlush stderr {- Should commands that normally output progress messages have that diff --git a/Messages/Internal.hs b/Messages/Internal.hs index d3c984e988..0b975cf74c 100644 --- a/Messages/Internal.hs +++ b/Messages/Internal.hs @@ -21,22 +21,25 @@ import qualified Data.ByteString as S withMessageState :: (MessageState -> Annex a) -> Annex a withMessageState a = Annex.getState Annex.output >>= a -outputMessage :: JSONBuilder -> S.ByteString -> Annex () +outputMessage :: JSONBuilder -> (S.ByteString -> S.ByteString) -> StringContainingQuotedPath -> Annex () outputMessage = outputMessage' bufferJSON -outputMessage' :: (JSONBuilder -> MessageState -> Annex Bool) -> JSONBuilder -> S.ByteString -> Annex () -outputMessage' jsonoutputter jsonbuilder msg = withMessageState $ \s -> case outputType s of +outputMessage' :: (JSONBuilder -> MessageState -> Annex Bool) -> JSONBuilder -> (S.ByteString -> S.ByteString) -> StringContainingQuotedPath -> Annex () +outputMessage' jsonoutputter jsonbuilder consolewhitespacef msg = withMessageState $ \s -> case outputType s of NormalOutput | concurrentOutputEnabled s -> do + qp <- coreQuotePath <$> Annex.getGitConfig liftIO $ clearProgressMeter s - concurrentMessage s False (decodeBS msg) q + concurrentMessage s False (decodeBS (consolewhitespacef (quote qp msg))) q | otherwise -> do + qp <- coreQuotePath <$> Annex.getGitConfig liftIO $ clearProgressMeter s - liftIO $ flushed $ S.putStr msg + liftIO $ flushed $ S.putStr (consolewhitespacef (quote qp msg)) JSONOutput _ -> void $ jsonoutputter jsonbuilder s QuietOutput -> q SerializedOutput h _ -> do - liftIO $ outputSerialized h $ OutputMessage msg + qp <- coreQuotePath <$> Annex.getGitConfig + liftIO $ outputSerialized h $ OutputMessage $ consolewhitespacef $ quote qp msg void $ jsonoutputter jsonbuilder s -- Buffer changes to JSON until end is reached and then emit it. diff --git a/Messages/Progress.hs b/Messages/Progress.hs index 832dd9e0f3..d587b9208d 100644 --- a/Messages/Progress.hs +++ b/Messages/Progress.hs @@ -177,7 +177,7 @@ meteredFile file combinemeterupdate key a = {- Progress dots. -} showProgressDots :: Annex () -showProgressDots = outputMessage JSON.none "." +showProgressDots = outputMessage JSON.none id "." {- Runs a command, that may output progress to either stdout or - stderr, as well as other messages. diff --git a/Messages/Serialized.hs b/Messages/Serialized.hs index 9a1cceda0f..2e8ed00d5f 100644 --- a/Messages/Serialized.hs +++ b/Messages/Serialized.hs @@ -52,7 +52,8 @@ relaySerializedOutput getso sendsor meterreport runannex = go Nothing runannex $ outputMessage' (\_ _ -> return False) id - msg + id + (UnquotedByteString msg) loop st Left (OutputError msg) -> do runannex $ outputError id $ UnquotedString msg diff --git a/Remote.hs b/Remote.hs index ac7e4b4712..bd7d0dc505 100644 --- a/Remote.hs +++ b/Remote.hs @@ -365,13 +365,13 @@ showLocations separateuntrusted key exclude nolocmsg = do "Maybe add some of these git remotes (git remote add ...)" ppuuidsskipped <- pp "skipped" uuidsskipped "Also these untrusted repositories may contain the file" - showLongNote $ case ppremotesmakeavailable ++ ppenablespecialremotes ++ ppaddgitremotes ++ ppuuidsskipped of + showLongNote $ UnquotedString $ case ppremotesmakeavailable ++ ppenablespecialremotes ++ ppaddgitremotes ++ ppuuidsskipped of [] -> nolocmsg s -> s ) ignored <- filterM (liftIO . getDynamicConfig . remoteAnnexIgnore . gitconfig) remotes unless (null ignored) $ - showLongNote $ "(Note that these git remotes have annex-ignore set: " ++ unwords (map name ignored) ++ ")" + showLongNote $ UnquotedString $ "(Note that these git remotes have annex-ignore set: " ++ unwords (map name ignored) ++ ")" where filteruuids l x = filter (`notElem` x) l @@ -383,7 +383,7 @@ showLocations separateuntrusted key exclude nolocmsg = do showTriedRemotes :: [Remote] -> Annex () showTriedRemotes [] = noop showTriedRemotes remotes = - showLongNote $ "Unable to access these remotes: " + showLongNote $ UnquotedString $ "Unable to access these remotes: " ++ listRemoteNames remotes listRemoteNames :: [Remote] -> String diff --git a/Remote/External.hs b/Remote/External.hs index 6c9cb4a979..c429dc80fa 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -504,7 +504,7 @@ handleRequest' st external req mp responsehandler mapM_ (send . VALUE) =<< getUrlsWithPrefix key prefix send (VALUE "") -- end of list handleRemoteRequest (DEBUG msg) = fastDebug "Remote.External" msg - handleRemoteRequest (INFO msg) = showInfo msg + handleRemoteRequest (INFO msg) = showInfo (UnquotedString msg) handleRemoteRequest (VERSION _) = senderror "too late to send VERSION" handleExceptionalMessage (ERROR err) = giveup $ "external special remote error: " ++ err diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs index f9625a5623..e0349a2fb6 100644 --- a/Remote/Helper/Encryptable.hs +++ b/Remote/Helper/Encryptable.hs @@ -193,9 +193,9 @@ encryptionSetup c gc = do Left _ -> True encsetup a = use "encryption setup" . a =<< highRandomQuality use m a = do - showNote m + showNote (UnquotedString m) cipher <- liftIO a - showNote (describeCipher cipher) + showNote (UnquotedString (describeCipher cipher)) return (storeCipher cipher c', EncryptionIsSetup) highRandomQuality = ifM (Annex.getRead Annex.fast) ( return False diff --git a/Remote/Helper/Messages.hs b/Remote/Helper/Messages.hs index 7cbfb9ec4c..0ef25a7132 100644 --- a/Remote/Helper/Messages.hs +++ b/Remote/Helper/Messages.hs @@ -29,4 +29,4 @@ cantCheck :: Describable a => a -> e cantCheck v = giveup $ "unable to check " ++ describe v showLocking :: Describable a => a -> Annex () -showLocking v = showAction $ "locking " ++ describe v +showLocking v = showAction $ UnquotedString $ "locking " ++ describe v diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs index 05aa53452e..7a7da481bc 100644 --- a/Remote/Helper/Ssh.hs +++ b/Remote/Helper/Ssh.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Remote.Helper.Ssh where import Annex.Common diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs index 8b14c0b25c..c256fe6784 100644 --- a/Remote/Rsync.hs +++ b/Remote/Rsync.hs @@ -5,7 +5,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, OverloadedStrings #-} module Remote.Rsync ( remote, diff --git a/Remote/S3.hs b/Remote/S3.hs index a2b09165a1..4ed18149cd 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -774,7 +774,7 @@ genBucket c gc u = do case r of Right True -> noop _ -> do - showAction $ "creating bucket in " ++ datacenter + showAction $ UnquotedString $ "creating bucket in " ++ datacenter void $ liftIO $ runResourceT $ sendS3Handle h $ (S3.putBucket (bucket info)) { S3.pbCannedAcl = acl info diff --git a/Types/ActionItem.hs b/Types/ActionItem.hs index d4e3c19b19..deca2ad137 100644 --- a/Types/ActionItem.hs +++ b/Types/ActionItem.hs @@ -9,24 +9,22 @@ module Types.ActionItem ( module Types.ActionItem, - Git.Filename.StringContainingQuotedPath(..), + StringContainingQuotedPath(..), ) where import Key import Types.Transfer import Git.FilePath -import qualified Git.Filename +import Git.Filename (StringContainingQuotedPath(..)) import Utility.FileSystemEncoding -import qualified Data.ByteString as S - data ActionItem = ActionItemAssociatedFile AssociatedFile Key | ActionItemKey Key | ActionItemBranchFilePath BranchFilePath Key | ActionItemFailedTransfer Transfer TransferInfo | ActionItemTreeFile RawFilePath - | ActionItemOther (Maybe Git.Filename.StringContainingQuotedPath) + | ActionItemOther (Maybe StringContainingQuotedPath) -- Use to avoid more than one thread concurrently processing the -- same Key. | OnlyActionOn Key ActionItem @@ -59,19 +57,21 @@ instance MkActionItem (BranchFilePath, Key) where instance MkActionItem (Transfer, TransferInfo) where mkActionItem = uncurry ActionItemFailedTransfer -actionItemDesc :: Git.Filename.QuotePath -> ActionItem -> S.ByteString -actionItemDesc qp (ActionItemAssociatedFile (AssociatedFile (Just f)) _) = - Git.Filename.quote qp f -actionItemDesc _ (ActionItemAssociatedFile (AssociatedFile Nothing) k) = - serializeKey' k -actionItemDesc _ (ActionItemKey k) = serializeKey' k -actionItemDesc qp (ActionItemBranchFilePath bfp _) = descBranchFilePath qp bfp -actionItemDesc qp (ActionItemFailedTransfer t i) = actionItemDesc qp $ +actionItemDesc :: ActionItem -> StringContainingQuotedPath +actionItemDesc (ActionItemAssociatedFile (AssociatedFile (Just f)) _) = + QuotedPath f +actionItemDesc (ActionItemAssociatedFile (AssociatedFile Nothing) k) = + UnquotedByteString (serializeKey' k) +actionItemDesc (ActionItemKey k) = + UnquotedByteString (serializeKey' k) +actionItemDesc (ActionItemBranchFilePath bfp _) = + descBranchFilePath bfp +actionItemDesc (ActionItemFailedTransfer t i) = actionItemDesc $ ActionItemAssociatedFile (associatedFile i) (transferKey t) -actionItemDesc qp (ActionItemTreeFile f) = Git.Filename.quote qp f -actionItemDesc _ (ActionItemOther Nothing) = mempty -actionItemDesc qp (ActionItemOther (Just v)) = Git.Filename.quote qp v -actionItemDesc qp (OnlyActionOn _ ai) = actionItemDesc qp ai +actionItemDesc (ActionItemTreeFile f) = QuotedPath f +actionItemDesc (ActionItemOther Nothing) = mempty +actionItemDesc (ActionItemOther (Just v)) = v +actionItemDesc (OnlyActionOn _ ai) = actionItemDesc ai actionItemKey :: ActionItem -> Maybe Key actionItemKey (ActionItemAssociatedFile _ k) = Just k diff --git a/Upgrade/V0.hs b/Upgrade/V0.hs index 27dfab4c7f..7880b481e7 100644 --- a/Upgrade/V0.hs +++ b/Upgrade/V0.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Upgrade.V0 where import Annex.Common diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index b0a4304d49..0c5666c2ae 100644 --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Upgrade.V1 where import System.Posix.Types diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs index 13bd191cb2..f467fa2596 100644 --- a/Upgrade/V2.hs +++ b/Upgrade/V2.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Upgrade.V2 where import Annex.Common @@ -120,7 +122,7 @@ push = do -- no origin exists, so just let the user -- know about the new branch void Annex.Branch.update - showLongNote $ + showLongNote $ UnquotedString $ "git-annex branch created\n" ++ "Be sure to push this branch when pushing to remotes.\n" diff --git a/Upgrade/V6.hs b/Upgrade/V6.hs index 54a559ad85..1dce107905 100644 --- a/Upgrade/V6.hs +++ b/Upgrade/V6.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Upgrade.V6 where import Annex.Common diff --git a/Upgrade/V8.hs b/Upgrade/V8.hs index 57f4951dbb..ec462bebd8 100644 --- a/Upgrade/V8.hs +++ b/Upgrade/V8.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Upgrade.V8 where import Annex.Common diff --git a/Upgrade/V9.hs b/Upgrade/V9.hs index bb45228caf..700f1f6387 100644 --- a/Upgrade/V9.hs +++ b/Upgrade/V9.hs @@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} + module Upgrade.V9 where import Annex.Common diff --git a/doc/todo/terminal_escapes_in_filenames.mdwn b/doc/todo/terminal_escapes_in_filenames.mdwn index 2a46cb1891..422da7713b 100644 --- a/doc/todo/terminal_escapes_in_filenames.mdwn +++ b/doc/todo/terminal_escapes_in_filenames.mdwn @@ -33,10 +33,13 @@ behave more like git. > (by default it does), so once this gets implemented, some users may want > to set that config to false. --[[Joey]] -> Update: Most git-annex commands now quote filenames, due to work on -> ActionItem display. `git-annex find`, `git-annex info $file`, -> and everywhere filenames get -> embedded in info messages still need to be done. +> Update: Messages now handles quoting of filenames, and also filtering +> out any escape sequences in other things that get displayed (like Keys..) +> +> Still need to deal with `git-annex find` and `git-annex info $file` +> and anything else that outputs without using Messages. +> (Eg need to do `git-annex metadata`, `git-annex config --get` and `git-annex schedule` and `git-annex wanted` +> and `git-annex required` and `git-annex group`) ---- @@ -46,14 +49,6 @@ extension of a SHA-E key. So commands like `git-annex lookupkey` and `git-annex find` that output keys might need to handle that, when outputting to a terminal? -Also: -`git-annex metadata` could also contain an escape sequence. So could -`git-annex config --get` and `git-annex schedule` and `git-annex wanted` -and `git-annex required` and `git-annex group`. And so could the -description of a repository. It seems that git-annex could just filter out -control characters from all of these, since they are not filenames, and -any control characters in them are surely malicious. - Also: git-annex initremote with autoenable may be able to cause a remote with a malicious name to be set up?