442e607b0a
In some cases, unstaged changes are safe, eg dotfiles in the top which are not affected by a view. Or non-annexed files in general which would prevent view branch checkout from proceeding. But in other cases, particularly unstaged changes to annexed files, entering a view would wipe out those changes! And so don't allow entering a view with any unstaged changes. Staged changes are not safe when entering a view, because the changes get committed to the view branch, and so the user is unlikely to remember them when they exit the view, and so will effectively lose them, even if they're still present in the view branch. Also, improved the git status parser, although the improvement turned out to not really be needed. This commit was sponsored by Eric Drechsel on Patreon.
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 GPL 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 ls, cleanup)
|
|
where
|
|
ps' = concat
|
|
[ [Param "status"]
|
|
, ps
|
|
, [ Param "-uall" , Param "-z"]
|
|
, map File fs
|
|
]
|