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            -- ^ Used to skip an output. Necessary because we are parsing twice the output, ignoring certain lines on each pass
                  deriving (Int -> GitFileState -> ShowS
[GitFileState] -> ShowS
GitFileState -> String
(Int -> GitFileState -> ShowS)
-> (GitFileState -> String)
-> ([GitFileState] -> ShowS)
-> Show GitFileState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitFileState] -> ShowS
$cshowList :: [GitFileState] -> ShowS
show :: GitFileState -> String
$cshow :: GitFileState -> String
showsPrec :: Int -> GitFileState -> ShowS
$cshowsPrec :: Int -> GitFileState -> ShowS
Show)

-- | In case of error, return zeroRepoState, i.e. no changes
gitParseStatus :: String -> GitLocalRepoChanges
gitParseStatus :: String -> GitLocalRepoChanges
gitParseStatus String
out =
  GitLocalRepoChanges -> GitLocalRepoChanges -> GitLocalRepoChanges
mergeGitLocalRepoChanges GitLocalRepoChanges
local GitLocalRepoChanges
index
  where local :: GitLocalRepoChanges
local = (String -> GitLocalRepoChanges
parseLocal String
out)
        index :: GitLocalRepoChanges
index = (String -> GitLocalRepoChanges
parseIndex String
out)

parseLocal :: String -> GitLocalRepoChanges
parseLocal :: String -> GitLocalRepoChanges
parseLocal String
str =
  (ParseError -> GitLocalRepoChanges)
-> (GitLocalRepoChanges -> GitLocalRepoChanges)
-> Either ParseError GitLocalRepoChanges
-> GitLocalRepoChanges
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (GitLocalRepoChanges -> ParseError -> GitLocalRepoChanges
forall a b. a -> b -> a
const GitLocalRepoChanges
zeroLocalRepoChanges)
    GitLocalRepoChanges -> GitLocalRepoChanges
forall a. a -> a
id
    (Parsec String () GitLocalRepoChanges
-> String -> String -> Either ParseError GitLocalRepoChanges
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () GitLocalRepoChanges
localPorcelainStatusParser String
"" String
str)

parseIndex :: String -> GitLocalRepoChanges
parseIndex :: String -> GitLocalRepoChanges
parseIndex String
str =
  (ParseError -> GitLocalRepoChanges)
-> (GitLocalRepoChanges -> GitLocalRepoChanges)
-> Either ParseError GitLocalRepoChanges
-> GitLocalRepoChanges
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (GitLocalRepoChanges -> ParseError -> GitLocalRepoChanges
forall a b. a -> b -> a
const GitLocalRepoChanges
zeroLocalRepoChanges)
    GitLocalRepoChanges -> GitLocalRepoChanges
forall a. a -> a
id
    (Parsec String () GitLocalRepoChanges
-> String -> String -> Either ParseError GitLocalRepoChanges
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () GitLocalRepoChanges
indexPorcelainStatusParser String
"" String
str)

localPorcelainStatusParser :: Parser GitLocalRepoChanges
localPorcelainStatusParser :: Parsec String () GitLocalRepoChanges
localPorcelainStatusParser = Parser [GitFileState] -> Parsec String () GitLocalRepoChanges
gitLinesToLocalRepoState (Parser [GitFileState] -> Parsec String () GitLocalRepoChanges)
-> (ParsecT String () Identity GitFileState
    -> Parser [GitFileState])
-> ParsecT String () Identity GitFileState
-> Parsec String () GitLocalRepoChanges
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT String () Identity GitFileState -> Parser [GitFileState]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String () Identity GitFileState
 -> Parsec String () GitLocalRepoChanges)
-> ParsecT String () Identity GitFileState
-> Parsec String () GitLocalRepoChanges
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity GitFileState
gitLocalLines

