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