1ceece3108
By using System.Directory.OsPath, which takes and returns OsString, which is a ShortByteString. So, things like dirContents currently have the overhead of copying that to a ByteString, but that should be less than the overhead of using Strings which often in turn were converted to RawFilePaths. Added Utility.OsString and the OsString build flag. That flag is turned on in the stack.yaml, and will be turned on automatically by cabal when built with new enough libraries. The stack.yaml change is a bit ugly, and that could be reverted for now if it causes any problems. Note that Utility.OsString.toOsString on windows is avoiding only a check of encoding that is documented as being unlikely to fail. I don't think it can fail in git-annex; if it could, git-annex didn't contain such an encoding check before, so at worst that should be a wash.
55 lines
1.6 KiB
Haskell
55 lines
1.6 KiB
Haskell
{- .git/objects
|
|
-
|
|
- Copyright 2013 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Git.Objects where
|
|
|
|
import Common
|
|
import Git
|
|
import Git.Sha
|
|
|
|
import qualified Data.ByteString as B
|
|
import qualified System.FilePath.ByteString as P
|
|
|
|
objectsDir :: Repo -> RawFilePath
|
|
objectsDir r = localGitDir r P.</> "objects"
|
|
|
|
packDir :: Repo -> RawFilePath
|
|
packDir r = objectsDir r P.</> "pack"
|
|
|
|
packIdxFile :: RawFilePath -> RawFilePath
|
|
packIdxFile = flip P.replaceExtension "idx"
|
|
|
|
listPackFiles :: Repo -> IO [RawFilePath]
|
|
listPackFiles r = filter (".pack" `B.isSuffixOf`)
|
|
<$> catchDefaultIO [] (dirContents $ packDir r)
|
|
|
|
listLooseObjectShas :: Repo -> IO [Sha]
|
|
listLooseObjectShas r = catchDefaultIO [] $
|
|
mapMaybe (extractSha . encodeBS . concat . reverse . take 2 . reverse . splitDirectories . decodeBS)
|
|
<$> emptyWhenDoesNotExist (dirContentsRecursiveSkipping (== "pack") True (objectsDir r))
|
|
|
|
looseObjectFile :: Repo -> Sha -> RawFilePath
|
|
looseObjectFile r sha = objectsDir r P.</> prefix P.</> rest
|
|
where
|
|
(prefix, rest) = B.splitAt 2 (fromRef' sha)
|
|
|
|
listAlternates :: Repo -> IO [FilePath]
|
|
listAlternates r = catchDefaultIO [] $
|
|
lines <$> readFile (fromRawFilePath alternatesfile)
|
|
where
|
|
alternatesfile = objectsDir r P.</> "info" P.</> "alternates"
|
|
|
|
{- A repository recently cloned with --shared will have one or more
|
|
- alternates listed, and contain no loose objects or packs. -}
|
|
isSharedClone :: Repo -> IO Bool
|
|
isSharedClone r = allM id
|
|
[ not . null <$> listAlternates r
|
|
, null <$> listLooseObjectShas r
|
|
, null <$> listPackFiles r
|
|
]
|