1 files changed, 65 insertions, 31 deletions

diff --git a/Git/LsTree.hs b/Git/LsTree.hs
index 1ed6247..a3d8383 100644
--- a/Git/LsTree.hs
+++ b/Git/LsTree.hs
@@ -1,16 +1,21 @@
 {- git ls-tree interface
  -
- - Copyright 2011 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>
  -
- - Licensed under the GNU GPL version 3 or higher.
+ - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE BangPatterns #-}
+
 module Git.LsTree (
 	TreeItem(..),
+	LsTreeMode(..),
 	lsTree,
+	lsTree',
 	lsTreeParams,
 	lsTreeFiles,
-	parseLsTree
+	parseLsTree,
+	formatLsTree,
 ) where
 
 import Common
@@ -19,37 +24,52 @@ import Git.Command
 import Git.Sha
 import Git.FilePath
 import qualified Git.Filename
+import Utility.Attoparsec
 
 import Numeric
+import Data.Either
 import System.Posix.Types
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Lazy as L
+import qualified Data.Attoparsec.ByteString.Lazy as A
+import qualified Data.Attoparsec.ByteString.Char8 as A8
 
 data TreeItem = TreeItem
 	{ mode :: FileMode
-	, typeobj :: String
-	, sha :: String
+	, typeobj :: S.ByteString
+	, sha :: Ref
 	, file :: TopFilePath
 	} deriving Show
 
-{- Lists the complete contents of a tree, recursing into sub-trees,
- - with lazy output. -}
-lsTree :: Ref -> Repo -> IO [TreeItem]
-lsTree t repo = map parseLsTree
-	<$> pipeNullSplitZombie (lsTreeParams t []) repo
+data LsTreeMode = LsTreeRecursive | LsTreeNonRecursive
+
+{- Lists the contents of a tree, with lazy output. -}
+lsTree :: LsTreeMode -> Ref -> Repo -> IO ([TreeItem], IO Bool)
+lsTree = lsTree' []
+
+lsTree' :: [CommandParam] -> LsTreeMode -> Ref -> Repo -> IO ([TreeItem], IO Bool)
+lsTree' ps lsmode t repo = do
+	(l, cleanup) <- pipeNullSplit (lsTreeParams lsmode t ps) repo
+	return (rights (map parseLsTree l), cleanup)
 
-lsTreeParams :: Ref -> [CommandParam] -> [CommandParam]
-lsTreeParams r ps =
+lsTreeParams :: LsTreeMode -> Ref -> [CommandParam] -> [CommandParam]
+lsTreeParams lsmode r ps =
 	[ Param "ls-tree"
 	, Param "--full-tree"
 	, Param "-z"
-	, Param "-r"
-	] ++ ps ++
+	] ++ recursiveparams ++ ps ++
 	[ Param "--"
 	, File $ fromRef r
 	]
+  where
+	recursiveparams = case lsmode of
+		LsTreeRecursive -> [ Param "-r" ]
+		LsTreeNonRecursive -> []
 
 {- Lists specified files in a tree. -}
 lsTreeFiles :: Ref -> [FilePath] -> Repo -> IO [TreeItem]
-lsTreeFiles t fs repo = map parseLsTree <$> pipeNullSplitStrict ps repo
+lsTreeFiles t fs repo = rights . map (parseLsTree . L.fromStrict)
+	<$> pipeNullSplitStrict ps repo
   where
 	ps =
 		[ Param "ls-tree"
@@ -59,20 +79,34 @@ lsTreeFiles t fs repo = map parseLsTree <$> pipeNullSplitStrict ps repo
 		, File $ fromRef t
 		] ++ map File fs
 
-{- Parses a line of ls-tree output.
+parseLsTree :: L.ByteString -> Either String TreeItem
+parseLsTree b = case A.parse parserLsTree b of
+	A.Done _ r  -> Right r
+	A.Fail _ _ err -> Left err
+
+{- Parses a line of ls-tree output, in format:
+ - mode SP type SP sha TAB file
+ -
  - (The --long format is not currently supported.) -}
-parseLsTree :: String -> TreeItem
-parseLsTree l = TreeItem 
-	{ mode = fst $ Prelude.head $ readOct m
-	, typeobj = t
-	, sha = s
-	, file = asTopFilePath $ Git.Filename.decode f
-	}
-  where
-	-- l = <mode> SP <type> SP <sha> TAB <file>
-	-- All fields are fixed, so we can pull them out of
-	-- specific positions in the line.
-	(m, past_m) = splitAt 7 l
-	(t, past_t) = splitAt 4 past_m
-	(s, past_s) = splitAt shaSize $ Prelude.tail past_t
-	f = Prelude.tail past_s
+parserLsTree :: A.Parser TreeItem
+parserLsTree = TreeItem
+	-- mode
+	<$> octal
+	<* A8.char ' '
+	-- type
+	<*> A.takeTill (== 32)
+	<* A8.char ' '
+	-- sha
+	<*> (Ref . decodeBS' <$> A.take shaSize)
+	<* A8.char '\t'
+	-- file
+	<*> (asTopFilePath . Git.Filename.decode <$> A.takeByteString)
+
+{- Inverse of parseLsTree -}
+formatLsTree :: TreeItem -> String
+formatLsTree ti = unwords
+	[ showOct (mode ti) ""
+	, decodeBS (typeobj ti)
+	, fromRef (sha ti)
+	, fromRawFilePath (getTopFilePath (file ti))
+	]