addGitConfigOverride :: String -> Annex ()
addGitConfigOverride v = do
adjustGitRepo $ \r ->
- Git.Config.store (encodeBS' v) Git.Config.ConfigList $
+ Git.Config.store (encodeBS v) Git.Config.ConfigList $
r { Git.gitGlobalOpts = go (Git.gitGlobalOpts r) }
changeState $ \st -> st { gitconfigoverride = v : gitconfigoverride st }
where
- only changes to add the date fields. -}
dateMetaData :: UTCTime -> MetaData -> MetaData
dateMetaData mtime old = modMeta old $
- (SetMeta yearMetaField $ S.singleton $ toMetaValue $ encodeBS' $ show y)
+ (SetMeta yearMetaField $ S.singleton $ toMetaValue $ encodeBS $ show y)
`ComposeModMeta`
- (SetMeta monthMetaField $ S.singleton $ toMetaValue $ encodeBS' $ show m)
+ (SetMeta monthMetaField $ S.singleton $ toMetaValue $ encodeBS $ show m)
`ComposeModMeta`
- (SetMeta dayMetaField $ S.singleton $ toMetaValue $ encodeBS' $ show d)
+ (SetMeta dayMetaField $ S.singleton $ toMetaValue $ encodeBS $ show d)
where
(y, m, d) = toGregorian $ utctDay mtime
{- Only sets the configkey in the Repo; does not change .git/config -}
setUUID :: Git.Repo -> UUID -> IO Git.Repo
setUUID r u = do
- let s = encodeBS' $ show configkeyUUID ++ "=" ++ fromUUID u
+ let s = encodeBS $ show configkeyUUID ++ "=" ++ fromUUID u
Git.Config.store s Git.Config.ConfigList r
-- Dummy uuid for the whole web. Do not alter.
n = '/' : Git.fromRef Annex.Branch.name
fileToBranch :: FilePath -> Git.Ref
-fileToBranch f = Git.Ref $ encodeBS' $ "refs" </> base
+fileToBranch f = Git.Ref $ encodeBS $ "refs" </> base
where
base = Prelude.last $ split "/refs/" f
addLink file link mk = do
debug ["add symlink", file]
liftAnnex $ do
- v <- catObjectDetails $ Ref $ encodeBS' $ ':':file
+ v <- catObjectDetails $ Ref $ encodeBS $ ':':file
case v of
Just (currlink, sha, _type)
| L.fromStrict link == currlink ->
- there's not. Special remotes don't normally
- have that, and don't use it. Temporarily add
- it if it's missing. -}
- let remotefetch = Git.ConfigKey $ encodeBS' $
+ let remotefetch = Git.ConfigKey $ encodeBS $
"remote." ++ T.unpack (repoName oldc) ++ ".fetch"
needfetch <- isNothing <$> fromRepo (Git.Config.getMaybe remotefetch)
when needfetch $
warning msg
externalBackendProgram :: ExternalBackendName -> String
-externalBackendProgram (ExternalBackendName bname) = "git-annex-backend-X" ++ decodeBS' bname
+externalBackendProgram (ExternalBackendName bname) = "git-annex-backend-X" ++ decodeBS bname
-- Runs an action with an ExternalState, starting a new external backend
-- process if necessary. It is returned to the pool once the action
genKeyName :: String -> S.ByteString
genKeyName s
-- Avoid making keys longer than the length of a SHA256 checksum.
- | bytelen > sha256len = encodeBS' $
+ | bytelen > sha256len = encodeBS $
truncateFilePath (sha256len - md5len - 1) s' ++ "-" ++
show (md5 bl)
- | otherwise = encodeBS' s'
+ | otherwise = encodeBS s'
where
s' = preSanitizeKeyName s
bl = encodeBL s
-- Also set in git config so it will be passed on to any
-- git-annex child processes.
, setAnnexState $ Annex.addGitConfigOverride $
- decodeBS' $ debugconfig <> "=" <> boolConfig' v
+ decodeBS $ debugconfig <> "=" <> boolConfig' v
]
setdebugfilter v = mconcat
-- Also set in git config so it will be passed on to any
-- git-annex child processes.
, setAnnexState $ Annex.addGitConfigOverride $
- decodeBS' (debugfilterconfig <> "=") ++ v
+ decodeBS (debugfilterconfig <> "=") ++ v
]
(ConfigKey debugconfig) = annexConfig "debug"
seek :: Action -> CommandSeek
seek (SetConfig ck@(ConfigKey name) val) = checkIsGlobalConfig ck $ commandAction $
- startingUsualMessages (decodeBS' name) ai si $ do
+ startingUsualMessages (decodeBS name) ai si $ do
setGlobalConfig ck val
when (needLocalUpdate ck) $
setConfig ck (fromConfigValue val)
next $ return True
where
ai = ActionItemOther (Just (fromConfigValue val))
- si = SeekInput [decodeBS' name]
+ si = SeekInput [decodeBS name]
seek (UnsetConfig ck@(ConfigKey name)) = checkIsGlobalConfig ck $ commandAction $
- startingUsualMessages (decodeBS' name) ai si $ do
+ startingUsualMessages (decodeBS name) ai si $ do
unsetGlobalConfig ck
when (needLocalUpdate ck) $
unsetConfig ck
next $ return True
where
ai = ActionItemOther (Just "unset")
- si = SeekInput [decodeBS' name]
+ si = SeekInput [decodeBS name]
seek (GetConfig ck) = checkIsGlobalConfig ck $ commandAction $
startingCustomOutput ai $ do
getGlobalConfig ck >>= \case
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 (encodeBS' (getmode r)) of
+ check getfile getmode setfile r = case readTreeItemType (encodeBS (getmode r)) of
Just TreeSymlink -> do
v <- getAnnexLinkTarget' f False
maybe (return r) repoint (parseLinkTargetOrPointer =<< v)
where
o' = o
{ Find.keyOptions = Just $ WantBranchKeys $
- map (Git.Ref . encodeBS') (Find.findThese o)
+ map (Git.Ref . encodeBS) (Find.findThese o)
, Find.findThese = []
}
fix InfoMissing
warning $
"** Based on the location log, " ++
- decodeBS' (actionItemDesc ai) ++
+ decodeBS (actionItemDesc ai) ++
"\n** was expected to be present, " ++
"but its content is missing."
return False
missingrequired <- Remote.prettyPrintUUIDs "missingrequired" missinglocs
warning $
"** Required content " ++
- decodeBS' (actionItemDesc ai) ++
+ decodeBS (actionItemDesc ai) ++
" is missing from these repositories:\n" ++
missingrequired
return False
badsize a b = do
msg <- bad key
warning $ concat
- [ decodeBS' (actionItemDesc ai)
+ [ decodeBS (actionItemDesc ai)
, ": Bad file size ("
, compareSizes storageUnits True a b
, "); "
case Types.Backend.canUpgradeKey backend of
Just a | a key -> do
warning $ concat
- [ decodeBS' (actionItemDesc ai)
+ [ decodeBS (actionItemDesc ai)
, ": Can be upgraded to an improved key format. "
, "You can do so by running: git annex migrate --backend="
, decodeBS (formatKeyVariety (fromKey keyVariety key)) ++ " "
- , decodeBS' file
+ , decodeBS file
]
return True
_ -> return True
unless ok $ do
msg <- bad key
warning $ concat
- [ decodeBS' (actionItemDesc ai)
+ [ decodeBS (actionItemDesc ai)
, ": Bad file content; "
, msg
]
Nothing -> noop
Just ic' -> whenM (compareInodeCaches ic ic') $ do
warning $ concat
- [ decodeBS' (actionItemDesc ai)
+ [ decodeBS (actionItemDesc ai)
, ": Stale or missing inode cache; updating."
]
Database.Keys.addInodeCaches key [ic]
[bs] ->
let (branch, subdir) = separate (== ':') bs
in RemoteImportOptions r
- (Ref (encodeBS' branch))
+ (Ref (encodeBS branch))
(if null subdir then Nothing else Just subdir)
content
ic
noInfo :: String -> SeekInput -> Annex ()
noInfo s si = do
- showStart "info" (encodeBS' s) si
+ showStart "info" (encodeBS s) si
showNote $ "not a directory or an annexed file or a treeish or a remote or a uuid"
showEndFail
treeishInfo :: InfoOptions -> String -> SeekInput -> Annex ()
treeishInfo o t si = do
- mi <- getTreeStatInfo o (Git.Ref (encodeBS' t))
+ mi <- getTreeStatInfo o (Git.Ref (encodeBS t))
case mi of
Nothing -> noInfo t si
Just i -> showCustom (unwords ["info", t]) si $ do
showStat s = maybe noop calc =<< s
where
calc (desc, a) = do
- (lift . showHeader . encodeBS') desc
- lift . showRaw . encodeBS' =<< a
+ (lift . showHeader . encodeBS) desc
+ lift . showRaw . encodeBS =<< a
repo_list :: TrustLevel -> Stat
repo_list level = stat n $ nojson $ lift $ do
[ Param $ Git.fromRef Annex.Branch.fullname
, Param "--"
] ++ map Param fs
- return (parseGitRawLog config (map decodeBL' ls), cleanup)
+ return (parseGitRawLog config (map decodeBL ls), cleanup)
-- Parses chunked git log --raw output, which looks something like:
--
| otherwise = do
prepMerge
forM_ (mergeBranches o) $
- commandAction . mergeBranch o . Git.Ref . encodeBS'
+ commandAction . mergeBranch o . Git.Ref . encodeBS
mergeAnnexBranch :: CommandStart
mergeAnnexBranch = starting "merge" ai si $ do
whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath currdir)) $
giveup "can only run uninit from the top of the git repository"
where
- current_branch = Git.Ref . encodeBS' . Prelude.head . lines . decodeBS' <$> revhead
+ current_branch = Git.Ref . encodeBS . Prelude.head . lines . decodeBS <$> revhead
revhead = inRepo $ Git.Command.pipeReadStrict
[Param "rev-parse", Param "--abbrev-ref", Param "HEAD"]
let m = M.insert u l (cfgScheduleMap cfg)
in Right $ cfg { cfgScheduleMap = m }
| setting == "config" =
- let m = M.insert (ConfigKey (encodeBS' f)) (ConfigValue (encodeBS' 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)"
setConfig (ConfigKey key) value = do
inRepo $ Git.Command.run
[ Param "config"
- , Param (decodeBS' key)
+ , Param (decodeBS key)
, Param value
]
reloadConfig
deriving (Eq, Show)
toSSha :: Sha -> SSha
-toSSha (Ref s) = SSha (decodeBS' s)
+toSSha (Ref s) = SSha (decodeBS s)
fromSSha :: SSha -> Ref
-fromSSha (SSha s) = Ref (encodeBS' s)
+fromSSha (SSha s) = Ref (encodeBS s)
instance PersistField SSha where
toPersistValue (SSha b) = toPersistValue b
{- Checks if a string from git config is a true/false value. -}
isTrueFalse :: String -> Maybe Bool
-isTrueFalse = isTrueFalse' . ConfigValue . encodeBS'
+isTrueFalse = isTrueFalse' . ConfigValue . encodeBS
isTrueFalse' :: ConfigValue -> Maybe Bool
isTrueFalse' (ConfigValue s)
[ Param "config"
, Param "--file"
, File f
- , Param (decodeBS' k)
- , Param (decodeBS' v)
+ , Param (decodeBS k)
+ , Param (decodeBS v)
]
{- Unsets a git config setting, in both the git repo,
, return Nothing
)
where
- ps = [Param "config", Param "--unset-all", Param (decodeBS' k)]
+ ps = [Param "config", Param "--unset-all", Param (decodeBS k)]
"all" -> AllShared
"world" -> AllShared
"everybody" -> AllShared
- _ -> maybe UnShared UmaskShared (readish (decodeBS' v))
+ _ -> maybe UnShared UmaskShared (readish (decodeBS v))
Just NoConfigValue -> UnShared
Nothing -> UnShared
go (info:f:rest) = case A.parse (parserDiffRaw (L.toStrict f)) info of
A.Done _ r -> r : go rest
A.Fail _ _ err -> error $ "diff-tree parse error: " ++ err
- go (s:[]) = error $ "diff-tree parse error near \"" ++ decodeBL' s ++ "\""
+ go (s:[]) = error $ "diff-tree parse error near \"" ++ decodeBL s ++ "\""
-- :<srcmode> SP <dstmode> SP <srcsha> SP <dstsha> SP <status>
--
] r
findShas :: [String] -> [Sha]
-findShas = catMaybes . map (extractSha . encodeBS')
+findShas = catMaybes . map (extractSha . encodeBS)
. concat . map words . filter wanted
where
wanted l = not ("dangling " `isPrefixOf` l)
where
defaultkey = "gcrypt.participants"
parse (Just (ConfigValue "simple")) = []
- parse (Just (ConfigValue b)) = words (decodeBS' b)
+ parse (Just (ConfigValue b)) = words (decodeBS b)
parse (Just NoConfigValue) = []
parse Nothing = []
remoteConfigKey :: S.ByteString -> RemoteName -> ConfigKey
remoteConfigKey key remotename = ConfigKey $
- "remote." <> encodeBS' remotename <> "." <> key
+ "remote." <> encodeBS remotename <> "." <> key
unmerged :: [RawFilePath] -> Repo -> IO ([Unmerged], IO Bool)
unmerged l repo = guardSafeForLsFiles repo $ do
(fs, cleanup) <- pipeNullSplit params repo
- return (reduceUnmerged [] $ catMaybes $ map (parseUnmerged . decodeBL') fs, cleanup)
+ return (reduceUnmerged [] $ catMaybes $ map (parseUnmerged . decodeBL) fs, cleanup)
where
params =
Param "ls-files" :
then Nothing
else do
treeitemtype <- readTreeItemType (encodeBS rawtreeitemtype)
- sha <- extractSha (encodeBS' rawsha)
+ sha <- extractSha (encodeBS rawsha)
return $ InternalUnmerged (stage == 2) (toRawFilePath file)
(Just treeitemtype) (Just sha)
_ -> Nothing
- generated, so any size information is not included. -}
formatLsTree :: TreeItem -> S.ByteString
formatLsTree ti = S.intercalate (S.singleton (fromIntegral (ord ' ')))
- [ encodeBS' (showOct (mode ti) "")
+ [ encodeBS (showOct (mode ti) "")
, typeobj ti
, fromRef' (sha ti)
] <> (S.cons (fromIntegral (ord '\t')) (getTopFilePath (file ti)))
{- Converts a Ref to refer to the content of the Ref on a given date. -}
dateRef :: Ref -> RefDate -> Ref
-dateRef r (RefDate d) = Ref $ fromRef' r <> "@" <> encodeBS' d
+dateRef r (RefDate d) = Ref $ fromRef' r <> "@" <> encodeBS d
{- A Ref that can be used to refer to a file in the repository as it
- appears in a given Ref. -}
[ Param "rev-parse"
, Param "--verify"
, Param "--quiet"
- , Param (decodeBS' ref')
+ , Param (decodeBS ref')
]
where
ref' = if ":" `S.isInfixOf` ref
remoteKeyToRemoteName (ConfigKey k)
| "remote." `S.isPrefixOf` k =
let n = S.intercalate "." $ dropFromEnd 1 $ drop 1 $ S8.split '.' k
- in if S.null n then Nothing else Just (decodeBS' n)
+ in if S.null n then Nothing else Just (decodeBS n)
| otherwise = Nothing
{- Construct a legal git remote name out of an arbitrary input string.
| null insteadofs = l
| otherwise = replacement ++ drop (S.length bestvalue) l
where
- replacement = decodeBS' $ S.drop (S.length prefix) $
+ replacement = decodeBS $ S.drop (S.length prefix) $
S.take (S.length bestkey - S.length suffix) bestkey
(bestkey, bestvalue) =
case maximumBy longestvalue insteadofs of
getAllRefs' :: FilePath -> IO [Ref]
getAllRefs' refdir = do
let topsegs = length (splitPath refdir) - 1
- let toref = Ref . encodeBS' . joinPath . drop topsegs . splitPath
+ let toref = Ref . encodeBS . joinPath . drop topsegs . splitPath
map toref <$> dirContentsRecursive refdir
explodePackedRefsFile :: Repo -> IO ()
parsePacked :: String -> Maybe (Sha, Ref)
parsePacked l = case words l of
(sha:ref:[])
- | isJust (extractSha (encodeBS' sha)) && Ref.legal True ref ->
- Just (Ref (encodeBS' sha), Ref (encodeBS' ref))
+ | isJust (extractSha (encodeBS sha)) && Ref.legal True ref ->
+ Just (Ref (encodeBS sha), Ref (encodeBS ref))
_ -> Nothing
{- git-branch -d cannot be used to remove a branch that is directly
where
parse l = case words l of
(commitsha:treesha:[]) -> (,)
- <$> extractSha (encodeBS' commitsha)
- <*> extractSha (encodeBS' treesha)
+ <$> extractSha (encodeBS commitsha)
+ <*> extractSha (encodeBS treesha)
_ -> Nothing
check [] = return True
check ((c, t):rest)
where
headfile = localGitDir g P.</> "HEAD"
validhead s = "ref: refs/" `isPrefixOf` s
- || isJust (extractSha (encodeBS' s))
+ || isJust (extractSha (encodeBS s))
{- Put it all together. -}
runRepair :: (Ref -> Bool) -> Bool -> Repo -> IO (Bool, [Branch])
def = ConfigValue mempty
fromConfigKey :: ConfigKey -> String
-fromConfigKey (ConfigKey s) = decodeBS' s
+fromConfigKey (ConfigKey s) = decodeBS s
instance Show ConfigKey where
show = fromConfigKey
fromConfigValue NoConfigValue = mempty
instance FromConfigValue String where
- fromConfigValue = decodeBS' . fromConfigValue
+ fromConfigValue = decodeBS . fromConfigValue
instance Show ConfigValue where
show = fromConfigValue
instance IsString ConfigKey where
- fromString = ConfigKey . encodeBS'
+ fromString = ConfigKey . encodeBS
instance IsString ConfigValue where
- fromString = ConfigValue . encodeBS'
+ fromString = ConfigValue . encodeBS
type RemoteName = String
deriving (Eq, Ord, Read, Show)
fromRef :: Ref -> String
-fromRef = decodeBS' . fromRef'
+fromRef = decodeBS . fromRef'
fromRef' :: Ref -> S.ByteString
fromRef' (Ref s) = s
mapM_ streamer s
void $ cleanup
where
- params = map Param ["ls-tree", "-z", "-r", "--full-tree", decodeBS' x]
+ params = map Param ["ls-tree", "-z", "-r", "--full-tree", decodeBS x]
lsSubTree :: Ref -> FilePath -> Repo -> Streamer
lsSubTree (Ref x) p repo streamer = do
(s, cleanup) <- pipeNullSplit params repo
mapM_ streamer s
void $ cleanup
where
- params = map Param ["ls-tree", "-z", "-r", "--full-tree", decodeBS' x, p]
+ params = map Param ["ls-tree", "-z", "-r", "--full-tree", decodeBS x, p]
{- Generates a line suitable to be fed into update-index, to add
- a given file with a given sha. -}
isChunkKey k = isJust (fromKey keyChunkSize k) && isJust (fromKey keyChunkNum k)
serializeKey :: Key -> String
-serializeKey = decodeBS' . serializeKey'
+serializeKey = decodeBS . serializeKey'
serializeKey' :: Key -> S.ByteString
serializeKey' = keySerialization
deserializeKey :: String -> Maybe Key
-deserializeKey = deserializeKey' . encodeBS'
+deserializeKey = deserializeKey' . encodeBS
deserializeKey' :: S.ByteString -> Maybe Key
deserializeKey' = eitherToMaybe . A.parseOnly keyParser
deserialize ("truncated":ls) = deserialize' ls True
deserialize ls = deserialize' ls False
deserialize' ls t =
- let s = S.fromList $ map (Ref . encodeBS') ls
+ let s = S.fromList $ map (Ref . encodeBS) ls
in if S.null s then FsckFailed else FsckFoundMissing s t
clearFsckResults :: UUID -> Annex ()
describeTransfer t info = unwords
[ show $ transferDirection t
, show $ transferUUID t
- , decodeBS' $ actionItemDesc $ ActionItemAssociatedFile
+ , decodeBS $ actionItemDesc $ ActionItemAssociatedFile
(associatedFile info)
(transferKey t)
, show $ bytesComplete info
| B.null name = Git.Ref branchViewPrefix
| otherwise = Git.Ref $ branchViewPrefix <> "/" <> name
where
- name = encodeBS' $
+ name = encodeBS $
intercalate ";" $ map branchcomp (viewComponents view)
branchcomp c
| viewVisible c = branchcomp' c
showStart :: String -> RawFilePath -> SeekInput -> Annex ()
showStart command file si = outputMessage json $
- encodeBS' command <> " " <> file <> " "
+ encodeBS command <> " " <> file <> " "
where
json = JSON.start command (Just file) Nothing si
showStartKey :: String -> Key -> ActionItem -> SeekInput -> Annex ()
showStartKey command key ai si = outputMessage json $
- encodeBS' command <> " " <> actionItemDesc ai <> " "
+ encodeBS command <> " " <> actionItemDesc ai <> " "
where
json = JSON.start command (actionItemFile ai) (Just key) si
showStartOther :: String -> Maybe String -> SeekInput -> Annex ()
-showStartOther command mdesc si = outputMessage json $ encodeBS' $
+showStartOther command mdesc si = outputMessage json $ encodeBS $
command ++ (maybe "" (" " ++) mdesc) ++ " "
where
json = JSON.start command Nothing Nothing si
showEndMessage (CustomOutput _) = const noop
showNote :: String -> Annex ()
-showNote s = outputMessage (JSON.note s) $ encodeBS' $ "(" ++ s ++ ") "
+showNote s = outputMessage (JSON.note s) $ encodeBS $ "(" ++ s ++ ") "
showAction :: String -> Annex ()
showAction s = showNote $ s ++ "..."
Annex.changeState $ \s -> s { Annex.output = st' }
| sideActionBlock st == InBlock = return ()
| otherwise = go'
- go' = outputMessage JSON.none $ encodeBS' $ "(" ++ m ++ "...)\n"
+ go' = outputMessage JSON.none $ encodeBS $ "(" ++ m ++ "...)\n"
showStoringStateAction :: Annex ()
showStoringStateAction = showSideAction "recording state in git"
outputMessage JSON.none "\n"
showLongNote :: String -> Annex ()
-showLongNote s = outputMessage (JSON.note s) (encodeBS' (formatLongNote s))
+showLongNote s = outputMessage (JSON.note s) (encodeBS (formatLongNote s))
formatLongNote :: String -> String
formatLongNote s = '\n' : indent s ++ "\n"
-- to console, but json object containing the info is emitted immediately.
showInfo :: String -> Annex ()
showInfo s = outputMessage' outputJSON (JSON.info s) $
- encodeBS' (formatLongNote s)
+ encodeBS (formatLongNote s)
showEndOk :: Annex ()
showEndOk = showEndResult True
instance Proto.Serializable ProtoAssociatedFile where
serialize (ProtoAssociatedFile (AssociatedFile Nothing)) = ""
serialize (ProtoAssociatedFile (AssociatedFile (Just af))) =
- decodeBS' $ toInternalGitPath $ encodeBS' $ concatMap esc $ fromRawFilePath af
+ decodeBS $ toInternalGitPath $ encodeBS $ concatMap esc $ fromRawFilePath af
where
esc '%' = "%%"
esc c
{- Finds the remote or remote group matching the name. -}
byNameOrGroup :: RemoteName -> Annex [Remote]
-byNameOrGroup n = go =<< getConfigMaybe (ConfigKey ("remotes." <> encodeBS' n))
+byNameOrGroup n = go =<< getConfigMaybe (ConfigKey ("remotes." <> encodeBS n))
where
go (Just l) = catMaybes
<$> mapM (byName . Just) (splitc ' ' (fromConfigValue l))
mk ('S':'T':'\t':l) =
let (stat, fn) = separate (== '\t') l
sz = fromMaybe 0 (readish (takeWhile (/= ' ') stat))
- cid = ContentIdentifier (encodeBS' stat)
+ cid = ContentIdentifier (encodeBS stat)
loc = mkImportLocation $ toRawFilePath $
Posix.makeRelative (fromAndroidPath adir) fn
in Just (loc, (cid, sz))
return $ case ls of
Just ["n"] -> Right Nothing
Just (('S':'T':'\t':stat):[]) -> Right $ Just $
- ContentIdentifier (encodeBS' stat)
+ ContentIdentifier (encodeBS stat)
_ -> Left (ExitFailure 1)
where
aloc = fromAndroidPath $ androidExportLocation adir loc
borgLocal (BorgRepo r) = notElem ':' r
borgArchive :: BorgRepo -> BorgArchiveName -> String
-borgArchive (BorgRepo r) n = r ++ "::" ++ decodeBS' n
+borgArchive (BorgRepo r) n = r ++ "::" ++ decodeBS n
absBorgRepo :: BorgRepo -> IO BorgRepo
absBorgRepo r@(BorgRepo p)
, Param tmpconfig
]
liftIO $ do
- void $ Git.Config.changeFile tmpconfig coreGCryptId (encodeBS' gcryptid)
+ void $ Git.Config.changeFile tmpconfig coreGCryptId (encodeBS gcryptid)
void $ Git.Config.changeFile tmpconfig denyNonFastForwards (Git.Config.boolConfig' False)
ok <- liftIO $ rsync $ opts ++
[ Param "--recursive"
set k v r' = do
let k' = remoteAnnexConfig r' k
setConfig k' v
- return $ Git.Config.store' k' (Git.ConfigValue (encodeBS' v)) r'
+ return $ Git.Config.store' k' (Git.ConfigValue (encodeBS v)) r'
data LFSHandle = LFSHandle
{ downloadEndpoint :: Maybe LFS.Endpoint
(pure Git.Construct.fromUnknown)
match (ConfigKey k) _ =
"remote." `S.isPrefixOf` k
- && (".annex-" <> encodeBS' s) `S.isSuffixOf` k
+ && (".annex-" <> encodeBS s) `S.isSuffixOf` k
{- Sets up configuration for a special remote in .git/config. -}
gitConfigSpecialRemote :: UUID -> RemoteConfig -> [(String, String)] -> Annex ()
gitConfigSpecialRemote u c cfgs = do
forM_ cfgs $ \(k, v) ->
- setConfig (remoteAnnexConfig c (encodeBS' k)) v
+ setConfig (remoteAnnexConfig c (encodeBS k)) v
storeUUIDIn (remoteAnnexConfig c "uuid") u
-- RetrievalVerifiableKeysSecure unless overridden by git config.
else return $ Just fallback
else return $ Just command
where
- hook = annexConfig $ encodeBS' $ hookname ++ "-" ++ action ++ "-hook"
- hookfallback = annexConfig $ encodeBS' $ hookname ++ "-hook"
+ hook = annexConfig $ encodeBS $ hookname ++ "-" ++ action ++ "-hook"
+ hookfallback = annexConfig $ encodeBS $ hookname ++ "-hook"
runHook :: HookName -> Action -> Key -> Maybe FilePath -> Annex ()
runHook hook action k f = lookupHook hook action >>= \case
with_ssh_origin :: (Assertion -> Assertion) -> (Assertion -> Assertion)
with_ssh_origin cloner a = cloner $ do
- let k = Git.Types.ConfigKey (encodeBS' config)
+ let k = Git.Types.ConfigKey (encodeBS config)
let v = Git.Types.ConfigValue (toRawFilePath "/dev/null")
origindir <- absPath . Git.Types.fromConfigValue
=<< annexeval (Config.getConfig k v)
actionItemDesc (ActionItemFailedTransfer t i) = actionItemDesc $
ActionItemAssociatedFile (associatedFile i) (transferKey t)
actionItemDesc (ActionItemTreeFile f) = f
-actionItemDesc (ActionItemOther s) = encodeBS' (fromMaybe "" s)
+actionItemDesc (ActionItemOther s) = encodeBS (fromMaybe "" s)
actionItemDesc (OnlyActionOn _ ai) = actionItemDesc ai
actionItemKey :: ActionItem -> Maybe Key
{- A per-remote setting in git config. -}
remoteConfig :: RemoteNameable r => r -> UnqualifiedConfigKey -> ConfigKey
remoteConfig r key = ConfigKey $
- "remote." <> encodeBS' (getRemoteName r) <> "." <> key
+ "remote." <> encodeBS (getRemoteName r) <> "." <> key
| otherwise = UUID b
instance FromUUID String where
- fromUUID s = decodeBS' (fromUUID s)
+ fromUUID s = decodeBS (fromUUID s)
instance ToUUID String where
- toUUID s = toUUID (encodeBS' s)
+ toUUID s = toUUID (encodeBS s)
instance FromUUID ConfigValue where
fromUUID s = (ConfigValue (fromUUID s))
push :: Annex ()
push = do
origin_master <- inRepo $ Git.Ref.exists $
- Git.Ref $ encodeBS' "origin/master"
+ Git.Ref $ encodeBS "origin/master"
origin_gitannex <- Annex.Branch.hasOrigin
case (origin_master, origin_gitannex) of
(_, True) -> do
fromDirectBranch :: Ref -> Ref
fromDirectBranch directhead = case splitc '/' $ fromRef directhead of
("refs":"heads":"annex":"direct":rest) ->
- Ref $ encodeBS' $ "refs/heads/" ++ intercalate "/" rest
+ Ref $ encodeBS $ "refs/heads/" ++ intercalate "/" rest
_ -> directhead
switchHEADBack :: Annex ()
{- utilities for simple data types
-
- - Copyright 2013 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2021 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
module Utility.Data (
firstJust,
eitherToMaybe,
+ s2w8,
+ w82s,
) where
+import Data.Word
+
{- First item in the list that is not Nothing. -}
firstJust :: Eq a => [Maybe a] -> Maybe a
firstJust ms = case dropWhile (== Nothing) ms of
eitherToMaybe :: Either a b -> Maybe b
eitherToMaybe = either (const Nothing) Just
+
+c2w8 :: Char -> Word8
+c2w8 = fromIntegral . fromEnum
+
+w82c :: Word8 -> Char
+w82c = toEnum . fromIntegral
+
+s2w8 :: String -> [Word8]
+s2w8 = map c2w8
+
+w82s :: [Word8] -> String
+w82s = map w82c
deriving (Eq, Show)
instance IsString DebugSource where
- fromString = DebugSource . encodeBS'
+ fromString = DebugSource . encodeBS
-- | Selects whether to display a message from a source.
data DebugSelector
formatDebugMessage :: DebugSource -> String -> IO S.ByteString
formatDebugMessage (DebugSource src) msg = do
- t <- encodeBS' . formatTime defaultTimeLocale "[%F %X%Q]"
+ t <- encodeBS . formatTime defaultTimeLocale "[%F %X%Q]"
<$> getZonedTime
return (t <> " (" <> src <> ") " <> encodeBS msg)
{- GHC File system encoding handling.
-
- - Copyright 2012-2016 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2021 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
encodeBL,
decodeBS,
encodeBS,
- decodeBL',
- encodeBL',
- decodeBS',
- encodeBS',
truncateFilePath,
- s2w8,
- w82s,
- c2w8,
- w82c,
) where
import qualified GHC.Foreign as GHC
import qualified GHC.IO.Encoding as Encoding
-import Foreign.C
import System.IO
import System.IO.Unsafe
-import Data.Word
import System.FilePath.ByteString (RawFilePath, encodeFilePath, decodeFilePath)
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
+import Data.ByteString.Unsafe (unsafePackMallocCStringLen)
#ifdef mingw32_HOST_OS
import qualified Data.ByteString.UTF8 as S8
import qualified Data.ByteString.Lazy.UTF8 as L8
-#else
-import Data.List
-import Utility.Split
#endif
-import Utility.Exception
-
{- Makes all subsequent Handles that are opened, as well as stdio Handles,
- use the filesystem encoding, instead of the encoding of the current
- locale.
fileEncoding h = hSetEncoding h Encoding.utf8
#endif
-{- Encodes a FilePath into a String, applying the filesystem encoding.
- -
- - There are very few things it makes sense to do with such an encoded
- - string. It's not a legal filename; it should not be displayed.
- - So this function is not exported, but instead used by the few functions
- - that can usefully consume it.
- -
- - This use of unsafePerformIO is belived to be safe; GHC's interface
- - only allows doing this conversion with CStrings, and the CString buffer
- - is allocated, used, and deallocated within the call, with no side
- - effects.
- -
- - If the FilePath contains a value that is not legal in the filesystem
- - encoding, rather than thowing an exception, it will be returned as-is.
- -}
-{-# NOINLINE _encodeFilePath #-}
-_encodeFilePath :: FilePath -> String
-_encodeFilePath fp = unsafePerformIO $ do
- enc <- Encoding.getFileSystemEncoding
- GHC.withCString enc fp (GHC.peekCString Encoding.char8)
- `catchNonAsync` (\_ -> return fp)
-
{- Decodes a ByteString into a FilePath, applying the filesystem encoding. -}
decodeBL :: L.ByteString -> FilePath
#ifndef mingw32_HOST_OS
-decodeBL = encodeW8NUL . L.unpack
+decodeBL = decodeBS . L.toStrict
#else
{- On Windows, we assume that the ByteString is utf-8, since Windows
- only uses unicode for filenames. -}
{- Encodes a FilePath into a ByteString, applying the filesystem encoding. -}
encodeBL :: FilePath -> L.ByteString
#ifndef mingw32_HOST_OS
-encodeBL = L.pack . decodeW8NUL
+encodeBL = L.fromStrict . encodeBS
#else
encodeBL = L8.fromString
#endif
decodeBS :: S.ByteString -> FilePath
#ifndef mingw32_HOST_OS
-decodeBS = encodeW8NUL . S.unpack
+-- This is a copy of code from System.FilePath.Internal.decodeFilePath.
+-- However, older versions of that library truncated at NUL, which this
+-- must not do, because it may end up used on something other than a unix
+-- filepath.
+{-# NOINLINE decodeBS #-}
+decodeBS b = unsafePerformIO $ do
+ enc <- Encoding.getFileSystemEncoding
+ S.useAsCStringLen b (GHC.peekCStringLen enc)
#else
decodeBS = S8.toString
#endif
encodeBS :: FilePath -> S.ByteString
#ifndef mingw32_HOST_OS
-encodeBS = S.pack . decodeW8NUL
+-- This is a copy of code from System.FilePath.Internal.encodeFilePath.
+-- However, older versions of that library truncated at NUL, which this
+-- must not do, because it may end up used on something other than a unix
+-- filepath.
+{-# NOINLINE encodeBS #-}
+encodeBS f = unsafePerformIO $ do
+ enc <- Encoding.getFileSystemEncoding
+ GHC.newCStringLen enc f >>= unsafePackMallocCStringLen
#else
encodeBS = S8.fromString
#endif
-{- Faster version that assumes the string does not contain NUL;
- - if it does it will be truncated before the NUL. -}
-decodeBS' :: S.ByteString -> FilePath
-#ifndef mingw32_HOST_OS
-decodeBS' = encodeW8 . S.unpack
-#else
-decodeBS' = S8.toString
-#endif
-
-encodeBS' :: FilePath -> S.ByteString
-#ifndef mingw32_HOST_OS
-encodeBS' = S.pack . decodeW8
-#else
-encodeBS' = S8.fromString
-#endif
-
-decodeBL' :: L.ByteString -> FilePath
-#ifndef mingw32_HOST_OS
-decodeBL' = encodeW8 . L.unpack
-#else
-decodeBL' = L8.toString
-#endif
-
-encodeBL' :: FilePath -> L.ByteString
-#ifndef mingw32_HOST_OS
-encodeBL' = L.pack . decodeW8
-#else
-encodeBL' = L8.fromString
-#endif
-
fromRawFilePath :: RawFilePath -> FilePath
fromRawFilePath = decodeFilePath
toRawFilePath :: FilePath -> RawFilePath
toRawFilePath = encodeFilePath
-#ifndef mingw32_HOST_OS
-{- Converts a [Word8] to a FilePath, encoding using the filesystem encoding.
- -
- - w82s produces a String, which may contain Chars that are invalid
- - unicode. From there, this is really a simple matter of applying the
- - file system encoding, only complicated by GHC's interface to doing so.
- -
- - Note that the encoding stops at any NUL in the input. FilePaths
- - cannot contain embedded NUL, but Haskell Strings may.
- -}
-{-# NOINLINE encodeW8 #-}
-encodeW8 :: [Word8] -> FilePath
-encodeW8 w8 = unsafePerformIO $ do
- enc <- Encoding.getFileSystemEncoding
- GHC.withCString Encoding.char8 (w82s w8) $ GHC.peekCString enc
-
-decodeW8 :: FilePath -> [Word8]
-decodeW8 = s2w8 . _encodeFilePath
-
-{- Like encodeW8 and decodeW8, but NULs are passed through unchanged. -}
-encodeW8NUL :: [Word8] -> FilePath
-encodeW8NUL = intercalate [nul] . map encodeW8 . splitc (c2w8 nul)
- where
- nul = '\NUL'
-
-decodeW8NUL :: FilePath -> [Word8]
-decodeW8NUL = intercalate [c2w8 nul] . map decodeW8 . splitc nul
- where
- nul = '\NUL'
-#endif
-
-c2w8 :: Char -> Word8
-c2w8 = fromIntegral . fromEnum
-
-w82c :: Word8 -> Char
-w82c = toEnum . fromIntegral
-
-s2w8 :: String -> [Word8]
-s2w8 = map c2w8
-
-w82s :: [Word8] -> String
-w82s = map w82c
-
{- Truncates a FilePath to the given number of bytes (or less),
- as represented on disk.
-
truncateFilePath n = go . reverse
where
go f =
- let bytes = decodeW8 f
- in if length bytes <= n
+ let b = encodeBS f
+ in if S.length b <= n
then reverse f
else go (drop 1 f)
#else
projects / git-annex.git / commitdiff