git-annex/Git/LsTree.hs
Joey Hess d5d8259937
ByteString Ref continued
Attoparsec parser for diff-tree.

Changed fromRef back to producing a String, to avoid needing to convert
every use of it. However, this does mean I'm going to miss some
opportunities where fromRef is used and the result converted back to a
ByteString. Would be worth revisiting that at some point maybe.
2020-04-07 11:54:27 -04:00

111 lines
2.6 KiB
Haskell

{- git ls-tree interface
-
- Copyright 2011-2019 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE BangPatterns #-}
module Git.LsTree (
TreeItem(..),
LsTreeMode(..),
lsTree,
lsTree',
lsTreeParams,
lsTreeFiles,
parseLsTree,
formatLsTree,
) where
import Common
import Git
import Git.Command
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 :: S.ByteString
, sha :: Ref
, file :: TopFilePath
} deriving Show
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 :: LsTreeMode -> Ref -> [CommandParam] -> [CommandParam]
lsTreeParams lsmode r ps =
[ Param "ls-tree"
, Param "--full-tree"
, Param "-z"
] ++ 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 = rights . map (parseLsTree . L.fromStrict)
<$> pipeNullSplitStrict ps repo
where
ps =
[ Param "ls-tree"
, Param "--full-tree"
, Param "-z"
, Param "--"
, File $ fromRef t
] ++ map File fs
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.) -}
parserLsTree :: A.Parser TreeItem
parserLsTree = TreeItem
-- mode
<$> octal
<* A8.char ' '
-- type
<*> A8.takeTill (== ' ')
<* A8.char ' '
-- sha
<*> (Ref <$> A8.takeTill (== '\t'))
<* 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))
]