indexPorcelainStatusParser :: Parser GitLocalRepoChanges
indexPorcelainStatusParser :: Parsec String () GitLocalRepoChanges
indexPorcelainStatusParser = Parser [GitFileState] -> Parsec String () GitLocalRepoChanges
gitLinesToIndexRepoState (Parser [GitFileState] -> Parsec String () GitLocalRepoChanges)
-> (ParsecT String () Identity GitFileState
    -> Parser [GitFileState])
-> ParsecT String () Identity GitFileState
-> Parsec String () GitLocalRepoChanges
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT String () Identity GitFileState -> Parser [GitFileState]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String () Identity GitFileState
 -> Parsec String () GitLocalRepoChanges)
-> ParsecT String () Identity GitFileState
-> Parsec String () GitLocalRepoChanges
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity GitFileState
gitIndexLines

gitLinesToLocalRepoState :: Parser [GitFileState] -> Parser GitLocalRepoChanges
gitLinesToLocalRepoState :: Parser [GitFileState] -> Parsec String () GitLocalRepoChanges
gitLinesToLocalRepoState Parser [GitFileState]
gitFileStateP = do
    [GitFileState]
gitFileState <- Parser [GitFileState]
gitFileStateP
    GitLocalRepoChanges -> Parsec String () GitLocalRepoChanges
forall (m :: * -> *) a. Monad m => a -> m a
return (GitLocalRepoChanges -> Parsec String () GitLocalRepoChanges)
-> GitLocalRepoChanges -> Parsec String () GitLocalRepoChanges
forall a b. (a -> b) -> a -> b
$ (GitLocalRepoChanges -> GitFileState -> GitLocalRepoChanges)
-> GitLocalRepoChanges -> [GitFileState] -> GitLocalRepoChanges
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl GitLocalRepoChanges -> GitFileState -> GitLocalRepoChanges
linesStateFolder GitLocalRepoChanges
zeroLocalRepoChanges [GitFileState]
gitFileState

gitLinesToIndexRepoState :: Parser [GitFileState] -> Parser GitLocalRepoChanges
gitLinesToIndexRepoState :: Parser [GitFileState] -> Parsec String () GitLocalRepoChanges
gitLinesToIndexRepoState Parser [GitFileState]
gitFileStateP = do
    [GitFileState]
gitFileState <- Parser [GitFileState]
gitFileStateP
    GitLocalRepoChanges -> Parsec String () GitLocalRepoChanges
forall (m :: * -> *) a. Monad m => a -> m a
return (GitLocalRepoChanges -> Parsec String () GitLocalRepoChanges)
-> GitLocalRepoChanges -> Parsec String () GitLocalRepoChanges
forall a b. (a -> b) -> a -> b
$ (GitLocalRepoChanges -> GitFileState -> GitLocalRepoChanges)
-> GitLocalRepoChanges -> [GitFileState] -> GitLocalRepoChanges
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl GitLocalRepoChanges -> GitFileState -> GitLocalRepoChanges
linesStateFolder GitLocalRepoChanges
zeroLocalRepoChanges [GitFileState]
gitFileState

