adjust: Fix behavior when used in a repository that contains submodules.

Also fixed the LsFiles parser to not assume its output has a fixed width
type field.

2 files changed, 20 insertions, 8 deletions

diff --git a/Git/LsTree.hs b/Git/LsTree.hs
index 2060fa793..225f2ce13 100644
--- a/Git/LsTree.hs
+++ b/Git/LsTree.hs
@@ -24,6 +24,7 @@ import Git.FilePath
 import qualified Git.Filename
 
 import Numeric
+import Data.Char
 import System.Posix.Types
 
 data TreeItem = TreeItem
@@ -66,7 +67,9 @@ lsTreeFiles t fs repo = map parseLsTree <$> pipeNullSplitStrict ps repo
 		, File $ fromRef t
 		] ++ map File fs
 
-{- Parses a line of ls-tree output.
+{- 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 
@@ -76,12 +79,9 @@ parseLsTree l = TreeItem
 	, file = sfile
 	}
   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
+	(m, past_m) = splitAt 7 l -- mode is 6 bytes
+	(!t, past_t) = separate isSpace past_m
+	(!s, past_s) = splitAt shaSize past_t
+	!f = drop 1 past_s
 	!smode = fst $ Prelude.head $ readOct m
 	!sfile = asTopFilePath $ Git.Filename.decode f
diff --git a/Git/Tree.hs b/Git/Tree.hs
index 282643f49..3e6b85a1d 100644
--- a/Git/Tree.hs
+++ b/Git/Tree.hs
@@ -35,11 +35,14 @@ newtype Tree = Tree [TreeContent]
 	deriving (Show)
 
 data TreeContent
+	-- A blob object in the tree.
 	= TreeBlob TopFilePath FileMode Sha
 	-- A subtree that is already recorded in git, with a known sha.
 	| RecordedSubTree TopFilePath Sha [TreeContent]
 	-- A subtree that has not yet been recorded in git.
 	| NewSubTree TopFilePath [TreeContent]
+	-- A commit object that is part of a tree (used for submodules)
+	| TreeCommit TopFilePath FileMode Sha
 	deriving (Show, Eq, Ord)
 
 {- Gets the Tree for a Ref. -}
@@ -93,6 +96,7 @@ mkTree (MkTreeHandle cp) l = CoProcess.query cp send receive
 			TreeBlob f fm s -> mkTreeOutput fm BlobObject s f
 			RecordedSubTree f s _ -> mkTreeOutput 0o040000 TreeObject s f
 			NewSubTree _ _ -> error "recordSubTree internal error; unexpected NewSubTree"
+			TreeCommit f fm s -> mkTreeOutput fm CommitObject s f
 		hPutStr h "\NUL" -- signal end of tree to --batch
 	receive h = getSha "mktree" (hGetLine h)
 
@@ -152,6 +156,7 @@ flattenTree n (Tree l) = Tree (concatMap (go n) l)
 	go _ b@(TreeBlob _ _ _) = [b]
 	go n' (RecordedSubTree _ _ l') = concatMap (go (n'-1)) l'
 	go n' (NewSubTree _ l') = concatMap (go (n'-1)) l'
+	go _ c@(TreeCommit _ _ _) = [c]
 
 {- Applies an adjustment to items in a tree.
  -
@@ -200,6 +205,9 @@ adjustTree adjusttreeitem addtreeitems removefiles r repo =
 					else return $ RecordedSubTree (LsTree.file i) (LsTree.sha i) [] 
 				let !modified' = modified || slmodified || wasmodified
 				go h modified' (subtree : c) depth intree is'
+			Just CommitObject -> do
+				let ti = TreeCommit (LsTree.file i) (LsTree.mode i)  (LsTree.sha i)
+				go h wasmodified (ti:c) depth intree is
 			_ -> error ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"")
 		| otherwise = return (c, wasmodified, i:is)
 
@@ -236,6 +244,9 @@ extractTree l = case go [] inTopTree l of
 					let st = RecordedSubTree (LsTree.file i) (LsTree.sha i) subtree
 					in go (st:t) intree is'
 				Left e -> Left e
+			Just CommitObject ->
+				let c = TreeCommit (LsTree.file i) (LsTree.mode i) (LsTree.sha i)
+				in go (c:t) intree is
 			_ -> parseerr ("unexpected object type \"" ++ LsTree.typeobj i ++ "\"")
 		| otherwise = Right (t, i:is)
 	parseerr = Left
@@ -259,6 +270,7 @@ instance GitPath TreeContent where
 	gitPath (TreeBlob f _ _) = gitPath f
 	gitPath (RecordedSubTree f _ _) = gitPath f
 	gitPath (NewSubTree f _) = gitPath f
+	gitPath (TreeCommit f _ _) = gitPath f
 
 inTopTree :: GitPath t => t -> Bool
 inTopTree = inTree "."