diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Grégory Bataille (c) 2015 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Grégory Bataille nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,6 @@ +module Main where + +import GitHUD + +main :: IO () +main = githud diff --git a/gitHUD.cabal b/gitHUD.cabal new file mode 100644 --- /dev/null +++ b/gitHUD.cabal @@ -0,0 +1,61 @@ +name: gitHUD +version: 1.0.0.0 +synopsis: More efficient replacement to the great git-radar +description: Please see README.md +homepage: http://github.com/gbataille/gitHUD#readme +license: BSD3 +license-file: LICENSE +author: Grégory Bataille +maintainer: gbataille.dev@gmail.com +copyright: Grégory Bataille 2015 +category: Development +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: GitHUD + , GitHUD.Process + , GitHUD.Git.Types + , GitHUD.Git.Common + , GitHUD.Git.Command + , GitHUD.Git.Parse.Base + , GitHUD.Git.Parse.Status + , GitHUD.Git.Parse.Branch + , GitHUD.Git.Parse.Count + , GitHUD.Terminal.Base + , GitHUD.Terminal.Types + build-depends: base >= 4.7 && < 5 + , process + , parsec >= 3.1.9 && < 4 + , mtl >= 2.2.1 && < 3 + default-language: Haskell2010 + +executable gitHUD + hs-source-dirs: app + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -fno-warn-unused-do-bind + build-depends: base + , gitHUD + default-language: Haskell2010 + +test-suite gitHUD-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , tasty >= 0.10 && < 0.12 + , tasty-hunit >= 0.9 && < 0.10 + , tasty-smallcheck >= 0.8 && < 0.9 + , tasty-quickcheck >= 0.8 && < 0.9 + , gitHUD + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + Other-modules: Test.GitHUD.Git.Parse.Status + , Test.GitHUD.Git.Parse.Branch + Ghc-Options: -rtsopts -Wall -fno-warn-unused-do-bind -threaded + +source-repository head + type: git + location: https://github.com/gbataille/gitHUD diff --git a/src/GitHUD.hs b/src/GitHUD.hs new file mode 100644 --- /dev/null +++ b/src/GitHUD.hs @@ -0,0 +1,177 @@ +module GitHUD ( + githud + ) where + +import Control.Monad.Reader +import System.Environment (getArgs) + +import GitHUD.Terminal.Types +import GitHUD.Terminal.Base +import GitHUD.Git.Types +import GitHUD.Git.Parse.Base +import GitHUD.Git.Command + +githud :: IO () +githud = do + shell <- processArguments getArgs + + isGit <- checkInGitDirectory + when isGit $ do + repoState <- getGitRepoState + runReaderT (buildOutput repoState) shell + -- Necessary to properly terminate the output + putStrLn "" + +processArguments :: IO [String] + -> IO Shell +processArguments args = do + arguments <- args + if (not (null arguments)) && ((head arguments) == "zsh") + then return ZSH + else return Other + +buildOutput :: GitRepoState + -> ShellOutput +buildOutput repoState = do + outputGitRepoIndicator + outputUpstreamAbsence (gitRemoteTrackingBranch repoState) + outputRCommits (gitRemoteCommitsToPull repoState) (gitRemoteCommitsToPush repoState) + outputLocalBranchName (gitLocalBranch repoState) (gitCommitShortSHA repoState) + outputCommitsToPullPush (gitCommitsToPull repoState) (gitCommitsToPush repoState) + outputRepoState (gitLocalRepoChanges repoState) + outputStashCount (gitStashCount repoState) + +-- | Requires patched fonts for Powerline (Monaco Powerline) +outputGitRepoIndicator :: ShellOutput +outputGitRepoIndicator = do + liftIO $ do + putChar '\57504' + putChar ' ' + +outputUpstreamAbsence :: String -> ShellOutput +outputUpstreamAbsence remoteTrackingBranch = + when (remoteTrackingBranch == "") $ do + liftIO . putStr $ "upstream " + showStrInColor Red Vivid "\9889" + liftIO . putChar $ ' ' + +outputLocalBranchName :: String -- ^ the local branch name + -> String -- ^ the HEAD commit short sha + -> ShellOutput +outputLocalBranchName localBranchName commitSHA = do + if (localBranchName /= "") + then liftIO $ do + putStr "[" + mapM_ putStr (lines localBranchName) + putStr "]" + putStr " " + else do + liftIO . putStr $ "[" + showStrInColor Yellow Vivid "detached@" + showStrInColor Yellow Vivid commitSHA + liftIO . putStr $ "]" + liftIO . putStr $ " " + +outputcommitsToPush :: Int + -> ShellOutput +outputcommitsToPush commitCount = do + when (commitCount > 0) $ do + liftIO . putStr . show $ commitCount + showStrInColor Green Vivid "\8593" + +outputcommitsToPull :: Int + -> ShellOutput +outputcommitsToPull commitCount = do + when (commitCount > 0) $ do + liftIO . putStr . show $ commitCount + showStrInColor Red Vivid "\8595" + +outputRCommits :: Int -- ^ commits to pull + -> Int -- ^ commits to push + -> ShellOutput +outputRCommits pull push = do + if (pull > 0) && (push > 0) + then do + liftIO . putStr $ "\120366 " + liftIO . putStr . show $ pull + showStrInColor Green Vivid "\8644" + liftIO . putStr . show $ push + else ( + if (pull > 0) + then do + liftIO . putStr $ "\120366 " + showStrInColor Green Vivid "\8594" + liftIO . putStr $ " " + liftIO . putStr . show $ pull + else ( + when (push > 0) $ do + liftIO . putStr $ "\120366 " + showStrInColor Green Vivid "\8592" + liftIO . putStr $ " " + liftIO . putStr . show $ push + ) + ) + + when ((pull > 0) || (push > 0)) . liftIO . putStr $ " " + +outputCommitsToPullPush :: Int -- ^ commits to pull + -> Int -- ^ commits to push + -> ShellOutput +outputCommitsToPullPush pull push = do + if (pull > 0) && (push > 0) + then do + liftIO . putStr . show $ pull + showStrInColor Green Vivid "\8645" + liftIO . putStr . show $ push + else + if (pull > 0) + then outputcommitsToPull pull + else + when (push > 0) $ outputcommitsToPush push + + when ((pull > 0) || (push > 0)) . liftIO . putStr $ " " + +outputStashCount :: Int + -> ShellOutput +outputStashCount stashCount = do + when (stashCount /= 0) $ do + liftIO . putStr . show $ stashCount + showStrInColor Green Vivid "≡ " + +outputRepoState :: GitLocalRepoChanges + -> ShellOutput +outputRepoState repoState = do + showElem indexAdd repoState Green Vivid "A" + showElem indexDel repoState Green Vivid "D" + showElem indexMod repoState Green Vivid "M" + showElem renamed repoState Green Vivid "R" + when ((indexAdd repoState > 0) || (indexDel repoState > 0) || (indexMod repoState > 0) || (renamed repoState > 0)) . liftIO . putStr $ " " + + showElem localDel repoState Red Vivid "D" + showElem localMod repoState Red Vivid "M" + when ((localDel repoState > 0) || (localMod repoState > 0)) . liftIO . putStr $ " " + + showElem localAdd repoState White Vivid "A" + when (localAdd repoState > 0) . liftIO . putStr $ " " + + showElem conflict repoState Green Vivid "C" + when (conflict repoState > 0) . liftIO . putStr $ " " + +showElem :: (GitLocalRepoChanges -> Int) + -> GitLocalRepoChanges + -> Color + -> ColorIntensity + -> String + -> ShellOutput +showElem elemFunc repoState color intensity letter = do + let num = elemFunc repoState + when (num > 0) $ showNumState num color intensity letter + +showNumState :: Int + -> Color + -> ColorIntensity + -> String + -> ShellOutput +showNumState num color intensity letter = do + liftIO . putStr . show $ num + showStrInColor color intensity letter diff --git a/src/GitHUD/Git/Command.hs b/src/GitHUD/Git/Command.hs new file mode 100644 --- /dev/null +++ b/src/GitHUD/Git/Command.hs @@ -0,0 +1,83 @@ +module GitHUD.Git.Command ( + gitCmdLocalBranchName + , gitCmdRemoteName + , gitCmdRemoteBranchName + , gitCmdPorcelainStatus + , gitCmdRevToPush + , gitCmdRevToPull + , gitCmdStashCount + , gitCmdCommitShortSHA + , checkInGitDirectory + ) where + +import Control.Concurrent.MVar (MVar, putMVar) +import System.Process (readProcessWithExitCode, proc, StdStream(CreatePipe, UseHandle), createProcess, CreateProcess(..)) +import GHC.IO.Handle (hGetLine) +import System.Exit (ExitCode(ExitSuccess)) + +import GitHUD.Process (readProcessWithIgnoreExitCode) +import GitHUD.Git.Common + +checkInGitDirectory :: IO Bool +checkInGitDirectory = do + (exCode, _, _) <- readProcessWithExitCode "git" ["rev-parse", "--git-dir"] "" + return (exCode == ExitSuccess) + +gitCmdLocalBranchName :: MVar String -> IO () +gitCmdLocalBranchName out = do + localBranch <- readProcessWithIgnoreExitCode "git" ["symbolic-ref", "--short", "HEAD"] "" + putMVar out localBranch + +gitCmdRemoteName :: String -- ^ local branch name + -> MVar String -- ^ the output mvar + -> IO () +gitCmdRemoteName localBranchName out = do + remoteName <- readProcessWithIgnoreExitCode "git" ["config", "--get", gitRemoteTrackingConfigKey localBranchName] "" + putMVar out remoteName + +gitCmdRemoteBranchName :: String -- ^ remote name + -> MVar String -- ^ The output mvar + -> IO () +gitCmdRemoteBranchName remoteName out = do + remoteBranch <- readProcessWithIgnoreExitCode "git" ["config", "--get", gitRemoteBranchConfigKey remoteName] "" + putMVar out remoteBranch + + +gitCmdPorcelainStatus :: MVar String -> IO () +gitCmdPorcelainStatus out = do + porcelainStatus <- readProcessWithIgnoreExitCode "git" ["status", "--porcelain"] "" + putMVar out porcelainStatus + +gitCmdRevToPush :: String -- ^ from revision + -> String -- ^ to revision + -> MVar String -- ^ The output mvar + -> IO () +gitCmdRevToPush fromCommit toCommit out = do + revToPush <- readProcessWithIgnoreExitCode "git" ["rev-list", "--right-only", "--count", mergeBaseDiffFromTo fromCommit toCommit] "" + putMVar out revToPush + +gitCmdRevToPull :: String -- ^ from revision + -> String -- ^ to revision + -> MVar String -- ^ The output mvar + -> IO () +gitCmdRevToPull fromCommit toCommit out = do + revToPull <- readProcessWithIgnoreExitCode "git" ["rev-list", "--left-only", "--count", mergeBaseDiffFromTo fromCommit toCommit] "" + putMVar out revToPull + +gitCmdStashCount :: MVar String -- ^ The output mvar + -> IO () +gitCmdStashCount out = do + ( _, Just hGitStashList, _, _) <- createProcess + (proc "git" ["stash", "list"]) + { std_out = CreatePipe } + ( _, Just hCountStr, _, _) <- createProcess + (proc "wc" ["-l"]) + { std_in = UseHandle hGitStashList, std_out = CreatePipe } + count <- hGetLine hCountStr + putMVar out count + +gitCmdCommitShortSHA :: MVar String + -> IO () +gitCmdCommitShortSHA out = do + shortSHA <- readProcessWithIgnoreExitCode "git" ["rev-parse", "--short", "HEAD"] "" + putMVar out shortSHA diff --git a/src/GitHUD/Git/Common.hs b/src/GitHUD/Git/Common.hs new file mode 100644 --- /dev/null +++ b/src/GitHUD/Git/Common.hs @@ -0,0 +1,16 @@ +module GitHUD.Git.Common ( + gitRemoteTrackingConfigKey + , gitRemoteBranchConfigKey + , mergeBaseDiffFromTo + ) where + + +gitRemoteTrackingConfigKey :: String -> String +gitRemoteTrackingConfigKey localBranchName = "branch." ++ localBranchName ++ ".remote" + +gitRemoteBranchConfigKey :: String -> String +gitRemoteBranchConfigKey localBranchName = "branch." ++ localBranchName ++ ".merge" + +mergeBaseDiffFromTo :: String -> String -> String +mergeBaseDiffFromTo fromCommit toCommit = fromCommit ++ "..." ++ toCommit + diff --git a/src/GitHUD/Git/Parse/Base.hs b/src/GitHUD/Git/Parse/Base.hs new file mode 100644 --- /dev/null +++ b/src/GitHUD/Git/Parse/Base.hs @@ -0,0 +1,83 @@ +module GitHUD.Git.Parse.Base ( + getGitRepoState + ) where + +import Control.Concurrent (forkIO) +import Control.Concurrent.MVar (newEmptyMVar, takeMVar) + +import GitHUD.Git.Types +import GitHUD.Git.Command +import GitHUD.Git.Parse.Status +import GitHUD.Git.Parse.Branch +import GitHUD.Git.Parse.Count + +removeEndingNewline :: String -> String +removeEndingNewline str = concat . lines $ str + +getGitRepoState :: IO GitRepoState +getGitRepoState = do + -- Preparing MVars + mvLocalBranch <- newEmptyMVar + mvGitStatus <- newEmptyMVar + mvRemoteName <- newEmptyMVar + mvStashCount <- newEmptyMVar + mvCommitShortSHA <- newEmptyMVar + + forkIO $ gitCmdLocalBranchName mvLocalBranch + forkIO $ gitCmdPorcelainStatus mvGitStatus + forkIO $ gitCmdStashCount mvStashCount + forkIO $ gitCmdCommitShortSHA mvCommitShortSHA + + localBranchName <- removeEndingNewline <$> (takeMVar mvLocalBranch) + forkIO $ gitCmdRemoteName localBranchName mvRemoteName + + remoteName <- removeEndingNewline <$> takeMVar mvRemoteName + repoState <- gitParseStatus <$> takeMVar mvGitStatus + stashCountStr <- takeMVar mvStashCount + commitShortSHA <- removeEndingNewline <$> takeMVar mvCommitShortSHA + + fillGitRemoteRepoState zeroGitRepoState { + gitLocalRepoChanges = repoState + , gitRemote = remoteName + , gitLocalBranch = localBranchName + , gitCommitShortSHA = commitShortSHA + , gitStashCount = (getCount stashCountStr) + } + +fillGitRemoteRepoState :: GitRepoState + -> IO GitRepoState +fillGitRemoteRepoState repoState@( GitRepoState { gitRemote = ""} ) = return repoState +fillGitRemoteRepoState repoState = do + mvRemoteBranchName <- newEmptyMVar + mvCommitsToPull <- newEmptyMVar + mvCommitsToPush <- newEmptyMVar + mvRemoteCommitsToPull <- newEmptyMVar + mvRemoteCommitsToPush <- newEmptyMVar + + forkIO $ gitCmdRemoteBranchName (gitLocalBranch repoState) mvRemoteBranchName + remoteBranch <- removeEndingNewline <$> (takeMVar mvRemoteBranchName) + + let fullRemoteBranchName = buildFullyQualifiedRemoteBranchName (gitRemote repoState) remoteBranch + + forkIO $ gitCmdRevToPush "origin/master" fullRemoteBranchName mvRemoteCommitsToPush + forkIO $ gitCmdRevToPull "origin/master" fullRemoteBranchName mvRemoteCommitsToPull + forkIO $ gitCmdRevToPush fullRemoteBranchName "HEAD" mvCommitsToPush + forkIO $ gitCmdRevToPull fullRemoteBranchName "HEAD" mvCommitsToPull + + rCommitsToMergeStr <- takeMVar mvRemoteCommitsToPush + let rCommitsToMerge = getCount rCommitsToMergeStr + rCommitsToRMasterStr <- takeMVar mvRemoteCommitsToPull + let rCommitsToRMaster = getCount rCommitsToRMasterStr + + commitsToPushStr <- takeMVar mvCommitsToPush + let commitsToPush = getCount commitsToPushStr + commitsToPullStr <- takeMVar mvCommitsToPull + let commitsToPull = getCount commitsToPullStr + + return repoState { + gitRemoteTrackingBranch = remoteBranch + , gitCommitsToPull = commitsToPull + , gitCommitsToPush = commitsToPush + , gitRemoteCommitsToPull = rCommitsToRMaster + , gitRemoteCommitsToPush = rCommitsToMerge + } diff --git a/src/GitHUD/Git/Parse/Branch.hs b/src/GitHUD/Git/Parse/Branch.hs new file mode 100644 --- /dev/null +++ b/src/GitHUD/Git/Parse/Branch.hs @@ -0,0 +1,29 @@ +module GitHUD.Git.Parse.Branch ( + buildFullyQualifiedRemoteBranchName + ) where + +import Text.Parsec (parse) +import Text.Parsec.String (Parser) +import Text.Parsec.Char (anyChar, string) +import Text.Parsec.Prim (many) + +buildFullyQualifiedRemoteBranchName :: String -- ^ remote + -> String -- ^ remote Branch Name + -> String +buildFullyQualifiedRemoteBranchName remote branch = + remote ++ "/" ++ (simpleRemoteBranchName branch) + +simpleRemoteBranchName :: String + -> String +simpleRemoteBranchName branch = + either + (const "") + id + (parse remoteBranchParser "" branch) + +remoteBranchParser :: Parser String +remoteBranchParser = do + string "refs/heads/" + many anyChar + + diff --git a/src/GitHUD/Git/Parse/Count.hs b/src/GitHUD/Git/Parse/Count.hs new file mode 100644 --- /dev/null +++ b/src/GitHUD/Git/Parse/Count.hs @@ -0,0 +1,23 @@ +module GitHUD.Git.Parse.Count ( + getCount + ) where + +import Text.Parsec (parse) +import Text.Parsec.String (Parser) +import Text.Parsec.Char (anyChar) +import Text.Parsec.Prim (many) + +getCount :: String -> Int +getCount numberString = + either + (const 0) + id + (parse countParser "" numberString) + +countParser :: Parser Int +countParser = do + number <- many anyChar + if null number + then return 0 + else return (read number) + diff --git a/src/GitHUD/Git/Parse/Status.hs b/src/GitHUD/Git/Parse/Status.hs new file mode 100644 --- /dev/null +++ b/src/GitHUD/Git/Parse/Status.hs @@ -0,0 +1,149 @@ +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 (Show) + +-- | In case of error, return zeroRepoState, i.e. no changes +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 + -- Fallthrough to skip the lines indicating local modifications + , skipLine + ] "local file state" + many $ noneOf "\n" + return state + +localFileState :: Parser GitFileState +localFileState = do + state <- choice [ + localModState + , localAddState + , localDelState + -- Fallthrough to skip the lines indicating index modifications + , skipLine + ] "local file state" + many $ noneOf "\n" + return 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 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 diff --git a/src/GitHUD/Git/Types.hs b/src/GitHUD/Git/Types.hs new file mode 100644 --- /dev/null +++ b/src/GitHUD/Git/Types.hs @@ -0,0 +1,71 @@ +module GitHUD.Git.Types ( + GitLocalRepoChanges(..) + , zeroLocalRepoChanges + , GitRepoState(..) + , zeroGitRepoState + , mergeGitLocalRepoChanges + ) where + +data GitLocalRepoChanges = GitLocalRepoChanges { localMod :: Int + , localAdd :: Int + , localDel :: Int + , indexMod :: Int + , indexAdd :: Int + , indexDel :: Int + , renamed :: Int + , conflict :: Int + } deriving (Show, Eq) + +zeroLocalRepoChanges :: GitLocalRepoChanges +zeroLocalRepoChanges = GitLocalRepoChanges { localMod = 0 + , localAdd = 0 + , localDel = 0 + , indexMod = 0 + , indexAdd = 0 + , indexDel = 0 + , renamed = 0 + , conflict = 0 + } + +mergeGitLocalRepoChanges :: GitLocalRepoChanges -> GitLocalRepoChanges -> GitLocalRepoChanges +mergeGitLocalRepoChanges a b = + GitLocalRepoChanges { + localMod = (localMod a) + (localMod b) + , localAdd = (localAdd a) + (localAdd b) + , localDel = (localDel a) + (localDel b) + , indexMod = (indexMod a) + (indexMod b) + , indexAdd = (indexAdd a) + (indexAdd b) + , indexDel = (indexDel a) + (indexDel b) + , renamed = (renamed a) + (renamed b) + , conflict = (conflict a) + (conflict b) + } + +data GitRepoState = + GitRepoState { + gitLocalRepoChanges :: GitLocalRepoChanges + , gitLocalBranch :: String + , gitCommitShortSHA :: String + , gitRemote :: String + , gitRemoteTrackingBranch :: String + , gitStashCount :: Int + , gitCommitsToPull :: Int + , gitCommitsToPush :: Int + , gitRemoteCommitsToPull :: Int + , gitRemoteCommitsToPush :: Int + } + deriving (Eq, Show) + +zeroGitRepoState :: GitRepoState +zeroGitRepoState = + GitRepoState { + gitLocalRepoChanges = zeroLocalRepoChanges + , gitLocalBranch = "" + , gitCommitShortSHA = "" + , gitRemote = "" + , gitRemoteTrackingBranch = "" + , gitStashCount = 0 + , gitCommitsToPull = 0 + , gitCommitsToPush = 0 + , gitRemoteCommitsToPull = 0 + , gitRemoteCommitsToPush = 0 + } diff --git a/src/GitHUD/Process.hs b/src/GitHUD/Process.hs new file mode 100644 --- /dev/null +++ b/src/GitHUD/Process.hs @@ -0,0 +1,14 @@ +module GitHUD.Process ( + readProcessWithIgnoreExitCode + ) where + +import System.Process (readProcessWithExitCode) +import System.Exit (ExitCode(ExitSuccess)) + +readProcessWithIgnoreExitCode :: FilePath -> [String] -> String -> IO String +readProcessWithIgnoreExitCode command options stdin = do + (exCode, stdout, _) <- readProcessWithExitCode command options stdin + if (exCode == ExitSuccess) + then return stdout + else return "" + diff --git a/src/GitHUD/Terminal/Base.hs b/src/GitHUD/Terminal/Base.hs new file mode 100644 --- /dev/null +++ b/src/GitHUD/Terminal/Base.hs @@ -0,0 +1,58 @@ +module GitHUD.Terminal.Base ( + showStrInColor + ) where + +import Control.Monad.Reader + +import GitHUD.Terminal.Types + +showStrInColor :: Color -- ^ The terminal color to use + -> ColorIntensity -- ^ The intensity to use + -> String -- ^ The string to output + -> ShellOutput +showStrInColor color intensity str = do + shell <- ask + liftIO $ outputStrInColor color intensity str shell + +outputStrInColor :: Color + -> ColorIntensity + -> String + -> Shell + -> IO() +outputStrInColor color intensity str shell = do + let startCode = terminalStartCode color intensity + if (shell == ZSH) + then putStr $ zshMarkZeroWidth startCode + else putStr $ startCode + + putStr str + if (shell == ZSH) + then putStr $ zshMarkZeroWidth terminalEndCode + else putStr $ terminalEndCode + +zshMarkZeroWidth :: String + -> String +zshMarkZeroWidth str = "%{" `mappend` str `mappend` "%}" + +terminalStartCode :: Color + -> ColorIntensity + -> String +terminalStartCode Black Vivid = "\x1b[1;30m" +terminalStartCode Red Vivid = "\x1b[1;31m" +terminalStartCode Green Vivid = "\x1b[1;32m" +terminalStartCode Yellow Vivid = "\x1b[1;33m" +terminalStartCode Blue Vivid = "\x1b[1;34m" +terminalStartCode Magenta Vivid = "\x1b[1;35m" +terminalStartCode Cyan Vivid = "\x1b[1;36m" +terminalStartCode White Vivid = "\x1b[1;37m" +terminalStartCode Black Dull = "\x1b[30m" +terminalStartCode Red Dull = "\x1b[31m" +terminalStartCode Green Dull = "\x1b[32m" +terminalStartCode Yellow Dull = "\x1b[33m" +terminalStartCode Blue Dull = "\x1b[34m" +terminalStartCode Magenta Dull = "\x1b[35m" +terminalStartCode Cyan Dull = "\x1b[36m" +terminalStartCode White Dull = "\x1b[37m" + +terminalEndCode :: String +terminalEndCode = "\x1b[0m" diff --git a/src/GitHUD/Terminal/Types.hs b/src/GitHUD/Terminal/Types.hs new file mode 100644 --- /dev/null +++ b/src/GitHUD/Terminal/Types.hs @@ -0,0 +1,14 @@ +module GitHUD.Terminal.Types ( + Color(..) + , ColorIntensity(..) + , Shell(..) + , ShellOutput(..) + ) where + +import Control.Monad.Reader + +data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White +data ColorIntensity = Dull | Vivid +data Shell = ZSH | Other deriving (Eq) +type ShellOutput = ReaderT Shell IO () + diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,49 @@ +import Test.Tasty +-- import Test.Tasty.SmallCheck as SC +-- import Test.Tasty.QuickCheck as QC + +import Test.GitHUD.Git.Parse.Status +import Test.GitHUD.Git.Parse.Branch + +main :: IO () +main = defaultMain tests + +tests :: TestTree +tests = testGroup "Tests" [statusTests, branchTests] +-- +-- tests :: TestTree +-- tests = testGroup "Tests" [properties, unitTests] +-- +-- properties :: TestTree +-- properties = testGroup "Properties" [scProps, qcProps] +-- +-- scProps = testGroup "(checked by SmallCheck)" +-- [ SC.testProperty "sort == sort . reverse" $ +-- \list -> sort (list :: [Int]) == sort (reverse list) +-- , SC.testProperty "Fermat's little theorem" $ +-- \x -> ((x :: Integer)^7 - x) `mod` 7 == 0 +-- -- the following property does not hold +-- , SC.testProperty "Fermat's last theorem" $ +-- \x y z n -> +-- (n :: Integer) >= 3 SC.==> x^n + y^n /= (z^n :: Integer) +-- ] +-- +-- qcProps = testGroup "(checked by QuickCheck)" +-- [ QC.testProperty "sort == sort . reverse" $ +-- \list -> sort (list :: [Int]) == sort (reverse list) +-- , QC.testProperty "Fermat's little theorem" $ +-- \x -> ((x :: Integer)^7 - x) `mod` 7 == 0 +-- -- the following property does not hold +-- , QC.testProperty "Fermat's last theorem" $ +-- \x y z n -> +-- (n :: Integer) >= 3 QC.==> x^n + y^n /= (z^n :: Integer) +-- ] +-- +-- unitTests = testGroup "Unit tests" +-- [ testCase "List comparison (different length)" $ +-- [1, 2, 3] `compare` [1,2] @?= GT +-- +-- -- the following test does not hold +-- , testCase "List comparison (same length)" $ +-- [1, 2, 3] `compare` [1,2,2] @?= LT +-- ] diff --git a/test/Test/GitHUD/Git/Parse/Branch.hs b/test/Test/GitHUD/Git/Parse/Branch.hs new file mode 100644 --- /dev/null +++ b/test/Test/GitHUD/Git/Parse/Branch.hs @@ -0,0 +1,15 @@ +module Test.GitHUD.Git.Parse.Branch ( + branchTests + ) where + +import Test.Tasty +import Test.Tasty.HUnit + +import GitHUD.Git.Parse.Branch + +branchTests :: TestTree +branchTests = testGroup "Branch Parser Test" + [ testCase "remote branch name" $ + buildFullyQualifiedRemoteBranchName "bar" "refs/heads/foo" + @?= "bar/foo" + ] diff --git a/test/Test/GitHUD/Git/Parse/Status.hs b/test/Test/GitHUD/Git/Parse/Status.hs new file mode 100644 --- /dev/null +++ b/test/Test/GitHUD/Git/Parse/Status.hs @@ -0,0 +1,82 @@ +module Test.GitHUD.Git.Parse.Status ( + statusTests + ) where + +import Test.Tasty +import Test.Tasty.HUnit + +import GitHUD.Git.Parse.Status +import GitHUD.Git.Types + +statusTests :: TestTree +statusTests = testGroup "Status Parser Test" + [ testCase "with an empty input, should return 0 for all categories" $ + gitParseStatus "" @?= zeroLocalRepoChanges + + , testCase "with one locally modified file" $ + gitParseStatus " M some random foo bar stuff\n" @?= (zeroLocalRepoChanges { localMod = 1 }) + + , testCase "with one locally deleted file" $ + gitParseStatus " D some random foo bar stuff\n" @?= (zeroLocalRepoChanges { localDel = 1 }) + + , testCase "with one locally added file" $ + gitParseStatus "?? some random foo bar stuff\n" @?= (zeroLocalRepoChanges { localAdd = 1 }) + + , testCase "with one added file to the index" $ + gitParseStatus "A some random foo bar stuff\n" @?= (zeroLocalRepoChanges { indexAdd = 1 }) + + , testCase "with one modified file to the index" $ + gitParseStatus "M some random foo bar stuff\n" @?= (zeroLocalRepoChanges { indexMod = 1 }) + + , testCase "with one added file to the index" $ + gitParseStatus "D some random foo bar stuff\n" @?= (zeroLocalRepoChanges { indexDel = 1 }) + + , testCase "with a conflict with both sides changed" $ + gitParseStatus "UU test\n" @?= (zeroLocalRepoChanges { conflict = 1 }) + + , testCase "with a conflict with us side changed" $ + gitParseStatus "DU test\n" @?= (zeroLocalRepoChanges { conflict = 1 }) + + , testCase "with a conflict with them side changed" $ + gitParseStatus "UD test\n" @?= (zeroLocalRepoChanges { conflict = 1 }) + + , testCase "with a complex mix" $ + gitParseStatus + complexStatusString + @?= (zeroLocalRepoChanges { localAdd = 1, localDel = 1, localMod = 1, + indexAdd = 1, indexMod = 1, indexDel = 1, conflict = 3 }) + + , testCase "with a renamed file in the index" $ + gitParseStatus "R test\n" @?= (zeroLocalRepoChanges { renamed = 1 }) + + , testCase "with a file renamed in the index and modified locally" $ + gitParseStatus "RM test\n" @?= (zeroLocalRepoChanges { localMod = 1, renamed = 1 }) + + , testCase "with a file renamed in the index and deleted locally" $ + gitParseStatus "RD test\n" @?= (zeroLocalRepoChanges { localDel = 1, renamed = 1 }) + + , testCase "with a file modified in the index and deleted locally" $ + gitParseStatus "MD test\n" @?= (zeroLocalRepoChanges { localDel = 1, indexMod = 1 }) + + , testCase "with a file changed in the index AND locally" $ + gitParseStatus "MM test\n" @?= (zeroLocalRepoChanges { localMod = 1, indexMod = 1 }) + + , testCase "with a file added in the index AND modified locally" $ + gitParseStatus "AM test\n" @?= (zeroLocalRepoChanges { localMod = 1, indexAdd = 1 }) + + , testCase "with a file added in the index AND deleted locally" $ + gitParseStatus "AD test\n" @?= (zeroLocalRepoChanges { localDel = 1, indexAdd = 1 }) + + ] + +complexStatusString :: String +complexStatusString = + " M foo\n\ + \ D bar\n\ + \?? add\n\ + \A add\n\ + \M mod\n\ + \D del\n\ + \UU conflict\n\ + \DU conflict\n\ + \UD conflict\n"