6a97ff6b3a
Goal is to make git-annex faster by using ByteString for all the worktree traversal. For now, this is focusing on Command.Find, in order to benchmark how much it helps. (All other commands are temporarily disabled) Currently in a very bad unbuildable in-between state.
79 lines
2 KiB
Haskell
79 lines
2 KiB
Haskell
{- git status interface
|
|
-
|
|
- Copyright 2015-2018 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Git.Status where
|
|
|
|
import Common
|
|
import Git
|
|
import Git.Command
|
|
import Git.FilePath
|
|
|
|
data Status
|
|
= Modified TopFilePath
|
|
| Deleted TopFilePath
|
|
| Added TopFilePath
|
|
| Renamed TopFilePath TopFilePath
|
|
| TypeChanged TopFilePath
|
|
| Untracked TopFilePath
|
|
|
|
data StagedUnstaged a = StagedUnstaged
|
|
{ staged :: Maybe a
|
|
, unstaged :: Maybe a
|
|
}
|
|
|
|
statusChar :: Status -> Char
|
|
statusChar (Modified _) = 'M'
|
|
statusChar (Deleted _) = 'D'
|
|
statusChar (Added _) = 'A'
|
|
statusChar (Renamed _ _) = 'R'
|
|
statusChar (TypeChanged _) = 'T'
|
|
statusChar (Untracked _) = '?'
|
|
|
|
statusFile :: Status -> TopFilePath
|
|
statusFile (Modified f) = f
|
|
statusFile (Deleted f) = f
|
|
statusFile (Added f) = f
|
|
statusFile (Renamed _oldf newf) = newf
|
|
statusFile (TypeChanged f) = f
|
|
statusFile (Untracked f) = f
|
|
|
|
parseStatusZ :: [String] -> [StagedUnstaged Status]
|
|
parseStatusZ = go []
|
|
where
|
|
go c [] = reverse c
|
|
go c (x:xs) = case x of
|
|
(sstaged:sunstaged:' ':f) ->
|
|
case (cparse sstaged f xs, cparse sunstaged f xs) of
|
|
((vstaged, xs1), (vunstaged, xs2)) ->
|
|
let v = StagedUnstaged
|
|
{ staged = vstaged
|
|
, unstaged = vunstaged
|
|
}
|
|
xs' = fromMaybe xs (xs1 <|> xs2)
|
|
in go (v : c) xs'
|
|
_ -> go c xs
|
|
|
|
cparse 'M' f _ = (Just (Modified (asTopFilePath f)), Nothing)
|
|
cparse 'A' f _ = (Just (Added (asTopFilePath f)), Nothing)
|
|
cparse 'D' f _ = (Just (Deleted (asTopFilePath f)), Nothing)
|
|
cparse 'T' f _ = (Just (TypeChanged (asTopFilePath f)), Nothing)
|
|
cparse '?' f _ = (Just (Untracked (asTopFilePath f)), Nothing)
|
|
cparse 'R' f (oldf:xs) =
|
|
(Just (Renamed (asTopFilePath oldf) (asTopFilePath f)), Just xs)
|
|
cparse _ _ _ = (Nothing, Nothing)
|
|
|
|
getStatus :: [CommandParam] -> [FilePath] -> Repo -> IO ([StagedUnstaged Status], IO Bool)
|
|
getStatus ps fs r = do
|
|
(ls, cleanup) <- pipeNullSplit ps' r
|
|
return (parseStatusZ (map decodeBL ls), cleanup)
|
|
where
|
|
ps' = concat
|
|
[ [Param "status"]
|
|
, ps
|
|
, [ Param "-uall" , Param "-z"]
|
|
, map File fs
|
|
]
|