1{- git ls-tree interface
2 -
3 - Copyright 2011-2021 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8module Git.LsTree (
9	TreeItem(..),
10	LsTreeRecursive(..),
11	LsTreeLong(..),
12	lsTree,
13	lsTree',
14	lsTreeStrict,
15	lsTreeStrict',
16	lsTreeParams,
17	lsTreeFiles,
18	parseLsTree,
19	formatLsTree,
20) where
21
22import Common
23import Git
24import Git.Command
25import Git.FilePath
26import qualified Git.Filename
27import Utility.Attoparsec
28
29import Numeric
30import Data.Either
31import Data.Char
32import System.Posix.Types
33import qualified Data.ByteString as S
34import qualified Data.ByteString.Lazy as L
35import qualified Data.Attoparsec.ByteString as AS
36import qualified Data.Attoparsec.ByteString.Lazy as A
37import qualified Data.Attoparsec.ByteString.Char8 as A8
38
39data TreeItem = TreeItem
40	{ mode :: FileMode
41	, typeobj :: S.ByteString
42	, sha :: Ref
43	, size :: Maybe FileSize
44	, file :: TopFilePath
45	-- ^ only available when long is used
46	} deriving (Show)
47
48data LsTreeRecursive = LsTreeRecursive | LsTreeNonRecursive
49
50{- Enabling --long also gets the size of tree items.
51 - This slows down ls-tree some, since it has to look up the size of each
52 - blob.
53 -}
54data LsTreeLong = LsTreeLong Bool
55
56{- Lists the contents of a tree, with lazy output. -}
57lsTree :: LsTreeRecursive -> LsTreeLong -> Ref -> Repo -> IO ([TreeItem], IO Bool)
58lsTree = lsTree' []
59
60lsTree' :: [CommandParam] -> LsTreeRecursive -> LsTreeLong -> Ref -> Repo -> IO ([TreeItem], IO Bool)
61lsTree' ps recursive long t repo = do
62	(l, cleanup) <- pipeNullSplit (lsTreeParams recursive long t ps) repo
63	return (rights (map (parseLsTree long) l), cleanup)
64
65lsTreeStrict :: LsTreeRecursive -> LsTreeLong -> Ref -> Repo -> IO [TreeItem]
66lsTreeStrict = lsTreeStrict' []
67
68lsTreeStrict' :: [CommandParam] -> LsTreeRecursive -> LsTreeLong -> Ref -> Repo -> IO [TreeItem]
69lsTreeStrict' ps recursive long t repo = rights . map (parseLsTreeStrict long)
70	<$> pipeNullSplitStrict (lsTreeParams recursive long t ps) repo
71
72lsTreeParams :: LsTreeRecursive -> LsTreeLong -> Ref -> [CommandParam] -> [CommandParam]
73lsTreeParams recursive long r ps =
74	[ Param "ls-tree"
75	, Param "--full-tree"
76	, Param "-z"
77	] ++ recursiveparams ++ longparams ++ ps ++
78	[ Param "--"
79	, File $ fromRef r
80	]
81  where
82	recursiveparams = case recursive of
83		LsTreeRecursive -> [ Param "-r" ]
84		LsTreeNonRecursive -> []
85	longparams = case long of
86		LsTreeLong True -> [ Param "--long" ]
87		LsTreeLong False -> []
88
89{- Lists specified files in a tree. -}
90lsTreeFiles :: LsTreeLong -> Ref -> [FilePath] -> Repo -> IO [TreeItem]
91lsTreeFiles long t fs repo = rights . map (parseLsTree long . L.fromStrict)
92	<$> pipeNullSplitStrict ps repo
93  where
94	ps =
95		[ Param "ls-tree"
96		, Param "--full-tree"
97		, Param "-z"
98		, Param "--"
99		, File $ fromRef t
100		] ++ map File fs
101
102parseLsTree :: LsTreeLong -> L.ByteString -> Either String TreeItem
103parseLsTree long b = case A.parse (parserLsTree long) b of
104	A.Done _ r  -> Right r
105	A.Fail _ _ err -> Left err
106
107parseLsTreeStrict :: LsTreeLong -> S.ByteString -> Either String TreeItem
108parseLsTreeStrict long b = go (AS.parse (parserLsTree long) b)
109  where
110	go (AS.Done _ r) = Right r
111	go (AS.Fail _ _ err) = Left err
112	go (AS.Partial c) = go (c mempty)
113
114{- Parses a line of ls-tree output, in format:
115 -   mode SP type SP sha TAB file
116 - Or long format:
117 -   mode SP type SP sha SPACES size TAB file
118 -
119 - The TAB can also be a space. Git does not use that, but an earlier
120 - version of formatLsTree did, and this keeps parsing what it output
121 - working.
122 -}
123parserLsTree :: LsTreeLong -> A.Parser TreeItem
124parserLsTree long = case long of
125	LsTreeLong False ->
126		startparser <*> pure Nothing <* filesep <*> fileparser
127	LsTreeLong True ->
128		startparser <* sizesep <*> sizeparser <* filesep <*> fileparser
129  where
130	startparser = TreeItem
131		-- mode
132		<$> octal
133		<* A8.char ' '
134		-- type
135		<*> A8.takeTill (== ' ')
136		<* A8.char ' '
137		-- sha
138		<*> (Ref <$> A8.takeTill A8.isSpace)
139
140	fileparser = asTopFilePath . Git.Filename.decode <$> A.takeByteString
141
142	sizeparser = fmap Just A8.decimal
143
144	filesep = A8.space
145
146	sizesep = A.many1 A8.space
147
148{- Inverse of parseLsTree. Note that the long output format is not
149 - generated, so any size information is not included. -}
150formatLsTree :: TreeItem -> S.ByteString
151formatLsTree ti = S.intercalate (S.singleton (fromIntegral (ord ' ')))
152	[ encodeBS (showOct (mode ti) "")
153	, typeobj ti
154	, fromRef' (sha ti)
155	] <> (S.cons (fromIntegral (ord '\t')) (getTopFilePath (file ti)))
156