module GitHUD.Git.Parse.Status (
gitParseStatus
) where
import Text.Parsec (parse)
import Text.Parsec.String (Parser)
import Text.Parsec.Char (anyChar, newline, noneOf, oneOf)
import Text.Parsec.Prim (many, (<?>), try)
import Text.Parsec.Combinator (choice)
import GitHUD.Git.Types
data GitFileState = LocalMod
| LocalAdd
| LocalDel
| IndexMod
| IndexAdd
| IndexDel
| Renamed
| Conflict
| Skip
deriving (Show)
gitParseStatus :: String -> GitLocalRepoChanges
gitParseStatus out =
mergeGitLocalRepoChanges local index
where local = (parseLocal out)
index = (parseIndex out)
parseLocal :: String -> GitLocalRepoChanges
parseLocal str =
either
(const zeroLocalRepoChanges)
id
(parse localPorcelainStatusParser "" str)
parseIndex :: String -> GitLocalRepoChanges
parseIndex str =
either
(const zeroLocalRepoChanges)
id
(parse indexPorcelainStatusParser "" str)
localPorcelainStatusParser :: Parser GitLocalRepoChanges
localPorcelainStatusParser = gitLinesToLocalRepoState . many $ gitLocalLines
indexPorcelainStatusParser :: Parser GitLocalRepoChanges
indexPorcelainStatusParser = gitLinesToIndexRepoState . many $ gitIndexLines
gitLinesToLocalRepoState :: Parser [GitFileState] -> Parser GitLocalRepoChanges
gitLinesToLocalRepoState gitFileStateP = do
gitFileState <- gitFileStateP
return $ foldl linesStateFolder zeroLocalRepoChanges gitFileState
gitLinesToIndexRepoState :: Parser [GitFileState] -> Parser GitLocalRepoChanges
gitLinesToIndexRepoState gitFileStateP = do
gitFileState <- gitFileStateP
return $ foldl linesStateFolder zeroLocalRepoChanges gitFileState
linesStateFolder :: GitLocalRepoChanges -> GitFileState -> GitLocalRepoChanges
linesStateFolder repoS (LocalMod) = repoS { localMod = (localMod repoS) + 1 }
linesStateFolder repoS (LocalAdd) = repoS { localAdd = (localAdd repoS) + 1 }
linesStateFolder repoS (LocalDel) = repoS { localDel = (localDel repoS) + 1 }
linesStateFolder repoS (IndexMod) = repoS { indexMod = (indexMod repoS) + 1 }
linesStateFolder repoS (IndexAdd) = repoS { indexAdd = (indexAdd repoS) + 1 }
linesStateFolder repoS (IndexDel) = repoS { indexDel = (indexDel repoS) + 1 }
linesStateFolder repoS (Conflict) = repoS { conflict = (conflict repoS) + 1 }
linesStateFolder repoS (Renamed) = repoS { renamed = (renamed repoS) + 1 }
linesStateFolder repoS (Skip) = repoS
gitLocalLines :: Parser GitFileState
gitLocalLines = do
state <- localFileState
newline
return state
gitIndexLines :: Parser GitFileState
gitIndexLines = do
state <- indexFileState
newline
return state
indexFileState :: Parser GitFileState
indexFileState = do
state <- choice [
conflictState
, renamedState
, indexModState
, indexAddState
, indexDelState
, skipLine
] <?> "local file state"
many $ noneOf "\n"
return state
localFileState :: Parser GitFileState
localFileState = do
state <- choice [
localModState
, localAddState
, localDelState
, skipLine
] <?> "local file state"
many $ noneOf "\n"
return state
twoCharParser :: [Char]
-> [Char]
-> GitFileState
-> Parser GitFileState
twoCharParser first second state = try $ do
oneOf first
oneOf second
return state
skipLine :: Parser GitFileState
skipLine = anyChar >> return Skip
conflictState :: Parser GitFileState
conflictState = choice [
(twoCharParser "D" "DU" Conflict)
, (twoCharParser "A" "AU" Conflict)
, (twoCharParser "U" "AUD" Conflict)
] <?> "conflict parser"
localModState :: Parser GitFileState
localModState = twoCharParser "MARC " "M" LocalMod
localAddState :: Parser GitFileState
localAddState = twoCharParser "?" "?" LocalAdd
localDelState :: Parser GitFileState
localDelState = twoCharParser "MARC " "D" LocalDel
indexModState :: Parser GitFileState
indexModState = twoCharParser "M" "DM " IndexMod
indexAddState :: Parser GitFileState
indexAddState = twoCharParser "A" "DM " IndexAdd
indexDelState :: Parser GitFileState
indexDelState = twoCharParser "D" "M " IndexDel
renamedState :: Parser GitFileState
renamedState = twoCharParser "R" "DM " Renamed