Several nice speed wins I think.
At 340/633 files converted.
- Licensed under the GNU AGPL version 3 or higher.
-}
+{-# LANGUAGE OverloadedStrings #-}
+
module Annex.AdjustedBranch.Name (
originalToAdjusted,
adjustedToOriginal,
import Utility.Misc
import Control.Applicative
-import Data.List
+import Data.Char
+import qualified Data.ByteString as S
-adjustedBranchPrefix :: String
+adjustedBranchPrefix :: S.ByteString
adjustedBranchPrefix = "refs/heads/adjusted/"
class SerializeAdjustment t where
- serializeAdjustment :: t -> String
- deserializeAdjustment :: String -> Maybe t
+ serializeAdjustment :: t -> S.ByteString
+ deserializeAdjustment :: S.ByteString -> Maybe t
instance SerializeAdjustment Adjustment where
serializeAdjustment (LinkAdjustment l) =
serializeAdjustment (PresenceAdjustment p Nothing) =
serializeAdjustment p
serializeAdjustment (PresenceAdjustment p (Just l)) =
- serializeAdjustment p ++ "-" ++ serializeAdjustment l
+ serializeAdjustment p <> "-" <> serializeAdjustment l
deserializeAdjustment s =
(LinkAdjustment <$> deserializeAdjustment s)
<|>
<|>
(PresenceAdjustment <$> deserializeAdjustment s <*> pure Nothing)
where
- (s1, s2) = separate (== '-') s
+ (s1, s2) = separate' (== (fromIntegral (ord '-'))) s
instance SerializeAdjustment LinkAdjustment where
serializeAdjustment UnlockAdjustment = "unlocked"
originalToAdjusted :: OrigBranch -> Adjustment -> AdjBranch
originalToAdjusted orig adj = AdjBranch $ Ref $
- adjustedBranchPrefix ++ base ++ '(' : serializeAdjustment adj ++ ")"
+ adjustedBranchPrefix <> base <> "(" <> serializeAdjustment adj <> ")"
where
- base = fromRef (Git.Ref.base orig)
+ base = fromRef' (Git.Ref.base orig)
type OrigBranch = Branch
adjustedToOriginal :: Branch -> Maybe (Adjustment, OrigBranch)
adjustedToOriginal b
- | adjustedBranchPrefix `isPrefixOf` bs = do
- let (base, as) = separate (== '(') (drop prefixlen bs)
- adj <- deserializeAdjustment (takeWhile (/= ')') as)
+ | adjustedBranchPrefix `S.isPrefixOf` bs = do
+ let (base, as) = separate' (== openparen) (S.drop prefixlen bs)
+ adj <- deserializeAdjustment (S.takeWhile (/= closeparen) as)
Just (adj, Git.Ref.branchRef (Ref base))
| otherwise = Nothing
where
- bs = fromRef b
- prefixlen = length adjustedBranchPrefix
+ bs = fromRef' b
+ prefixlen = S.length adjustedBranchPrefix
+ openparen = fromIntegral (ord '(')
+ closeparen = fromIntegral (ord ')')
withIndex,
) where
+import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Char8 as B8
import qualified Data.Set as S
import qualified Data.Map as M
import Data.Function
getMergedRefs' :: Annex [(Git.Sha, Git.Branch)]
getMergedRefs' = do
f <- fromRepo gitAnnexMergedRefs
- s <- liftIO $ catchDefaultIO "" $ readFile f
- return $ map parse $ lines s
+ s <- liftIO $ catchDefaultIO mempty $ B.readFile f
+ return $ map parse $ B8.lines s
where
parse l =
- let (s, b) = separate (== '\t') l
+ let (s, b) = separate' (== (fromIntegral (ord '\t'))) l
in (Ref s, Ref b)
{- Grafts a treeish into the branch at the specified location,
{- Waiting for changed git refs
-
- - Copyright 2014-216 Joey Hess <id@joeyh.name>
+ - Copyright 2014-2016 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
import Control.Concurrent
import Control.Concurrent.STM
import Control.Concurrent.STM.TBMChan
+import qualified Data.ByteString as S
newtype ChangedRefs = ChangedRefs [Git.Ref]
deriving (Show)
instance Proto.Serializable ChangedRefs where
serialize (ChangedRefs l) = unwords $ map Git.fromRef l
- deserialize = Just . ChangedRefs . map Git.Ref . words
+ deserialize = Just . ChangedRefs . map (Git.Ref . encodeBS) . words
data ChangedRefsHandle = ChangedRefsHandle DirWatcherHandle (TBMChan Git.Sha)
| ".lock" `isSuffixOf` reffile = noop
| otherwise = void $ do
sha <- catchDefaultIO Nothing $
- extractSha <$> readFile reffile
+ extractSha <$> S.readFile reffile
-- When the channel is full, there is probably no reader
-- running, or ref changes have been occuring very fast,
-- so it's ok to not write the change to it.
-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings #-}
module Database.Keys (
DbHandle,
import Git.Index
import qualified Data.ByteString as S
+import qualified Data.ByteString.Char8 as S8
import qualified System.FilePath.ByteString as P
{- Runs an action that reads from the database.
Nothing -> noop
where
go cur indexcache = do
- (l, cleanup) <- inRepo $ pipeNullSplit diff
- changed <- procdiff (map decodeBL' l) False
+ (l, cleanup) <- inRepo $ pipeNullSplit' diff
+ changed <- procdiff l False
void $ liftIO cleanup
-- Flush database changes immediately
-- so other processes can see them.
, Param "--no-ext-diff"
]
- procdiff (info:file:rest) changed = case words info of
- ((':':_srcmode):dstmode:_srcsha:dstsha:_change:[])
- -- Only want files, not symlinks
- | dstmode /= decodeBS' (fmtTreeItemType TreeSymlink) -> do
- maybe noop (reconcile (asTopFilePath (toRawFilePath file)))
- =<< catKey (Ref dstsha)
- procdiff rest True
- | otherwise -> procdiff rest changed
- _ -> return changed -- parse failed
+ procdiff (info:file:rest) changed
+ | ":" `S.isPrefixOf` info = case S8.words info of
+ (_colonsrcmode:dstmode:_srcsha:dstsha:_change:[])
+ -- Only want files, not symlinks
+ | dstmode /= fmtTreeItemType TreeSymlink -> do
+ maybe noop (reconcile (asTopFilePath file))
+ =<< catKey (Ref dstsha)
+ procdiff rest True
+ | otherwise -> procdiff rest changed
+ _ -> return changed -- parse failed
procdiff _ changed = return changed
-- Note that database writes done in here will not necessarily
import qualified Git.Ref
import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as B8
{- The currently checked out branch.
-
{- The current branch, which may not really exist yet. -}
currentUnsafe :: Repo -> IO (Maybe Branch)
-currentUnsafe r = parse . firstLine'
- <$> pipeReadStrict [Param "symbolic-ref", Param "-q", Param $ fromRef Git.Ref.headRef] r
+currentUnsafe r = parse . firstLine' <$> pipeReadStrict
+ [ Param "symbolic-ref"
+ , Param "-q"
+ , Param $ fromRef Git.Ref.headRef
+ ] r
where
parse b
| B.null b = Nothing
- | otherwise = Just $ Git.Ref $ decodeBS b
+ | otherwise = Just $ Git.Ref b
{- Checks if the second branch has any commits not present on the first
- branch. -}
changed :: Branch -> Branch -> Repo -> IO Bool
changed origbranch newbranch repo
| origbranch == newbranch = return False
- | otherwise = not . null
+ | otherwise = not . B.null
<$> changed' origbranch newbranch [Param "-n1"] repo
where
-changed' :: Branch -> Branch -> [CommandParam] -> Repo -> IO String
-changed' origbranch newbranch extraps repo =
- decodeBS <$> pipeReadStrict ps repo
+changed' :: Branch -> Branch -> [CommandParam] -> Repo -> IO B.ByteString
+changed' origbranch newbranch extraps repo = pipeReadStrict ps repo
where
ps =
[ Param "log"
{- Lists commits that are in the second branch and not in the first branch. -}
changedCommits :: Branch -> Branch -> [CommandParam] -> Repo -> IO [Sha]
changedCommits origbranch newbranch extraps repo =
- catMaybes . map extractSha . lines
+ catMaybes . map extractSha . B8.lines
<$> changed' origbranch newbranch extraps repo
{- Check if it's possible to fast-forward from the old
-}
commit :: CommitMode -> Bool -> String -> Branch -> [Ref] -> Repo -> IO (Maybe Sha)
commit commitmode allowempty message branch parentrefs repo = do
- tree <- getSha "write-tree" $
- decodeBS' <$> pipeReadStrict [Param "write-tree"] repo
+ tree <- getSha "write-tree" $ pipeReadStrict [Param "write-tree"] repo
ifM (cancommit tree)
( do
sha <- commitTree commitmode message parentrefs tree repo
- Licensed under the GNU AGPL version 3 or higher.
-}
+{-# LANGUAGE OverloadedStrings #-}
+
module Git.CatFile (
CatFileHandle,
catFileStart,
import System.IO
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
-import qualified Data.ByteString.Lazy.Char8 as L8
import qualified Data.Map as M
import Data.String
import Data.Char
{- Reads a file from a specified branch. -}
catFile :: CatFileHandle -> Branch -> RawFilePath -> IO L.ByteString
catFile h branch file = catObject h $ Ref $
- fromRef branch ++ ":" ++ fromRawFilePath (toInternalGitPath file)
+ fromRef' branch <> ":" <> toInternalGitPath file
catFileDetails :: CatFileHandle -> Branch -> RawFilePath -> IO (Maybe (L.ByteString, Sha, ObjectType))
catFileDetails h branch file = catObjectDetails h $ Ref $
- fromRef branch ++ ":" ++ fromRawFilePath (toInternalGitPath file)
+ fromRef' branch <> ":" <> toInternalGitPath file
{- Uses a running git cat-file read the content of an object.
- Objects that do not exist will have "" returned. -}
| " missing" `isSuffixOf` l -- less expensive than full check
&& l == fromRef object ++ " missing" = Just DNE
| otherwise = case words l of
- [sha, objtype, size] -> case extractSha sha of
+ [sha, objtype, size] -> case extractSha (encodeBS sha) of
Just sha' -> case (readObjectType (encodeBS objtype), reads size) of
(Just t, [(bytes, "")]) ->
Just $ ParsedResp sha' bytes t
catCommit :: CatFileHandle -> Ref -> IO (Maybe Commit)
catCommit h commitref = go <$> catObjectDetails h commitref
where
- go (Just (b, _, CommitObject)) = parseCommit b
+ go (Just (b, _, CommitObject)) = parseCommit (L.toStrict b)
go _ = Nothing
-parseCommit :: L.ByteString -> Maybe Commit
+parseCommit :: S.ByteString -> Maybe Commit
parseCommit b = Commit
- <$> (extractSha . L8.unpack =<< field "tree")
- <*> Just (maybe [] (mapMaybe (extractSha . L8.unpack)) (fields "parent"))
+ <$> (extractSha =<< field "tree")
+ <*> Just (maybe [] (mapMaybe extractSha) (fields "parent"))
<*> (parsemetadata <$> field "author")
<*> (parsemetadata <$> field "committer")
- <*> Just (L8.unpack $ L.intercalate (L.singleton nl) message)
+ <*> Just (decodeBS $ S.intercalate (S.singleton nl) message)
where
field n = headMaybe =<< fields n
fields n = M.lookup (fromString n) fieldmap
fieldmap = M.fromListWith (++) ((map breakfield) header)
breakfield l =
- let (k, sp_v) = L.break (== sp) l
- in (k, [L.drop 1 sp_v])
- (header, message) = separate L.null ls
- ls = L.split nl b
+ let (k, sp_v) = S.break (== sp) l
+ in (k, [S.drop 1 sp_v])
+ (header, message) = separate S.null ls
+ ls = S.split nl b
-- author and committer lines have the form: "name <email> date"
-- The email is always present, even if empty "<>"
parsemetadata l = CommitMetaData
- { commitName = whenset $ L.init name_sp
+ { commitName = whenset $ S.init name_sp
, commitEmail = whenset email
- , commitDate = whenset $ L.drop 2 gt_sp_date
+ , commitDate = whenset $ S.drop 2 gt_sp_date
}
where
- (name_sp, rest) = L.break (== lt) l
- (email, gt_sp_date) = L.break (== gt) (L.drop 1 rest)
+ (name_sp, rest) = S.break (== lt) l
+ (email, gt_sp_date) = S.break (== gt) (S.drop 1 rest)
whenset v
- | L.null v = Nothing
- | otherwise = Just (L8.unpack v)
+ | S.null v = Nothing
+ | otherwise = Just (decodeBS v)
nl = fromIntegral (ord '\n')
sp = fromIntegral (ord ' ')
import qualified Data.Set as S
import qualified Data.ByteString.Lazy as L
-import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
+import qualified Data.ByteString.Lazy.Char8 as L8
data History t = History t (S.Set (History t))
deriving (Show, Eq, Ord)
!h <- fmap (truncateHistoryToDepth n)
. build Nothing
. map parsehistorycommit
- . map B.copy
- . B8.lines
+ . map L.toStrict
+ . L8.lines
<$> L.hGetContents inh
hClose inh
void $ waitForProcess pid
, Param "--format=%T %H %P"
]
- parsehistorycommit l = case map extractSha (S8.split ' ' l) of
+ parsehistorycommit l = case map extractSha (B8.split ' ' l) of
(Just t:Just c:ps) -> Just $
( HistoryCommit
{ historyCommit = c
import Utility.TimeStamp
import Numeric
+import Data.Char
import System.Posix.Types
import qualified Data.Map as M
-import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString as S
{- It's only safe to use git ls-files on the current repo, not on a remote.
-
{- Files that are checked into the index or have been committed to a
- branch. -}
inRepoOrBranch :: Branch -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
-inRepoOrBranch (Ref b) = inRepo' [Param $ "--with-tree=" ++ b]
+inRepoOrBranch b = inRepo' [Param $ "--with-tree=" ++ fromRef b]
{- Scans for files at the specified locations that are not checked into git. -}
notInRepo :: Bool -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
- contents. -}
stagedDetails' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([StagedDetails], IO Bool)
stagedDetails' ps l repo = guardSafeForLsFiles repo $ do
- (ls, cleanup) <- pipeNullSplit params repo
+ (ls, cleanup) <- pipeNullSplit' params repo
return (map parseStagedDetails ls, cleanup)
where
params = Param "ls-files" : Param "--stage" : Param "-z" : ps ++
Param "--" : map (File . fromRawFilePath) l
-parseStagedDetails :: L.ByteString -> StagedDetails
+parseStagedDetails :: S.ByteString -> StagedDetails
parseStagedDetails s
- | null file = (L.toStrict s, Nothing, Nothing)
- | otherwise = (toRawFilePath file, extractSha sha, readmode mode)
+ | S.null file = (s, Nothing, Nothing)
+ | otherwise = (file, extractSha sha, readmode mode)
where
- (metadata, file) = separate (== '\t') (decodeBL' s)
- (mode, metadata') = separate (== ' ') metadata
- (sha, _) = separate (== ' ') metadata'
- readmode = fst <$$> headMaybe . readOct
+ (metadata, file) = separate' (== fromIntegral (ord '\t')) s
+ (mode, metadata') = separate' (== fromIntegral (ord ' ')) metadata
+ (sha, _) = separate' (== fromIntegral (ord ' ')) metadata'
+ readmode = fst <$$> headMaybe . readOct . decodeBS'
{- Returns a list of the files in the specified locations that are staged
- for commit, and whose type has changed. -}
getAllRefs' :: FilePath -> IO [Ref]
getAllRefs' refdir = do
let topsegs = length (splitPath refdir) - 1
- let toref = Ref . 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 sha) && Ref.legal True ref ->
- Just (Ref sha, Ref 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
if ok
then return (Just branch, goodcommits')
else do
- (ls, cleanup) <- pipeNullSplit
+ (ls, cleanup) <- pipeNullSplit'
[ Param "log"
, Param "-z"
, Param "--format=%H"
, Param (fromRef branch)
] r
- let branchshas = catMaybes $ map (extractSha . decodeBL) ls
+ let branchshas = catMaybes $ map extractSha ls
reflogshas <- RefLog.get branch r
-- XXX Could try a bit harder here, and look
-- for uncorrupted old commits in branches in the
where
parse l = case words l of
(commitsha:treesha:[]) -> (,)
- <$> extractSha commitsha
- <*> extractSha treesha
+ <$> extractSha (encodeBS' commitsha)
+ <*> extractSha (encodeBS' treesha)
_ -> Nothing
check [] = return True
check ((c, t):rest)
void $ tryIO $ allowWrite f
where
headfile = fromRawFilePath (localGitDir g) </> "HEAD"
- validhead s = "ref: refs/" `isPrefixOf` s || isJust (extractSha s)
+ validhead s = "ref: refs/" `isPrefixOf` s
+ || isJust (extractSha (encodeBS' s))
{- Put it all together. -}
runRepair :: (Ref -> Bool) -> Bool -> Repo -> IO (Bool, [Branch])
import Control.Monad.IO.Class
import qualified Data.Set as S
import qualified Data.Map as M
+import qualified Data.ByteString.Char8 as S8
newtype Tree = Tree [TreeContent]
deriving (Show)
NewSubTree _ _ -> error "recordSubTree internal error; unexpected NewSubTree"
TreeCommit f fm s -> mkTreeOutput fm CommitObject s f
hPutStr h "\NUL" -- signal end of tree to --batch
- receive h = getSha "mktree" (hGetLine h)
+ receive h = getSha "mktree" (S8.hGetLine h)
treeMode :: FileMode
treeMode = 0o040000
mergeIndex
) where
+import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as L8
+import qualified Data.ByteString.Char8 as S8
import qualified Data.Set as S
import Common
{- For merging two trees. -}
mergeTrees :: Ref -> Ref -> HashObjectHandle -> CatFileHandle -> Repo -> Streamer
-mergeTrees (Ref x) (Ref y) hashhandle ch = doMerge hashhandle ch
- ("diff-tree":diffOpts ++ [x, y, "--"])
+mergeTrees x y hashhandle ch = doMerge hashhandle ch
+ ("diff-tree":diffOpts ++ [fromRef x, fromRef y, "--"])
{- For merging a single tree into the index. -}
mergeTreeIndex :: Ref -> HashObjectHandle -> CatFileHandle -> Repo -> Streamer
-mergeTreeIndex (Ref r) hashhandle ch = doMerge hashhandle ch $
- "diff-index" : diffOpts ++ ["--cached", r, "--"]
+mergeTreeIndex r hashhandle ch = doMerge hashhandle ch $
+ "diff-index" : diffOpts ++ ["--cached", fromRef r, "--"]
diffOpts :: [String]
diffOpts = ["--raw", "-z", "-r", "--no-renames", "-l0"]
- using git to get a raw diff. -}
doMerge :: HashObjectHandle -> CatFileHandle -> [String] -> Repo -> Streamer
doMerge hashhandle ch differ repo streamer = do
- (diff, cleanup) <- pipeNullSplit (map Param differ) repo
+ (diff, cleanup) <- pipeNullSplit' (map Param differ) repo
go diff
void $ cleanup
where
go [] = noop
- go (info:file:rest) = mergeFile (decodeBL' info) (L.toStrict file) hashhandle ch >>=
+ go (info:file:rest) = mergeFile info file hashhandle ch >>=
maybe (go rest) (\l -> streamer l >> go rest)
go (_:[]) = error $ "parse error " ++ show differ
{- Given an info line from a git raw diff, and the filename, generates
- a line suitable for update-index that union merges the two sides of the
- diff. -}
-mergeFile :: String -> RawFilePath -> HashObjectHandle -> CatFileHandle -> IO (Maybe L.ByteString)
+mergeFile :: S.ByteString -> RawFilePath -> HashObjectHandle -> CatFileHandle -> IO (Maybe L.ByteString)
mergeFile info file hashhandle h = case filter (`notElem` nullShas) [Ref asha, Ref bsha] of
[] -> return Nothing
(sha:[]) -> use sha
=<< either return (hashBlob hashhandle . L8.unlines)
=<< calcMerge . zip shas <$> mapM getcontents shas
where
- [_colonmode, _bmode, asha, bsha, _status] = words info
+ [_colonmode, _bmode, asha, bsha, _status] = S8.words info
use sha = return $ Just $
updateIndexLine sha TreeFile $ asTopFilePath file
-- Get file and split into lines to union merge.
deserialize ("truncated":ls) = deserialize' ls True
deserialize ls = deserialize' ls False
deserialize' ls t =
- let s = S.fromList $ map Ref ls
+ let s = S.fromList $ map (Ref . encodeBS') ls
in if S.null s then FsckFailed else FsckFoundMissing s t
clearFsckResults :: UUID -> Annex ()
- Licensed under the GNU AGPL version 3 or higher.
-}
+{-# LANGUAGE OverloadedStrings #-}
+
module Logs.View (
currentView,
setView,
import qualified Data.Text as T
import qualified Data.Set as S
import Data.Char
+import qualified Data.ByteString as B
setView :: View -> Annex ()
setView v = do
currentView :: Annex (Maybe View)
currentView = go =<< inRepo Git.Branch.current
where
- go (Just b) | branchViewPrefix `isPrefixOf` fromRef b =
+ go (Just b) | branchViewPrefix `B.isPrefixOf` fromRef' b =
headMaybe . filter (\v -> branchView v == b) <$> recentViews
go _ = return Nothing
-branchViewPrefix :: String
+branchViewPrefix :: B.ByteString
branchViewPrefix = "refs/heads/views"
{- Generates a git branch name for a View.
-}
branchView :: View -> Git.Branch
branchView view
- | null name = Git.Ref branchViewPrefix
- | otherwise = Git.Ref $ branchViewPrefix ++ "/" ++ name
+ | B.null name = Git.Ref branchViewPrefix
+ | otherwise = Git.Ref $ branchViewPrefix <> "/" <> name
where
- name = intercalate ";" $ map branchcomp (viewComponents view)
+ name = encodeBS' $
+ intercalate ";" $ map branchcomp (viewComponents view)
branchcomp c
| viewVisible c = branchcomp' c
| otherwise = "(" ++ branchcomp' c ++ ")"
is_branchView :: Git.Branch -> Bool
is_branchView (Ref b)
| b == branchViewPrefix = True
- | otherwise = (branchViewPrefix ++ "/") `isPrefixOf` b
+ | otherwise = (branchViewPrefix <> "/") `B.isPrefixOf` b
prop_branchView_legal :: View -> Bool
prop_branchView_legal = Git.Ref.legal False . fromRef . branchView
, remoteAnnexReadOnly = getbool "readonly" False
, remoteAnnexCheckUUID = getbool "checkuuid" True
, remoteAnnexVerify = getbool "verify" True
- , remoteAnnexTrackingBranch = Git.Ref <$>
+ , remoteAnnexTrackingBranch = Git.Ref . encodeBS <$>
( notempty (getmaybe "tracking-branch")
<|> notempty (getmaybe "export-tracking") -- old name
)
- Licensed under the GNU AGPL version 3 or higher.
-}
+{-# LANGUAGE OverloadedStrings #-}
+
module Types.View where
import Annex.Common
fromDirectBranch :: Ref -> Ref
fromDirectBranch directhead = case splitc '/' $ fromRef directhead of
("refs":"heads":"annex":"direct":rest) ->
- Ref $ "refs/heads/" ++ intercalate "/" rest
+ Ref $ encodeBS' $ "refs/heads/" ++ intercalate "/" rest
_ -> directhead
switchHEADBack :: Annex ()