1{- .git/objects
2 -
3 - Copyright 2013 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8{-# LANGUAGE OverloadedStrings #-}
9
10module Git.Objects where
11
12import Common
13import Git
14import Git.Sha
15
16import qualified Data.ByteString as B
17import qualified System.FilePath.ByteString as P
18
19objectsDir :: Repo -> RawFilePath
20objectsDir r = localGitDir r P.</> "objects"
21
22packDir :: Repo -> RawFilePath
23packDir r = objectsDir r P.</> "pack"
24
25packIdxFile :: RawFilePath -> RawFilePath
26packIdxFile = flip P.replaceExtension "idx"
27
28listPackFiles :: Repo -> IO [FilePath]
29listPackFiles r = filter (".pack" `isSuffixOf`)
30	<$> catchDefaultIO [] (dirContents $ fromRawFilePath $ packDir r)
31
32listLooseObjectShas :: Repo -> IO [Sha]
33listLooseObjectShas r = catchDefaultIO [] $
34	mapMaybe (extractSha . encodeBS . concat . reverse . take 2 . reverse . splitDirectories)
35		<$> dirContentsRecursiveSkipping (== "pack") True (fromRawFilePath (objectsDir r))
36
37looseObjectFile :: Repo -> Sha -> RawFilePath
38looseObjectFile r sha = objectsDir r P.</> prefix P.</> rest
39  where
40	(prefix, rest) = B.splitAt 2 (fromRef' sha)
41
42listAlternates :: Repo -> IO [FilePath]
43listAlternates r = catchDefaultIO [] $
44	lines <$> readFile (fromRawFilePath alternatesfile)
45  where
46	alternatesfile = objectsDir r P.</> "info" P.</> "alternates"
47
48{- A repository recently cloned with --shared will have one or more
49 - alternates listed, and contain no loose objects or packs. -}
50isSharedClone :: Repo -> IO Bool
51isSharedClone r = allM id
52	[ not . null <$> listAlternates r
53	, null <$> listLooseObjectShas r
54	, null <$> listPackFiles r
55	]
56