linesStateFolder :: GitLocalRepoChanges -> GitFileState -> GitLocalRepoChanges
linesStateFolder :: GitLocalRepoChanges -> GitFileState -> GitLocalRepoChanges
linesStateFolder GitLocalRepoChanges
repoS (GitFileState
LocalMod) = GitLocalRepoChanges
repoS { localMod :: Int
localMod = (GitLocalRepoChanges -> Int
localMod GitLocalRepoChanges
repoS) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
linesStateFolder GitLocalRepoChanges
repoS (GitFileState
LocalAdd) = GitLocalRepoChanges
repoS { localAdd :: Int
localAdd = (GitLocalRepoChanges -> Int
localAdd GitLocalRepoChanges
repoS) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
linesStateFolder GitLocalRepoChanges
repoS (GitFileState
LocalDel) = GitLocalRepoChanges
repoS { localDel :: Int
localDel = (GitLocalRepoChanges -> Int
localDel GitLocalRepoChanges
repoS) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
linesStateFolder GitLocalRepoChanges
repoS (GitFileState
IndexMod) = GitLocalRepoChanges
repoS { indexMod :: Int
indexMod = (GitLocalRepoChanges -> Int
indexMod GitLocalRepoChanges
repoS) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
linesStateFolder GitLocalRepoChanges
repoS (GitFileState
IndexAdd) = GitLocalRepoChanges
repoS { indexAdd :: Int
indexAdd = (GitLocalRepoChanges -> Int
indexAdd GitLocalRepoChanges
repoS) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
linesStateFolder GitLocalRepoChanges
repoS (GitFileState
IndexDel) = GitLocalRepoChanges
repoS { indexDel :: Int
indexDel = (GitLocalRepoChanges -> Int
indexDel GitLocalRepoChanges
repoS) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
linesStateFolder GitLocalRepoChanges
repoS (GitFileState
Conflict) = GitLocalRepoChanges
repoS { conflict :: Int
conflict = (GitLocalRepoChanges -> Int
conflict GitLocalRepoChanges
repoS) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
linesStateFolder GitLocalRepoChanges
repoS (GitFileState
Renamed)  = GitLocalRepoChanges
repoS { renamed :: Int
renamed = (GitLocalRepoChanges -> Int
renamed GitLocalRepoChanges
repoS) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
linesStateFolder GitLocalRepoChanges
repoS (GitFileState
Skip)     = GitLocalRepoChanges
repoS

gitLocalLines :: Parser GitFileState
gitLocalLines :: ParsecT String () Identity GitFileState
gitLocalLines = do
    GitFileState
state <- ParsecT String () Identity GitFileState
localFileState
    ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
    GitFileState -> ParsecT String () Identity GitFileState
forall (m :: * -> *) a. Monad m => a -> m a
return GitFileState
state

gitIndexLines :: Parser GitFileState
gitIndexLines :: ParsecT String () Identity GitFileState
gitIndexLines = do
    GitFileState
state <- ParsecT String () Identity GitFileState
indexFileState
    ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
    GitFileState -> ParsecT String () Identity GitFileState
forall (m :: * -> *) a. Monad m => a -> m a
return GitFileState
state

indexFileState :: Parser GitFileState
indexFileState :: ParsecT String () Identity GitFileState
indexFileState = do
    GitFileState
state <- [ParsecT String () Identity GitFileState]
-> ParsecT String () Identity GitFileState
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [
        ParsecT String () Identity GitFileState
conflictState
        , ParsecT String () Identity GitFileState
renamedState
        , ParsecT String () Identity GitFileState
indexModState
        , ParsecT String () Identity GitFileState
indexAddState
        , ParsecT String () Identity GitFileState
indexDelState
        -- Fallthrough to skip the lines indicating local modifications
        , ParsecT String () Identity GitFileState
skipLine
        ] ParsecT String () Identity GitFileState
-> String -> ParsecT String () Identity GitFileState
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"local file state"
    ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String () Identity Char
 -> ParsecT String () Identity String)
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\n"
    GitFileState -> ParsecT String () Identity GitFileState
forall (m :: * -> *) a. Monad m => a -> m a
return GitFileState
state

localFileState :: Parser GitFileState
localFileState :: ParsecT String () Identity GitFileState
localFileState = do
    GitFileState
state <- [ParsecT String () Identity GitFileState]
-> ParsecT String () Identity GitFileState
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [
        ParsecT String () Identity GitFileState
localModState
        , ParsecT String () Identity GitFileState
localAddState
        , ParsecT String () Identity GitFileState
localDelState
        -- Fallthrough to skip the lines indicating index modifications
        , ParsecT String () Identity GitFileState
skipLine
        ] ParsecT String () Identity GitFileState
-> String -> ParsecT String () Identity GitFileState
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"local file state"
    ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT String () Identity Char
 -> ParsecT String () Identity String)
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
"\n"
    GitFileState -> ParsecT String () Identity GitFileState
forall (m :: * -> *) a. Monad m => a -> m a
return GitFileState
state

-- | Parser of 2 characters exactly that returns a specific State
twoCharParser :: [Char]           -- ^ List of allowed first Char to be matched
              -> [Char]           -- ^ List of allowed second Char to be matched
              -> GitFileState   -- ^ the GitFileState to return as output
              -> Parser GitFileState
twoCharParser :: String
-> String
-> GitFileState
-> ParsecT String () Identity GitFileState
twoCharParser String
first String
second GitFileState
state = ParsecT String () Identity GitFileState
-> ParsecT String () Identity GitFileState
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity GitFileState
 -> ParsecT String () Identity GitFileState)
-> ParsecT String () Identity GitFileState
-> ParsecT String () Identity GitFileState
forall a b. (a -> b) -> a -> b
$ do
  String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
first
  String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
second
  GitFileState -> ParsecT String () Identity GitFileState
forall (m :: * -> *) a. Monad m => a -> m a
return GitFileState
state

skipLine :: Parser GitFileState
skipLine :: ParsecT String () Identity GitFileState
skipLine = ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT String () Identity Char
-> ParsecT String () Identity GitFileState
-> ParsecT String () Identity GitFileState
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GitFileState -> ParsecT String () Identity GitFileState
forall (m :: * -> *) a. Monad m => a -> m a
return GitFileState
Skip

conflictState :: Parser GitFileState
conflictState :: ParsecT String () Identity GitFileState
conflictState = [ParsecT String () Identity GitFileState]
-> ParsecT String () Identity GitFileState
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [
  (String
-> String
-> GitFileState
-> ParsecT String () Identity GitFileState
twoCharParser String
"D" String
"DU" GitFileState
Conflict)
  , (String
-> String
-> GitFileState
-> ParsecT String () Identity GitFileState
twoCharParser String
"A" String
"AU" GitFileState
Conflict)
  , (String
-> String
-> GitFileState
-> ParsecT String () Identity GitFileState
twoCharParser String
"U" String
"AUD" GitFileState
Conflict)
  ] ParsecT String () Identity GitFileState
-> String -> ParsecT String () Identity GitFileState
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"conflict parser"

localModState :: Parser GitFileState
localModState :: ParsecT String () Identity GitFileState
localModState = String
-> String
-> GitFileState
-> ParsecT String () Identity GitFileState
twoCharParser String
"MARC " String
"M" GitFileState
LocalMod

localAddState :: Parser GitFileState
localAddState :: ParsecT String () Identity GitFileState
localAddState = String
-> String
-> GitFileState
-> ParsecT String () Identity GitFileState
twoCharParser String
"?" String
"?" GitFileState
LocalAdd

localDelState :: Parser GitFileState
localDelState :: ParsecT String () Identity GitFileState
localDelState = String
-> String
-> GitFileState
-> ParsecT String () Identity GitFileState
twoCharParser String
"MARC " String
"D" GitFileState
LocalDel

indexModState :: Parser GitFileState
indexModState :: ParsecT String () Identity GitFileState
indexModState = String
-> String
-> GitFileState
-> ParsecT String () Identity GitFileState
twoCharParser String
"M" String
"DM " GitFileState
IndexMod

indexAddState :: Parser GitFileState
indexAddState :: ParsecT String () Identity GitFileState
indexAddState = String
-> String
-> GitFileState
-> ParsecT String () Identity GitFileState
twoCharParser String
"A" String
"DM " GitFileState
IndexAdd

indexDelState :: Parser GitFileState
indexDelState :: ParsecT String () Identity GitFileState
indexDelState = String
-> String
-> GitFileState
-> ParsecT String () Identity GitFileState
twoCharParser String
"D" String
"M " GitFileState
IndexDel

renamedState :: Parser GitFileState
renamedState :: ParsecT String () Identity GitFileState
renamedState = String
-> String
-> GitFileState
-> ParsecT String () Identity GitFileState
twoCharParser String
"R" String
"DM " GitFileState
Renamed