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,74 @@ +name: githud +version: 2.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: gregory.bataille@gmail.com +copyright: Grégory Bataille 2015-2016 +category: Development +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: GitHUD + , GitHUD.Config.Parse + , GitHUD.Config.Types + , 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.Process + , GitHUD.Terminal.Base + , GitHUD.Terminal.Prompt + , GitHUD.Terminal.Types + , GitHUD.Types + build-depends: base >= 4.7 && < 5 + , process + , parsec >= 3.1.9 && < 4 + , mtl >= 2.2.1 && < 3 + , text >= 1.2 && < 1.3 + , unix >= 2.7 && < 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 + , parsec >= 3.1.9 && < 4 + , mtl >= 2.2.1 && < 3 + , githud + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + Other-modules: Test.GitHUD.Git.Parse.Status + , Test.GitHUD.Git.Parse.Branch + , Test.GitHUD.Git.Common + , Test.GitHUD.Git.Types + , Test.GitHUD.Terminal.Base + , Test.GitHUD.Terminal.Prompt + , Test.GitHUD.Config.Parse + 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,54 @@ +{-# LANGUAGE OverloadedStrings #-} + +module GitHUD ( + githud + ) where + +import Control.Monad (when) +import Control.Monad.Reader (runReader) +import Data.Text +import System.Environment (getArgs) +import System.Posix.Files (fileExist) +import System.Posix.User (getRealUserID, getUserEntryForID, UserEntry(..)) + +import GitHUD.Config.Parse +import GitHUD.Config.Types +import GitHUD.Terminal.Prompt +import GitHUD.Terminal.Types +import GitHUD.Git.Parse.Base +import GitHUD.Git.Command +import GitHUD.Types + +githud :: IO () +githud = do + -- Exit ASAP if we are not in a git repository + isGit <- checkInGitDirectory + when isGit $ do + shell <- processArguments getArgs + config <- getAppConfig + repoState <- getGitRepoState + let prompt = runReader buildPromptWithConfig $ buildOutputConfig shell repoState config + + -- Necessary to use putStrLn to properly terminate the output (needs the CR) + putStrLn $ unpack (strip (pack prompt)) + +processArguments :: IO [String] + -> IO Shell +processArguments args = do + arguments <- args + return $ getShell arguments + +getShell :: [String] + -> Shell +getShell ("zsh":_) = ZSH +getShell ("bash":_) = BASH +getShell _ = Other + +getAppConfig :: IO Config +getAppConfig = do + userEntry <- getRealUserID >>= getUserEntryForID + let configFilePath = (homeDirectory userEntry) ++ "/.githudrc" + configFilePresent <- fileExist configFilePath + if configFilePresent + then parseConfigFile configFilePath + else return defaultConfig diff --git a/src/GitHUD/Config/Parse.hs b/src/GitHUD/Config/Parse.hs new file mode 100644 --- /dev/null +++ b/src/GitHUD/Config/Parse.hs @@ -0,0 +1,289 @@ +module GitHUD.Config.Parse ( + parseConfigFile + , commentParser + , itemParser + , fallThroughItemParser + , configItemsFolder + , ConfigItem(..) + , colorConfigToColor + , intensityConfigToIntensity + , stringConfigToStringList + ) where + +import Control.Monad (void, when) +import Text.Parsec (parse) +import Text.Parsec.Char (anyChar, char, newline, noneOf, letter, spaces, string) +import Text.Parsec.Combinator (choice, eof, many1, manyTill, optional, sepBy) +import Text.Parsec.Prim (many, try, unexpected, (<|>), ()) +import Text.Parsec.String (parseFromFile, Parser) + +import GitHUD.Config.Types +import GitHUD.Terminal.Types + +data ConfigItem = Item String String + | Comment + | ErrorLine deriving (Eq, Show) + +parseConfigFile :: FilePath -> IO Config +parseConfigFile filePath = do + eitherParsed <- parseFromFile configFileParser filePath + return $ either + (const defaultConfig) + id + eitherParsed + +configFileParser :: Parser Config +configFileParser = do + items <- many configItemParser + return $ foldl configItemsFolder defaultConfig items + +configItemParser :: Parser ConfigItem +configItemParser = choice [ + commentParser + , itemParser + , fallThroughItemParser + ] "config file line" + +endItem :: Parser () +endItem = choice [ + void newline + , eof + ] "end of item" + +commentParser :: Parser ConfigItem +commentParser = try $ do + char '#' + manyTill anyChar (try endItem) + return Comment + +itemParser :: Parser ConfigItem +itemParser = try $ do + key <- manyTill validKeyChar (char '=') + when (key == "") $ unexpected "A key in the config file should not be empty" + value <- manyTill anyChar (try endItem) + return $ Item key value + +validKeyChar :: Parser Char +validKeyChar = letter <|> (char '_') + +-- | Must not be able to process an empty string +-- This is mandated by the use of 'many' in configFileParser +-- Therefore the definition `manyTill anyChar eof` is invalid, thus using newline +fallThroughItemParser :: Parser ConfigItem +fallThroughItemParser = do + manyTill anyChar (try newline) + return ErrorLine + +configItemsFolder :: Config -> ConfigItem -> Config +configItemsFolder conf (Item "show_part_repo_indicator" value) = + conf { confShowPartRepoIndicator = boolConfigToIntensity value } +configItemsFolder conf (Item "show_part_merge_branch_commits_diff" value) = + conf { confShowPartMergeBranchCommitsDiff = boolConfigToIntensity value } +configItemsFolder conf (Item "show_part_local_branch" value) = + conf { confShowPartLocalBranch = boolConfigToIntensity value } +configItemsFolder conf (Item "show_part_commits_to_origin" value) = + conf { confShowPartCommitsToOrigin = boolConfigToIntensity value } +configItemsFolder conf (Item "show_part_local_changes_state" value) = + conf { confShowPartLocalChangesState = boolConfigToIntensity value } +configItemsFolder conf (Item "show_part_stashes" value) = + conf { confShowPartStashes = boolConfigToIntensity value } + +configItemsFolder conf (Item "git_repo_indicator" repoIndicator) = conf { confRepoIndicator = repoIndicator } + +configItemsFolder conf (Item "no_tracked_upstream_text" value) = + conf { confNoTrackedUpstreamString = value } +configItemsFolder conf (Item "no_tracked_upstream_text_color" value) = + conf { confNoTrackedUpstreamStringColor = colorConfigToColor value } +configItemsFolder conf (Item "no_tracked_upstream_text_intensity" value) = + conf { confNoTrackedUpstreamStringIntensity = intensityConfigToIntensity value } +configItemsFolder conf (Item "no_tracked_upstream_indicator" value) = + conf { confNoTrackedUpstreamIndicator = value } +configItemsFolder conf (Item "no_tracked_upstream_indicator_color" value) = + conf { confNoTrackedUpstreamIndicatorColor = colorConfigToColor value } +configItemsFolder conf (Item "no_tracked_upstream_indicator_intensity" value) = + conf { confNoTrackedUpstreamIndicatorIntensity = intensityConfigToIntensity value } + +configItemsFolder conf (Item "merge_branch_commits_indicator" value) = + conf { confMergeBranchCommitsIndicator = value } +configItemsFolder conf (Item "merge_branch_commits_pull_prefix" value) = + conf { confMergeBranchCommitsOnlyPull = value } +configItemsFolder conf (Item "merge_branch_commits_push_prefix" value) = + conf { confMergeBranchCommitsOnlyPush = value } +configItemsFolder conf (Item "merge_branch_commits_push_pull_infix" value) = + conf { confMergeBranchCommitsBothPullPush = value } +configItemsFolder conf (Item "merge_branch_ignore_branches" value) = + conf { confMergeBranchIgnoreBranches = stringConfigToStringList value } + +configItemsFolder conf (Item "local_branch_prefix" value) = + conf { confLocalBranchNamePrefix = value } +configItemsFolder conf (Item "local_branch_suffix" value) = + conf { confLocalBranchNameSuffix = value } +configItemsFolder conf (Item "local_branch_color" value) = + conf { confLocalBranchColor = colorConfigToColor value } +configItemsFolder conf (Item "local_branch_intensity" value) = + conf { confLocalBranchIntensity = intensityConfigToIntensity value } +configItemsFolder conf (Item "local_detached_prefix" value) = + conf { confLocalDetachedPrefix = value } +configItemsFolder conf (Item "local_detached_color" value) = + conf { confLocalDetachedColor = colorConfigToColor value } +configItemsFolder conf (Item "local_detached_intensity" value) = + conf { confLocalDetachedIntensity = intensityConfigToIntensity value } + +configItemsFolder conf (Item "local_commits_push_suffix" value) = + conf { confLocalCommitsPushSuffix = value } +configItemsFolder conf (Item "local_commits_push_suffix_color" value) = + conf { confLocalCommitsPushSuffixColor = colorConfigToColor value } +configItemsFolder conf (Item "local_commits_push_suffix_intensity" value) = + conf { confLocalCommitsPushSuffixIntensity = intensityConfigToIntensity value } +configItemsFolder conf (Item "local_commits_pull_suffix" value) = + conf { confLocalCommitsPullSuffix = value } +configItemsFolder conf (Item "local_commits_pull_suffix_color" value) = + conf { confLocalCommitsPullSuffixColor = colorConfigToColor value } +configItemsFolder conf (Item "local_commits_pull_suffix_intensity" value) = + conf { confLocalCommitsPullSuffixIntensity = intensityConfigToIntensity value } +configItemsFolder conf (Item "local_commits_push_pull_infix" value) = + conf { confLocalCommitsPushPullInfix = value } +configItemsFolder conf (Item "local_commits_push_pull_infix_color" value) = + conf { confLocalCommitsPushPullInfixColor = colorConfigToColor value } +configItemsFolder conf (Item "local_commits_push_pull_infix_intensity" value) = + conf { confLocalCommitsPushPullInfixIntensity = intensityConfigToIntensity value } + +configItemsFolder conf (Item "change_index_add_suffix" value) = + conf { confChangeIndexAddSuffix = value } +configItemsFolder conf (Item "change_index_add_suffix_color" value) = + conf { confChangeIndexAddSuffixColor = colorConfigToColor value } +configItemsFolder conf (Item "change_index_add_suffix_intensity" value) = + conf { confChangeIndexAddSuffixIntensity = intensityConfigToIntensity value } +configItemsFolder conf (Item "change_index_mod_suffix" value) = + conf { confChangeIndexModSuffix = value } +configItemsFolder conf (Item "change_index_mod_suffix_color" value) = + conf { confChangeIndexModSuffixColor = colorConfigToColor value } +configItemsFolder conf (Item "change_index_mod_suffix_intensity" value) = + conf { confChangeIndexModSuffixIntensity = intensityConfigToIntensity value } +configItemsFolder conf (Item "change_index_del_suffix" value) = + conf { confChangeIndexDelSuffix = value } +configItemsFolder conf (Item "change_index_del_suffix_color" value) = + conf { confChangeIndexDelSuffixColor = colorConfigToColor value } +configItemsFolder conf (Item "change_index_del_suffix_intensity" value) = + conf { confChangeIndexDelSuffixIntensity = intensityConfigToIntensity value } +configItemsFolder conf (Item "change_local_add_suffix" value) = + conf { confChangeLocalAddSuffix = value } +configItemsFolder conf (Item "change_local_add_suffix_color" value) = + conf { confChangeLocalAddSuffixColor = colorConfigToColor value } +configItemsFolder conf (Item "change_local_add_suffix_intensity" value) = + conf { confChangeLocalAddSuffixIntensity = intensityConfigToIntensity value } +configItemsFolder conf (Item "change_local_mod_suffix" value) = + conf { confChangeLocalModSuffix = value } +configItemsFolder conf (Item "change_local_mod_suffix_color" value) = + conf { confChangeLocalModSuffixColor = colorConfigToColor value } +configItemsFolder conf (Item "change_local_mod_suffix_intensity" value) = + conf { confChangeLocalModSuffixIntensity = intensityConfigToIntensity value } +configItemsFolder conf (Item "change_local_del_suffix" value) = + conf { confChangeLocalDelSuffix = value } +configItemsFolder conf (Item "change_local_del_suffix_color" value) = + conf { confChangeLocalDelSuffixColor = colorConfigToColor value } +configItemsFolder conf (Item "change_local_del_suffix_intensity" value) = + conf { confChangeLocalDelSuffixIntensity = intensityConfigToIntensity value } +configItemsFolder conf (Item "change_renamed_suffix" value) = + conf { confChangeRenamedSuffix = value } +configItemsFolder conf (Item "change_renamed_suffix_color" value) = + conf { confChangeRenamedSuffixColor = colorConfigToColor value } +configItemsFolder conf (Item "change_renamed_suffix_intensity" value) = + conf { confChangeRenamedSuffixIntensity = intensityConfigToIntensity value } +configItemsFolder conf (Item "change_conflicted_suffix" value) = + conf { confChangeConflictedSuffix = value } +configItemsFolder conf (Item "change_conflicted_suffix_color" value) = + conf { confChangeConflictedSuffixColor = colorConfigToColor value } +configItemsFolder conf (Item "change_conflicted_suffix_intensity" value) = + conf { confChangeConflictedSuffixIntensity = intensityConfigToIntensity value } + +configItemsFolder conf (Item "stash_suffix" value) = + conf { confStashSuffix = value } +configItemsFolder conf (Item "stash_suffix_color" value) = + conf { confStashSuffixColor = colorConfigToColor value } +configItemsFolder conf (Item "stash_suffix_intensity" value) = + conf { confStashSuffixIntensity = intensityConfigToIntensity value } + +configItemsFolder conf _ = conf + +colorConfigToColor :: String -> Color +colorConfigToColor str = + either + (const NoColor) + id + (parse colorParser "" str) + +colorParser :: Parser Color +colorParser = choice [ + string "Black" >> return Black + , string "Red" >> return Red + , string "Green" >> return Green + , string "Yellow" >> return Yellow + , string "Blue" >> return Blue + , string "Magenta" >> return Magenta + , string "Cyan" >> return Cyan + , string "White" >> return White + , string "NoColor" >> return NoColor + ] "color" + +intensityConfigToIntensity :: String -> ColorIntensity +intensityConfigToIntensity str = + either + (const Vivid) + id + (parse intensityParser "" str) + +intensityParser :: Parser ColorIntensity +intensityParser = choice [ + string "Dull" >> return Dull + , string "Vivid" >> return Vivid + ] "intensity" + +boolConfigToIntensity :: String -> Bool +boolConfigToIntensity str = + either + (const True) + id + (parse boolParser "" str) + +stringConfigToStringList :: String -> [String] +stringConfigToStringList str = + either + (const []) + id + (parse stringListParser "" str) + +stringListParser :: Parser [String] +stringListParser = do + branchNameList <- sepBy stripedBranchName (char ',') + return $ filter noEmptyStringFilter branchNameList + +noEmptyStringFilter :: String -> Bool +noEmptyStringFilter str = not (str == "") + +stripedBranchName :: Parser String +stripedBranchName = do + spaces + branchName <- many (noneOf [',', ' ']) + spaces + return branchName + +boolParser :: Parser Bool +boolParser = choice [ + string "False" >> return False + , string "F" >> return False + , string "false" >> return False + , string "f" >> return False + , string "No" >> return False + , string "N" >> return False + , string "no" >> return False + , string "n" >> return False + , string "True" >> return True + , string "T" >> return True + , string "true" >> return True + , string "t" >> return True + , string "Yes" >> return True + , string "Y" >> return True + , string "yes" >> return True + , string "y" >> return True + ] "bool" diff --git a/src/GitHUD/Config/Types.hs b/src/GitHUD/Config/Types.hs new file mode 100644 --- /dev/null +++ b/src/GitHUD/Config/Types.hs @@ -0,0 +1,149 @@ +module GitHUD.Config.Types ( + Config(..) + , defaultConfig + ) where + +import GitHUD.Terminal.Types + +data Config = Config { + confShowPartRepoIndicator :: Bool + , confShowPartMergeBranchCommitsDiff :: Bool + , confShowPartLocalBranch :: Bool + , confShowPartCommitsToOrigin :: Bool + , confShowPartLocalChangesState :: Bool + , confShowPartStashes :: Bool + + , confRepoIndicator :: String + + , confNoTrackedUpstreamString :: String + , confNoTrackedUpstreamStringColor :: Color + , confNoTrackedUpstreamStringIntensity :: ColorIntensity + , confNoTrackedUpstreamIndicator :: String + , confNoTrackedUpstreamIndicatorColor :: Color + , confNoTrackedUpstreamIndicatorIntensity :: ColorIntensity + + , confMergeBranchCommitsIndicator :: String + , confMergeBranchCommitsOnlyPush :: String + , confMergeBranchCommitsOnlyPull :: String + , confMergeBranchCommitsBothPullPush :: String + , confMergeBranchIgnoreBranches :: [String] + + , confLocalBranchNamePrefix :: String + , confLocalBranchNameSuffix :: String + , confLocalDetachedPrefix :: String + , confLocalBranchColor :: Color + , confLocalBranchIntensity :: ColorIntensity + , confLocalDetachedColor :: Color + , confLocalDetachedIntensity :: ColorIntensity + + , confLocalCommitsPushSuffix :: String + , confLocalCommitsPushSuffixColor :: Color + , confLocalCommitsPushSuffixIntensity :: ColorIntensity + , confLocalCommitsPullSuffix :: String + , confLocalCommitsPullSuffixColor :: Color + , confLocalCommitsPullSuffixIntensity :: ColorIntensity + , confLocalCommitsPushPullInfix :: String + , confLocalCommitsPushPullInfixColor :: Color + , confLocalCommitsPushPullInfixIntensity :: ColorIntensity + + , confChangeIndexAddSuffix :: String + , confChangeIndexAddSuffixColor :: Color + , confChangeIndexAddSuffixIntensity :: ColorIntensity + , confChangeIndexModSuffix :: String + , confChangeIndexModSuffixColor :: Color + , confChangeIndexModSuffixIntensity :: ColorIntensity + , confChangeIndexDelSuffix :: String + , confChangeIndexDelSuffixColor :: Color + , confChangeIndexDelSuffixIntensity :: ColorIntensity + , confChangeLocalAddSuffix :: String + , confChangeLocalAddSuffixColor :: Color + , confChangeLocalAddSuffixIntensity :: ColorIntensity + , confChangeLocalModSuffix :: String + , confChangeLocalModSuffixColor :: Color + , confChangeLocalModSuffixIntensity :: ColorIntensity + , confChangeLocalDelSuffix :: String + , confChangeLocalDelSuffixColor :: Color + , confChangeLocalDelSuffixIntensity :: ColorIntensity + , confChangeRenamedSuffix :: String + , confChangeRenamedSuffixColor :: Color + , confChangeRenamedSuffixIntensity :: ColorIntensity + , confChangeConflictedSuffix :: String + , confChangeConflictedSuffixColor :: Color + , confChangeConflictedSuffixIntensity :: ColorIntensity + + , confStashSuffix :: String + , confStashSuffixColor :: Color + , confStashSuffixIntensity :: ColorIntensity +} deriving (Eq, Show) + +defaultConfig :: Config +defaultConfig = Config { + confShowPartRepoIndicator = True + , confShowPartMergeBranchCommitsDiff = True + , confShowPartLocalBranch = True + , confShowPartCommitsToOrigin = True + , confShowPartLocalChangesState = True + , confShowPartStashes = True + + , confRepoIndicator = "ᚴ" + + , confNoTrackedUpstreamString = "upstream" + , confNoTrackedUpstreamStringColor = Red + , confNoTrackedUpstreamStringIntensity = Vivid + , confNoTrackedUpstreamIndicator = "\9889" + , confNoTrackedUpstreamIndicatorColor = Red + , confNoTrackedUpstreamIndicatorIntensity = Vivid + + , confMergeBranchCommitsIndicator = "\120366" + , confMergeBranchCommitsOnlyPush = "\8592" + , confMergeBranchCommitsOnlyPull = "\8594" + , confMergeBranchCommitsBothPullPush = "\8644" + , confMergeBranchIgnoreBranches = ["gh-pages"] + + , confLocalBranchNamePrefix = "[" + , confLocalBranchNameSuffix = "]" + , confLocalDetachedPrefix = "detached@" + , confLocalBranchColor = NoColor + , confLocalBranchIntensity = Vivid + , confLocalDetachedColor = Yellow + , confLocalDetachedIntensity = Vivid + + , confLocalCommitsPushSuffix = "\8593" + , confLocalCommitsPushSuffixColor = Green + , confLocalCommitsPushSuffixIntensity = Vivid + , confLocalCommitsPullSuffix = "\8595" + , confLocalCommitsPullSuffixColor = Red + , confLocalCommitsPullSuffixIntensity = Vivid + , confLocalCommitsPushPullInfix = "⥯" + , confLocalCommitsPushPullInfixColor = Green + , confLocalCommitsPushPullInfixIntensity = Vivid + + , confChangeIndexAddSuffix = "A" + , confChangeIndexAddSuffixColor = Green + , confChangeIndexAddSuffixIntensity = Vivid + , confChangeIndexModSuffix = "M" + , confChangeIndexModSuffixColor = Green + , confChangeIndexModSuffixIntensity = Vivid + , confChangeIndexDelSuffix = "D" + , confChangeIndexDelSuffixColor = Green + , confChangeIndexDelSuffixIntensity = Vivid + , confChangeLocalAddSuffix = "A" + , confChangeLocalAddSuffixColor = White + , confChangeLocalAddSuffixIntensity = Vivid + , confChangeLocalModSuffix = "M" + , confChangeLocalModSuffixColor = Red + , confChangeLocalModSuffixIntensity = Vivid + , confChangeLocalDelSuffix = "D" + , confChangeLocalDelSuffixColor = Red + , confChangeLocalDelSuffixIntensity = Vivid + , confChangeRenamedSuffix = "R" + , confChangeRenamedSuffixColor = Green + , confChangeRenamedSuffixIntensity = Vivid + , confChangeConflictedSuffix = "C" + , confChangeConflictedSuffixColor = Green + , confChangeConflictedSuffixIntensity = Vivid + + , confStashSuffix = "≡" + , confStashSuffixColor = Green + , confStashSuffixIntensity = Vivid +} 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,98 @@ +module GitHUD.Git.Command ( + gitCmdLocalBranchName + , gitCmdMergeBase + , gitCmdRemoteName + , gitCmdRemoteBranchName + , gitCmdPorcelainStatus + , gitCmdRevToPush + , gitCmdRevToPull + , gitCmdStashCount + , gitCmdCommitShortSHA + , gitCmdCommitTag + , 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 + +gitCmdMergeBase :: String -- ^ local branch name + -> MVar String -- ^ output Mvar + -> IO () +gitCmdMergeBase localBranchName out = do + mergeBase <- readProcessWithIgnoreExitCode "git" ["merge-base", "origin/master", localBranchName] "" + putMVar out mergeBase + +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", "--no-merges", "--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", "--no-merges", "--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 + +gitCmdCommitTag :: MVar String + -> IO () +gitCmdCommitTag out = do + tag <- readProcessWithIgnoreExitCode "git" ["describe", "--exact-match", "--tags"] "" + putMVar out tag 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,103 @@ +module GitHUD.Git.Parse.Base ( + getGitRepoState + ) where + +import Control.Applicative ((<$>)) +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 + mvCommitTag <- newEmptyMVar + + forkIO $ gitCmdLocalBranchName mvLocalBranch + forkIO $ gitCmdPorcelainStatus mvGitStatus + forkIO $ gitCmdStashCount mvStashCount + forkIO $ gitCmdCommitShortSHA mvCommitShortSHA + forkIO $ gitCmdCommitTag mvCommitTag + + localBranchName <- removeEndingNewline <$> (takeMVar mvLocalBranch) + forkIO $ gitCmdRemoteName localBranchName mvRemoteName + + remoteName <- removeEndingNewline <$> takeMVar mvRemoteName + repoState <- gitParseStatus <$> takeMVar mvGitStatus + stashCountStr <- takeMVar mvStashCount + commitShortSHA <- removeEndingNewline <$> takeMVar mvCommitShortSHA + commitTag <- removeEndingNewline <$> takeMVar mvCommitTag + + fillGitRemoteRepoState zeroGitRepoState { + gitLocalRepoChanges = repoState + , gitRemote = remoteName + , gitLocalBranch = localBranchName + , gitCommitShortSHA = commitShortSHA + , gitCommitTag = commitTag + , gitStashCount = (getCount stashCountStr) + } + +fillGitRemoteRepoState :: GitRepoState + -> IO GitRepoState +fillGitRemoteRepoState repoState@( GitRepoState { gitRemote = ""} ) = return repoState +fillGitRemoteRepoState repoState = do + mvRemoteBranchName <- newEmptyMVar + mvMergeBase <- newEmptyMVar + mvCommitsToPull <- newEmptyMVar + mvCommitsToPush <- newEmptyMVar + + forkIO $ gitCmdRemoteBranchName (gitLocalBranch repoState) mvRemoteBranchName + forkIO $ gitCmdMergeBase (gitLocalBranch repoState) mvMergeBase + remoteBranch <- removeEndingNewline <$> (takeMVar mvRemoteBranchName) + mergeBase <- removeEndingNewline <$> (takeMVar mvMergeBase) + + let fullRemoteBranchName = buildFullyQualifiedRemoteBranchName (gitRemote repoState) remoteBranch + + -- TODO: gbataille - Check for merge-base. If none, don't execute remote part + forkIO $ gitCmdRevToPush fullRemoteBranchName "HEAD" mvCommitsToPush + forkIO $ gitCmdRevToPull fullRemoteBranchName "HEAD" mvCommitsToPull + + (mergeBranchToPull, mergeBranchToPush) <- getRemoteMasterMergeState mergeBase fullRemoteBranchName + + commitsToPushStr <- takeMVar mvCommitsToPush + let commitsToPush = getCount commitsToPushStr + commitsToPullStr <- takeMVar mvCommitsToPull + let commitsToPull = getCount commitsToPullStr + + return repoState { + gitRemoteTrackingBranch = remoteBranch + , gitCommitsToPull = commitsToPull + , gitCommitsToPush = commitsToPush + , gitMergeBranchCommitsToPull = mergeBranchToPull + , gitMergeBranchCommitsToPush = mergeBranchToPush + } + +getRemoteMasterMergeState :: String -- ^ the merge base + -> String -- ^ the fully qualified remote branch name + -> IO (Int, Int) -- ^ tuple containing (to pull, to push) +getRemoteMasterMergeState "" _ = return (0, 0) +getRemoteMasterMergeState _ fullRemoteBranchName = do + mvMergeBranchCommitsToPull <- newEmptyMVar + mvMergeBranchCommitsToPush <- newEmptyMVar + + forkIO $ gitCmdRevToPush "origin/master" fullRemoteBranchName mvMergeBranchCommitsToPush + forkIO $ gitCmdRevToPull "origin/master" fullRemoteBranchName mvMergeBranchCommitsToPull + + mergeBranchCommitsToRMasterStr <- takeMVar mvMergeBranchCommitsToPull + let mergeBranchCommitsToRMaster = getCount mergeBranchCommitsToRMasterStr + mergeBranchCommitsToMergeStr <- takeMVar mvMergeBranchCommitsToPush + let mergeBranchCommitsToMerge = getCount mergeBranchCommitsToMergeStr + + return (mergeBranchCommitsToRMaster, mergeBranchCommitsToMerge) 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,73 @@ +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 + , gitCommitTag :: String + , gitRemote :: String + , gitRemoteTrackingBranch :: String + , gitStashCount :: Int + , gitCommitsToPull :: Int + , gitCommitsToPush :: Int + , gitMergeBranchCommitsToPull :: Int + , gitMergeBranchCommitsToPush :: Int + } + deriving (Eq, Show) + +zeroGitRepoState :: GitRepoState +zeroGitRepoState = + GitRepoState { + gitLocalRepoChanges = zeroLocalRepoChanges + , gitLocalBranch = "" + , gitCommitShortSHA = "" + , gitCommitTag = "" + , gitRemote = "" + , gitRemoteTrackingBranch = "" + , gitStashCount = 0 + , gitCommitsToPull = 0 + , gitCommitsToPush = 0 + , gitMergeBranchCommitsToPull = 0 + , gitMergeBranchCommitsToPush = 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,73 @@ +module GitHUD.Terminal.Base ( + tellStringInColor + , applyShellMarkers + , terminalStartCode + , endColorMarker + ) where + +import Control.Monad.Writer (tell) +import Data.Monoid (mappend) + +import GitHUD.Types +import GitHUD.Terminal.Types + +tellStringInColor :: Color -- ^ The terminal color to use + -> ColorIntensity -- ^ The intensity to use + -> String -- ^ The string to output + -> ShellOutput +tellStringInColor color intensity str = do + shell <- askShell + tell $ startColorMarker color intensity shell + tell $ str + tell $ endColorMarker shell + +startColorMarker :: Color + -> ColorIntensity + -> Shell + -> String +startColorMarker color intensity shell = + applyShellMarkers shell $ terminalStartCode color intensity + +endColorMarker :: Shell + -> String +endColorMarker shell = + applyShellMarkers shell $ terminalEndCode + +applyShellMarkers :: Shell + -> String + -> String +applyShellMarkers ZSH = zshMarkZeroWidth +applyShellMarkers BASH = bashMarkZeroWidth +applyShellMarkers _ = id + +zshMarkZeroWidth :: String + -> String +zshMarkZeroWidth str = "%{" `mappend` str `mappend` "%}" + +bashMarkZeroWidth :: String + -> String +bashMarkZeroWidth str = "\001" `mappend` str `mappend` "\002" + +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" +terminalStartCode NoColor _ = terminalEndCode + +terminalEndCode :: String +terminalEndCode = "\x1b[39m" diff --git a/src/GitHUD/Terminal/Prompt.hs b/src/GitHUD/Terminal/Prompt.hs new file mode 100644 --- /dev/null +++ b/src/GitHUD/Terminal/Prompt.hs @@ -0,0 +1,260 @@ +module GitHUD.Terminal.Prompt ( + buildPromptWithConfig + , resetPromptAtBeginning + , addGitRepoIndicator + , addNoTrackedUpstreamIndicator + , addMergeBranchCommits + , addLocalBranchName + , addLocalCommits + , addRepoState + , addStashes + , buildPrompt + ) where + +import Control.Applicative ((<$>)) +import Control.Monad (when) +import Control.Monad.Writer (runWriterT, tell) + +import GitHUD.Config.Types +import GitHUD.Git.Types +import GitHUD.Terminal.Base +import GitHUD.Terminal.Types +import GitHUD.Types + +-- | From the state of the terminal (shell type + git info), builds a prompt to +-- | display by accumulating data in a Writer and returning it +buildPromptWithConfig :: TerminalState +buildPromptWithConfig = do + (_, prompt) <- runWriterT buildPrompt + return prompt + +buildPrompt :: ShellOutput +buildPrompt = do + config <- askConfig + repoState <- askRepoState + let branch = gitLocalBranch repoState + resetPromptAtBeginning + when (confShowPartRepoIndicator config) $ addGitRepoIndicator + when (showMergeBranchIndicator branch config) $ addNoTrackedUpstreamIndicator + when (showMergeBranchIndicator branch config) $ addMergeBranchCommits + when (confShowPartLocalBranch config) $ addLocalBranchName + when (confShowPartCommitsToOrigin config) $ addLocalCommits + when (confShowPartLocalChangesState config) $ addRepoState + when (confShowPartStashes config) $ addStashes + return () + +showMergeBranchIndicator :: String -> Config -> Bool +showMergeBranchIndicator branch config = + (confShowPartMergeBranchCommitsDiff config) && + (not (branch `elem` (confMergeBranchIgnoreBranches config))) + +resetPromptAtBeginning :: ShellOutput +resetPromptAtBeginning = + (endColorMarker <$> askShell) >>= tell + +addGitRepoIndicator :: ShellOutput +addGitRepoIndicator = do + config <- askConfig + tell $ confRepoIndicator config + tell " " + +addNoTrackedUpstreamIndicator :: ShellOutput +addNoTrackedUpstreamIndicator = do + repoState <- askRepoState + config <- askConfig + when (gitRemoteTrackingBranch repoState == "") $ do + tellStringInColor + (confNoTrackedUpstreamStringColor config) + (confNoTrackedUpstreamStringIntensity config) + (confNoTrackedUpstreamString config) + tell " " + tellStringInColor + (confNoTrackedUpstreamIndicatorColor config) + (confNoTrackedUpstreamIndicatorIntensity config) + (confNoTrackedUpstreamIndicator config) + tell " " + return () + +addMergeBranchCommits :: ShellOutput +addMergeBranchCommits = do + repoState <- askRepoState + config <- askConfig + let push = gitMergeBranchCommitsToPush repoState + let pull = gitMergeBranchCommitsToPull repoState + if (push > 0) && (pull > 0) + then do + tell (confMergeBranchCommitsIndicator config) + tell " " + tell . show $ pull + tellStringInColor Green Vivid (confMergeBranchCommitsBothPullPush config) + tell . show $ push + else ( + if (pull > 0) + then do + tell (confMergeBranchCommitsIndicator config) + tell " " + tellStringInColor Green Vivid (confMergeBranchCommitsOnlyPull config) + tell " " + tell . show $ pull + else ( + when (push > 0) $ do + tell (confMergeBranchCommitsIndicator config) + tell " " + tellStringInColor Green Vivid (confMergeBranchCommitsOnlyPush config) + tell " " + tell . show $ push + ) + ) + addSpaceIfAnyBiggerThanZero [pull, push] + return () + +addLocalBranchName :: ShellOutput +addLocalBranchName = do + repoState <- askRepoState + config <- askConfig + let localBranchName = gitLocalBranch repoState + let commitTag = gitCommitTag repoState + tell (confLocalBranchNamePrefix config) + + if (localBranchName /= "") + then do + tellStringInColor (confLocalBranchColor config) (confLocalBranchIntensity config) $ + localBranchName + else do + if (commitTag /= "") + then do + tellStringInColor (confLocalDetachedColor config) (confLocalDetachedIntensity config) $ + (confLocalDetachedPrefix config) ++ commitTag + else do + tellStringInColor (confLocalDetachedColor config) (confLocalDetachedIntensity config) $ + (confLocalDetachedPrefix config) ++ (gitCommitShortSHA repoState) + + tell (confLocalBranchNameSuffix config) + tell " " + return () + +addLocalCommits :: ShellOutput +addLocalCommits = do + repoState <- askRepoState + config <- askConfig + let push = gitCommitsToPush repoState + let pull = gitCommitsToPull repoState + if (pull > 0) && (push > 0) + then do + tell . show $ pull + tellStringInColor + (confLocalCommitsPushPullInfixColor config) + (confLocalCommitsPushPullInfixIntensity config) + (confLocalCommitsPushPullInfix config) + tell . show $ push + tell " " + else + if (pull > 0) + then do + tell . show $ pull + tellStringInColor + (confLocalCommitsPullSuffixColor config) + (confLocalCommitsPullSuffixIntensity config) + (confLocalCommitsPullSuffix config) + tell " " + else + when (push > 0) $ do + tell . show $ push + tellStringInColor + (confLocalCommitsPushSuffixColor config) + (confLocalCommitsPushSuffixIntensity config) + (confLocalCommitsPushSuffix config) + tell " " + + return () + +addRepoState :: ShellOutput +addRepoState = do + repoState <- askRepoState + config <- askConfig + let repoChanges = gitLocalRepoChanges repoState + + let inda = indexAdd repoChanges + let indd = indexDel repoChanges + let indm = indexMod repoChanges + let mv = renamed repoChanges + addStateElem inda + (confChangeIndexAddSuffixColor config) + (confChangeIndexAddSuffixIntensity config) + (confChangeIndexAddSuffix config) + addStateElem indd + (confChangeIndexDelSuffixColor config) + (confChangeIndexDelSuffixIntensity config) + (confChangeIndexDelSuffix config) + addStateElem indm + (confChangeIndexModSuffixColor config) + (confChangeIndexModSuffixIntensity config) + (confChangeIndexModSuffix config) + addStateElem mv + (confChangeRenamedSuffixColor config) + (confChangeRenamedSuffixIntensity config) + (confChangeRenamedSuffix config) + addSpaceIfAnyBiggerThanZero [inda, indd, indm, mv] + + let ld = localDel repoChanges + let lm = localMod repoChanges + addStateElem ld + (confChangeLocalDelSuffixColor config) + (confChangeLocalDelSuffixIntensity config) + (confChangeLocalDelSuffix config) + addStateElem lm + (confChangeLocalModSuffixColor config) + (confChangeLocalModSuffixIntensity config) + (confChangeLocalModSuffix config) + addSpaceIfAnyBiggerThanZero [ld, lm] + + let la = localAdd repoChanges + addStateElem la + (confChangeLocalAddSuffixColor config) + (confChangeLocalAddSuffixIntensity config) + (confChangeLocalAddSuffix config) + addSpaceIfAnyBiggerThanZero [la] + + let co = conflict repoChanges + addStateElem co + (confChangeConflictedSuffixColor config) + (confChangeConflictedSuffixIntensity config) + (confChangeConflictedSuffix config) + addSpaceIfAnyBiggerThanZero [co] + return () + +addSpaceIfAnyBiggerThanZero :: [Int] -> ShellOutput +addSpaceIfAnyBiggerThanZero list = + when (any (>0) list) $ tell " " + +addStateElem :: Int + -> Color + -> ColorIntensity + -> String + -> ShellOutput +addStateElem stateElem color intensity letter = + when (stateElem > 0) $ addNumStateElem stateElem color intensity letter + +addNumStateElem :: Int + -> Color + -> ColorIntensity + -> String + -> ShellOutput +addNumStateElem num color intensity letter = do + tell . show $ num + tellStringInColor color intensity letter + return () + +addStashes :: ShellOutput +addStashes = do + repoState <- askRepoState + config <- askConfig + let stashCount = gitStashCount repoState + when (stashCount /= 0) $ do + tell . show $ stashCount + tellStringInColor + (confStashSuffixColor config) + (confStashSuffixIntensity config) + (confStashSuffix config) + tell " " + 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,9 @@ +module GitHUD.Terminal.Types ( + Color(..) + , ColorIntensity(..) + , Shell(..) + ) where + +data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White | NoColor deriving (Eq, Show, Read) +data ColorIntensity = Dull | Vivid deriving (Eq, Show, Read) +data Shell = ZSH | BASH | Other deriving (Eq, Show) diff --git a/src/GitHUD/Types.hs b/src/GitHUD/Types.hs new file mode 100644 --- /dev/null +++ b/src/GitHUD/Types.hs @@ -0,0 +1,51 @@ +{-# Language FlexibleContexts #-} + +module GitHUD.Types ( + OutputConfig(..) + , buildOutputConfig + , Prompt + , TerminalState + , ShellOutput + , askShell + , askRepoState + , askConfig + ) where + +import Control.Monad.Reader (Reader, MonadReader, asks) +import Control.Monad.Writer (WriterT) + +import GitHUD.Config.Types +import GitHUD.Git.Types +import GitHUD.Terminal.Types + +data OutputConfig = OutputConfig { + _shell :: Shell + , _repoState :: GitRepoState + , _config :: Config +} + +buildOutputConfig :: Shell + -> GitRepoState + -> Config + -> OutputConfig +buildOutputConfig shell repoState config = OutputConfig { + _shell = shell + , _repoState = repoState + , _config = config +} + +askShell :: MonadReader OutputConfig m => m Shell +askShell = asks _shell + +askRepoState :: MonadReader OutputConfig m => m GitRepoState +askRepoState = asks _repoState + +askConfig :: MonadReader OutputConfig m => m Config +askConfig = asks _config + +type Prompt = String + +type TerminalState = Reader OutputConfig String + +type ShellOutput = WriterT Prompt (Reader OutputConfig) () + diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,60 @@ +import Test.Tasty + +import Test.GitHUD.Config.Parse +import Test.GitHUD.Git.Parse.Status +import Test.GitHUD.Git.Parse.Branch +import Test.GitHUD.Git.Common +import Test.GitHUD.Git.Types +import Test.GitHUD.Terminal.Base +import Test.GitHUD.Terminal.Prompt + +main :: IO () +main = defaultMain tests + +tests :: TestTree +tests = testGroup "Tests" + [ statusTests + , branchTests + , gitTypesTests + , gitCommonTests + , terminalTests + , terminalPromptTests + , configParserTests + ] +-- +-- 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/Config/Parse.hs b/test/Test/GitHUD/Config/Parse.hs new file mode 100644 --- /dev/null +++ b/test/Test/GitHUD/Config/Parse.hs @@ -0,0 +1,497 @@ +module Test.GitHUD.Config.Parse ( + configParserTests + ) where + +import Test.Tasty +import Test.Tasty.HUnit + +import Text.Parsec (parse) +import Text.Parsec.String (Parser) + +import GitHUD.Config.Parse +import GitHUD.Config.Types +import GitHUD.Terminal.Types + +configParserTests :: TestTree +configParserTests = testGroup "Config Parser Test" + [ testItemParser + , testCommentParser + , testConfigItemFolder + , testColorConfigToColor + , testIntensityConfigToIntensity + , testStringConfigToStringList + ] + +testItemParser :: TestTree +testItemParser = testGroup "#itemParser" + [ testCase "properly formed config item" $ + utilConfigItemParser itemParser "some_test_key=some Complex ⚡ value" + @?= Item "some_test_key" "some Complex ⚡ value" + + , testCase "dash characters are not allowed in keys" $ + utilConfigItemParser itemParser "some-key=dash" + @?= ErrorLine + + , testCase "num characters are not allowed in keys" $ + utilConfigItemParser itemParser "some123=dash" + @?= ErrorLine + + , testCase "empty keys are not allowed" $ + utilConfigItemParser itemParser "=dash" + @?= ErrorLine + + , testCase "Comment should not work" $ + utilConfigItemParser itemParser "#some comment" + @?= ErrorLine + ] + +testCommentParser :: TestTree +testCommentParser = testGroup "#commentParser" + [ testCase "proper comment" $ + utilConfigItemParser commentParser "#some comment\n" + @?= Comment + + , testCase "not a comment if start with a space" $ + utilConfigItemParser commentParser " #some non comment\n" + @?= ErrorLine + ] + +testConfigItemFolder :: TestTree +testConfigItemFolder = testGroup "#configItemFolder" + [ testCase "Key: show_part_repo_indicator" $ + expectValue False $ + toBeInField confShowPartRepoIndicator $ + forConfigItemKey "show_part_repo_indicator" $ + withValue "False" + + , testCase "Key: show_part_merge_branch_commits_diff" $ + expectValue False $ + toBeInField confShowPartMergeBranchCommitsDiff $ + forConfigItemKey "show_part_merge_branch_commits_diff" $ + withValue "False" + + , testCase "Key: show_part_local_branch" $ + expectValue False $ + toBeInField confShowPartLocalBranch $ + forConfigItemKey "show_part_local_branch" $ + withValue "False" + + , testCase "Key: show_part_commits_to_origin" $ + expectValue False $ + toBeInField confShowPartCommitsToOrigin $ + forConfigItemKey "show_part_commits_to_origin" $ + withValue "False" + + , testCase "Key: show_part_local_changes_state" $ + expectValue False $ + toBeInField confShowPartLocalChangesState $ + forConfigItemKey "show_part_local_changes_state" $ + withValue "False" + + , testCase "Key: show_part_stashes" $ + expectValue False $ + toBeInField confShowPartStashes $ + forConfigItemKey "show_part_stashes" $ + withValue "False" + + , testCase "Comment should have no impact on the config" $ + configItemsFolder defaultConfig (Comment) + @?= defaultConfig + + , testCase "ErrorLines should have no impact on the config" $ + configItemsFolder defaultConfig (ErrorLine) + @?= defaultConfig + + , testCase "Key: git_repo_indicator" $ + expectValue "foo" $ + toBeInField confRepoIndicator $ + forConfigItemKey "git_repo_indicator" $ + withValue "foo" + + , testCase "Key: no_tracked_upstream_text" $ + expectValue "foo" $ + toBeInField confNoTrackedUpstreamString $ + forConfigItemKey "no_tracked_upstream_text" $ + withValue "foo" + + , testCase "Key: no_tracked_upstream_text_color" $ + expectValue Green $ + toBeInField confNoTrackedUpstreamStringColor $ + forConfigItemKey "no_tracked_upstream_text_color" $ + withValue "Green" + + , testCase "Key: no_tracked_upstream_text_intensity" $ + expectValue Dull $ + toBeInField confNoTrackedUpstreamStringIntensity $ + forConfigItemKey "no_tracked_upstream_text_intensity" $ + withValue "Dull" + + , testCase "Key: no_tracked_upstream_indicator" $ + expectValue "foo" $ + toBeInField confNoTrackedUpstreamIndicator $ + forConfigItemKey "no_tracked_upstream_indicator" $ + withValue "foo" + + , testCase "Key: no_tracked_upstream_indicator_color" $ + expectValue Black $ + toBeInField confNoTrackedUpstreamIndicatorColor $ + forConfigItemKey "no_tracked_upstream_indicator_color" $ + withValue "Black" + + , testCase "Key: no_tracked_upstream_indicator_color - invalid color" $ + expectValue NoColor $ + toBeInField confNoTrackedUpstreamIndicatorColor $ + forConfigItemKey "no_tracked_upstream_indicator_color" $ + withValue "FOO" + + , testCase "Key: no_tracked_upstream_indicator_intensity" $ + expectValue Dull $ + toBeInField confNoTrackedUpstreamIndicatorIntensity $ + forConfigItemKey "no_tracked_upstream_indicator_intensity" $ + withValue "Dull" + + , testCase "Key: no_tracked_upstream_indicator_intensity - invalid intensity" $ + expectValue Vivid $ + toBeInField confNoTrackedUpstreamIndicatorIntensity $ + forConfigItemKey "no_tracked_upstream_indicator_intensity" $ + withValue "FOO" + + , testCase "Key: merge_branch_commits_indicator" $ + expectValue "FOO" $ + toBeInField confMergeBranchCommitsIndicator $ + forConfigItemKey "merge_branch_commits_indicator" $ + withValue "FOO" + + , testCase "Key: merge_branch_commits_pull_prefix" $ + expectValue "FOO" $ + toBeInField confMergeBranchCommitsOnlyPull $ + forConfigItemKey "merge_branch_commits_pull_prefix" $ + withValue "FOO" + + , testCase "Key: merge_branch_commits_push_prefix" $ + expectValue "FOO" $ + toBeInField confMergeBranchCommitsOnlyPush $ + forConfigItemKey "merge_branch_commits_push_prefix" $ + withValue "FOO" + + , testCase "Key: merge_branch_commits_push_pull_infix" $ + expectValue "FOO" $ + toBeInField confMergeBranchCommitsBothPullPush $ + forConfigItemKey "merge_branch_commits_push_pull_infix" $ + withValue "FOO" + + , testCase "Key: merge_branch_ignore_branches" $ + expectValue ["gh-pages", "FOO"] $ + toBeInField confMergeBranchIgnoreBranches $ + forConfigItemKey "merge_branch_ignore_branches" $ + withValue "gh-pages, FOO" + + , testCase "Key: local_branch_prefix" $ + expectValue "FOO" $ + toBeInField confLocalBranchNamePrefix $ + forConfigItemKey "local_branch_prefix" $ + withValue "FOO" + + , testCase "Key: local_branch_suffix" $ + expectValue "FOO" $ + toBeInField confLocalBranchNameSuffix $ + forConfigItemKey "local_branch_suffix" $ + withValue "FOO" + + , testCase "Key: local_branch_color" $ + expectValue Cyan $ + toBeInField confLocalBranchColor $ + forConfigItemKey "local_branch_color" $ + withValue "Cyan" + + , testCase "Key: local_branch_intensity" $ + expectValue Dull $ + toBeInField confLocalBranchIntensity $ + forConfigItemKey "local_branch_intensity" $ + withValue "Dull" + + , testCase "Key: local_detached_prefix" $ + expectValue "FOO" $ + toBeInField confLocalDetachedPrefix $ + forConfigItemKey "local_detached_prefix" $ + withValue "FOO" + + , testCase "Key: local_detached_color" $ + expectValue Cyan $ + toBeInField confLocalDetachedColor $ + forConfigItemKey "local_detached_color" $ + withValue "Cyan" + + , testCase "Key: local_detached_intensity" $ + expectValue Dull $ + toBeInField confLocalDetachedIntensity $ + forConfigItemKey "local_detached_intensity" $ + withValue "Dull" + + , testCase "Key: local_commits_push_suffix" $ + expectValue "FOO" $ + toBeInField confLocalCommitsPushSuffix $ + forConfigItemKey "local_commits_push_suffix" $ + withValue "FOO" + + , testCase "Key: local_commits_push_suffix_color" $ + expectValue Cyan $ + toBeInField confLocalCommitsPushSuffixColor $ + forConfigItemKey "local_commits_push_suffix_color" $ + withValue "Cyan" + + , testCase "Key: local_commits_push_suffix_intensity" $ + expectValue Dull $ + toBeInField confLocalCommitsPushSuffixIntensity $ + forConfigItemKey "local_commits_push_suffix_intensity" $ + withValue "Dull" + + , testCase "Key: local_commits_pull_suffix" $ + expectValue "FOO" $ + toBeInField confLocalCommitsPullSuffix $ + forConfigItemKey "local_commits_pull_suffix" $ + withValue "FOO" + + , testCase "Key: local_commits_pull_suffix_color" $ + expectValue Cyan $ + toBeInField confLocalCommitsPullSuffixColor $ + forConfigItemKey "local_commits_pull_suffix_color" $ + withValue "Cyan" + + , testCase "Key: local_commits_pull_suffix_intensity" $ + expectValue Dull $ + toBeInField confLocalCommitsPullSuffixIntensity $ + forConfigItemKey "local_commits_pull_suffix_intensity" $ + withValue "Dull" + + , testCase "Key: local_commits_push_pull_infix" $ + expectValue "FOO" $ + toBeInField confLocalCommitsPushPullInfix $ + forConfigItemKey "local_commits_push_pull_infix" $ + withValue "FOO" + + , testCase "Key: local_commits_push_pull_infix_color" $ + expectValue Cyan $ + toBeInField confLocalCommitsPushPullInfixColor $ + forConfigItemKey "local_commits_push_pull_infix_color" $ + withValue "Cyan" + + , testCase "Key: local_commits_push_pull_infix_intensity" $ + expectValue Dull $ + toBeInField confLocalCommitsPushPullInfixIntensity $ + forConfigItemKey "local_commits_push_pull_infix_intensity" $ + withValue "Dull" + + , testCase "Key: change_index_add_suffix" $ + expectValue "FOO" $ + toBeInField confChangeIndexAddSuffix $ + forConfigItemKey "change_index_add_suffix" $ + withValue "FOO" + + , testCase "Key: change_index_add_suffix_color" $ + expectValue Cyan $ + toBeInField confChangeIndexAddSuffixColor $ + forConfigItemKey "change_index_add_suffix_color" $ + withValue "Cyan" + + , testCase "Key: change_index_add_suffix_intensity" $ + expectValue Dull $ + toBeInField confChangeIndexAddSuffixIntensity $ + forConfigItemKey "change_index_add_suffix_intensity" $ + withValue "Dull" + + , testCase "Key: change_index_mod_suffix" $ + expectValue "FOO" $ + toBeInField confChangeIndexModSuffix $ + forConfigItemKey "change_index_mod_suffix" $ + withValue "FOO" + + , testCase "Key: change_index_mod_suffix_color" $ + expectValue Cyan $ + toBeInField confChangeIndexModSuffixColor $ + forConfigItemKey "change_index_mod_suffix_color" $ + withValue "Cyan" + + , testCase "Key: change_index_mod_suffix_intensity" $ + expectValue Dull $ + toBeInField confChangeIndexModSuffixIntensity $ + forConfigItemKey "change_index_mod_suffix_intensity" $ + withValue "Dull" + + , testCase "Key: change_index_del_suffix" $ + expectValue "FOO" $ + toBeInField confChangeIndexDelSuffix $ + forConfigItemKey "change_index_del_suffix" $ + withValue "FOO" + + , testCase "Key: change_index_del_suffix_color" $ + expectValue Cyan $ + toBeInField confChangeIndexDelSuffixColor $ + forConfigItemKey "change_index_del_suffix_color" $ + withValue "Cyan" + + , testCase "Key: change_index_del_suffix_intensity" $ + expectValue Dull $ + toBeInField confChangeIndexDelSuffixIntensity $ + forConfigItemKey "change_index_del_suffix_intensity" $ + withValue "Dull" + + , testCase "Key: change_local_add_suffix" $ + expectValue "FOO" $ + toBeInField confChangeLocalAddSuffix $ + forConfigItemKey "change_local_add_suffix" $ + withValue "FOO" + + , testCase "Key: change_local_add_suffix_color" $ + expectValue Cyan $ + toBeInField confChangeLocalAddSuffixColor $ + forConfigItemKey "change_local_add_suffix_color" $ + withValue "Cyan" + + , testCase "Key: change_local_add_suffix_intensity" $ + expectValue Dull $ + toBeInField confChangeLocalAddSuffixIntensity $ + forConfigItemKey "change_local_add_suffix_intensity" $ + withValue "Dull" + + , testCase "Key: change_local_mod_suffix" $ + expectValue "FOO" $ + toBeInField confChangeLocalModSuffix $ + forConfigItemKey "change_local_mod_suffix" $ + withValue "FOO" + + , testCase "Key: change_local_mod_suffix_color" $ + expectValue Cyan $ + toBeInField confChangeLocalModSuffixColor $ + forConfigItemKey "change_local_mod_suffix_color" $ + withValue "Cyan" + + , testCase "Key: change_local_mod_suffix_intensity" $ + expectValue Dull $ + toBeInField confChangeLocalModSuffixIntensity $ + forConfigItemKey "change_local_mod_suffix_intensity" $ + withValue "Dull" + + , testCase "Key: change_local_del_suffix" $ + expectValue "FOO" $ + toBeInField confChangeLocalDelSuffix $ + forConfigItemKey "change_local_del_suffix" $ + withValue "FOO" + + , testCase "Key: change_local_del_suffix_color" $ + expectValue Cyan $ + toBeInField confChangeLocalDelSuffixColor $ + forConfigItemKey "change_local_del_suffix_color" $ + withValue "Cyan" + + , testCase "Key: change_local_del_suffix_intensity" $ + expectValue Dull $ + toBeInField confChangeLocalDelSuffixIntensity $ + forConfigItemKey "change_local_del_suffix_intensity" $ + withValue "Dull" + + , testCase "Key: change_renamed_suffix" $ + expectValue "FOO" $ + toBeInField confChangeRenamedSuffix $ + forConfigItemKey "change_renamed_suffix" $ + withValue "FOO" + + , testCase "Key: change_renamed_suffix_color" $ + expectValue Cyan $ + toBeInField confChangeRenamedSuffixColor $ + forConfigItemKey "change_renamed_suffix_color" $ + withValue "Cyan" + + , testCase "Key: change_renamed_suffix_intensity" $ + expectValue Dull $ + toBeInField confChangeRenamedSuffixIntensity $ + forConfigItemKey "change_renamed_suffix_intensity" $ + withValue "Dull" + + , testCase "Key: change_conflicted_suffix" $ + expectValue "FOO" $ + toBeInField confChangeConflictedSuffix $ + forConfigItemKey "change_conflicted_suffix" $ + withValue "FOO" + + , testCase "Key: change_conflicted_suffix_color" $ + expectValue Cyan $ + toBeInField confChangeConflictedSuffixColor $ + forConfigItemKey "change_conflicted_suffix_color" $ + withValue "Cyan" + + , testCase "Key: change_conflicted_suffix_intensity" $ + expectValue Dull $ + toBeInField confChangeConflictedSuffixIntensity $ + forConfigItemKey "change_conflicted_suffix_intensity" $ + withValue "Dull" + + , testCase "Key: stash_suffix" $ + expectValue "FOO" $ + toBeInField confStashSuffix $ + forConfigItemKey "stash_suffix" $ + withValue "FOO" + + , testCase "Key: stash_suffix_color" $ + expectValue Cyan $ + toBeInField confStashSuffixColor $ + forConfigItemKey "stash_suffix_color" $ + withValue "Cyan" + + , testCase "Key: stash_suffix_intensity" $ + expectValue Dull $ + toBeInField confStashSuffixIntensity $ + forConfigItemKey "stash_suffix_intensity" $ + withValue "Dull" + ] + +expectValue :: (Eq a, Show a) => a -> a -> Assertion +expectValue expected actual = actual @?= expected + +toBeInField :: (Config -> a) -> Config -> a +toBeInField accessor config = accessor config + +forConfigItemKey :: String -> String -> Config +forConfigItemKey key value = + configItemsFolder defaultConfig (Item key value) + +withValue :: a -> a +withValue = id + +utilConfigItemParser :: Parser ConfigItem -> String -> ConfigItem +utilConfigItemParser parser str = + either + (const ErrorLine) + id + (parse parser "" str) + +testIntensityConfigToIntensity :: TestTree +testIntensityConfigToIntensity = testGroup "#intensityConfigToIntensity" + [ testCase "valid intensity - return it" $ + intensityConfigToIntensity "Dull" @?= Dull + + , testCase "invalid intensity - default to Vivid" $ + intensityConfigToIntensity "Foo" @?= Vivid + ] + +testColorConfigToColor :: TestTree +testColorConfigToColor = testGroup "#colorConfigToColor" + [ testCase "valid color - return it" $ + colorConfigToColor "Cyan" @?= Cyan + + , testCase "invalid color - default to Blue" $ + colorConfigToColor "Foo" @?= NoColor + ] + +testStringConfigToStringList :: TestTree +testStringConfigToStringList = testGroup "#stringConfigToStringList" + [ testCase "valid string list, comma separated, no spaces" $ + stringConfigToStringList "foo,bar" @?= ["foo", "bar"] + + , testCase "valid string list, comma separated, spaces" $ + stringConfigToStringList "foo, bar , baz " @?= ["foo", "bar", "baz"] + + , testCase "valid string list, comma separated, finish with comma" $ + stringConfigToStringList "foo,bar, " @?= ["foo", "bar"] + ] + diff --git a/test/Test/GitHUD/Git/Common.hs b/test/Test/GitHUD/Git/Common.hs new file mode 100644 --- /dev/null +++ b/test/Test/GitHUD/Git/Common.hs @@ -0,0 +1,20 @@ +module Test.GitHUD.Git.Common ( + gitCommonTests + ) where + +import Test.Tasty +import Test.Tasty.HUnit + +import GitHUD.Git.Common + +gitCommonTests :: TestTree +gitCommonTests = testGroup "Git Common Test" + [ testCase "Getting the config key for the remote of a given local branch" $ + gitRemoteTrackingConfigKey "master" @?= "branch.master.remote" + + , testCase "Getting the config key for the remote tracking branch of a local branch" $ + gitRemoteBranchConfigKey "master" @?= "branch.master.merge" + + , testCase "Getting a commit span between 2 commits" $ + mergeBaseDiffFromTo "b2d35" "ef25d" @?= "b2d35...ef25d" + ] 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" diff --git a/test/Test/GitHUD/Git/Types.hs b/test/Test/GitHUD/Git/Types.hs new file mode 100644 --- /dev/null +++ b/test/Test/GitHUD/Git/Types.hs @@ -0,0 +1,54 @@ +module Test.GitHUD.Git.Types ( + gitTypesTests + ) where + +import Test.Tasty +import Test.Tasty.HUnit + +import GitHUD.Git.Types + +gitTypesTests :: TestTree +gitTypesTests = testGroup "Git Types Test" + [ testCase "Merging 2 repoChanges object should lead to the sum of its parts" $ + testMergeGitLocalRepoChanges + ] + +testMergeGitLocalRepoChanges :: Assertion +testMergeGitLocalRepoChanges = + mergeGitLocalRepoChanges glrc1 glrc2 @?= glrcMerged + +glrc1 :: GitLocalRepoChanges +glrc1 = GitLocalRepoChanges { + localMod = 3 + , localAdd = 2 + , localDel = 4 + , indexMod = 6 + , indexAdd = 10 + , indexDel = 7 + , renamed = 12 + , conflict = 50 +} + +glrc2 :: GitLocalRepoChanges +glrc2 = GitLocalRepoChanges { + localMod = 6 + , localAdd = 20 + , localDel = 48 + , indexMod = 3 + , indexAdd = 56 + , indexDel = 10 + , renamed = 44 + , conflict = 2 +} + +glrcMerged :: GitLocalRepoChanges +glrcMerged = GitLocalRepoChanges { + localMod = 9 + , localAdd = 22 + , localDel = 52 + , indexMod = 9 + , indexAdd = 66 + , indexDel = 17 + , renamed = 56 + , conflict = 52 +} diff --git a/test/Test/GitHUD/Terminal/Base.hs b/test/Test/GitHUD/Terminal/Base.hs new file mode 100644 --- /dev/null +++ b/test/Test/GitHUD/Terminal/Base.hs @@ -0,0 +1,19 @@ +module Test.GitHUD.Terminal.Base ( + terminalTests + ) where + +import Test.Tasty +import Test.Tasty.HUnit + +import GitHUD.Terminal.Base +import GitHUD.Terminal.Types + +terminalTests :: TestTree +terminalTests = testGroup "Terminal Base Tests" + [ testCase "#applyShellMarkers should not do anything for non ZSH shell" $ + applyShellMarkers Other "foo" @?= "foo" + + , testCase "#applyShellMarkers should add 0-width markers for ZSH shell" $ + applyShellMarkers ZSH "foo" @?= "%{foo%}" + + ] diff --git a/test/Test/GitHUD/Terminal/Prompt.hs b/test/Test/GitHUD/Terminal/Prompt.hs new file mode 100644 --- /dev/null +++ b/test/Test/GitHUD/Terminal/Prompt.hs @@ -0,0 +1,751 @@ +module Test.GitHUD.Terminal.Prompt ( + terminalPromptTests + ) where + +import Test.Tasty +import Test.Tasty.HUnit + +import Control.Monad.Reader (runReader) +import Control.Monad.Writer (runWriterT) + +import GitHUD.Config.Types +import GitHUD.Git.Types +import GitHUD.Terminal.Prompt +import GitHUD.Terminal.Types +import GitHUD.Types + +terminalPromptTests :: TestTree +terminalPromptTests = testGroup "Terminal Prompt Test" + [ testResetPromptAtBeginning + , testAddGitRepoIndicator + , testAddNoTrackedUpstreamIndicator + , testAddMergeBranchCommits + , testAddLocalBranchName + , testAddLocalCommits + , testAddRepoState + , testAddStashes + , testPartialPrompt + ] + +testResetPromptAtBeginning :: TestTree +testResetPromptAtBeginning = testGroup "#resetPromptAtBeginning" + [ testCase "Should start the prompt with a reset color control sequence" $ + testWriterWithConfig (zeroOutputConfig ZSH) resetPromptAtBeginning @?= "%{\x1b[39m%}" + , testCase "Should start the prompt with a reset color control sequence" $ + testWriterWithConfig (zeroOutputConfig Other) resetPromptAtBeginning @?= "\x1b[39m" + ] + +testAddGitRepoIndicator :: TestTree +testAddGitRepoIndicator = testGroup "#addGitRepoIndicator" + [ testGroup "Default Config" + [ testCase "ZSH: default config: hardcoded character" $ + testWriterWithConfig (zeroOutputConfig ZSH) addGitRepoIndicator @?= "ᚴ " + + , testCase "Other: default config: hardcoded character" $ + testWriterWithConfig (zeroOutputConfig Other) addGitRepoIndicator @?= "ᚴ " + ] + , testGroup "Custom Config" + [ testCase "ZSH: custom config: hardcoded character" $ + testWriterWithConfig + (buildOutputConfig ZSH zeroGitRepoState $ defaultConfig { confRepoIndicator = "indic" }) + addGitRepoIndicator + @?= "indic " + + , testCase "Other: custom config: hardcoded character" $ + testWriterWithConfig + (buildOutputConfig ZSH zeroGitRepoState $ defaultConfig { confRepoIndicator = "indic" }) + addGitRepoIndicator + @?= "indic " + ] + ] + +customConfigNoTrackedUpstreamIndicator :: Config +customConfigNoTrackedUpstreamIndicator = defaultConfig { + confNoTrackedUpstreamString = "foo" + , confNoTrackedUpstreamStringColor = Cyan + , confNoTrackedUpstreamStringIntensity = Dull + , confNoTrackedUpstreamIndicator = "bar" + , confNoTrackedUpstreamIndicatorColor = Green + , confNoTrackedUpstreamIndicatorIntensity = Dull +} + +testAddNoTrackedUpstreamIndicator :: TestTree +testAddNoTrackedUpstreamIndicator = testGroup "#addTrackedUpstreamIndicator" + [ testGroup "Default Config" + [ testCase "ZSH: with an upstream" $ + testWriterWithConfig + (buildOutputConfig ZSH (zeroGitRepoState { gitRemoteTrackingBranch = "foo" }) defaultConfig) + addNoTrackedUpstreamIndicator + @?= "" + + , testCase "Other: with an upstream" $ + testWriterWithConfig + (buildOutputConfig Other (zeroGitRepoState { gitRemoteTrackingBranch = "foo" }) defaultConfig) + addNoTrackedUpstreamIndicator + @?= "" + + , testCase "ZSH: with no upstream" $ + testWriterWithConfig + (zeroOutputConfig ZSH) addNoTrackedUpstreamIndicator + @?= "%{\x1b[1;31m%}upstream%{\x1b[39m%} %{\x1b[1;31m%}\9889%{\x1b[39m%} " + + , testCase "Other: with no upstream" $ + testWriterWithConfig + (zeroOutputConfig Other) addNoTrackedUpstreamIndicator + @?= "\x1b[1;31mupstream\x1b[39m \x1b[1;31m\9889\x1b[39m " + ] + , testGroup "Custom Config" + [ testCase "ZSH: with an upstream" $ + testWriterWithConfig + (buildOutputConfig ZSH (zeroGitRepoState { gitRemoteTrackingBranch = "foo" }) customConfigNoTrackedUpstreamIndicator) + addNoTrackedUpstreamIndicator + @?= "" + + , testCase "Other: with an upstream" $ + testWriterWithConfig + (buildOutputConfig Other (zeroGitRepoState { gitRemoteTrackingBranch = "foo" }) customConfigNoTrackedUpstreamIndicator) + addNoTrackedUpstreamIndicator + @?= "" + + , testCase "ZSH: with no upstream" $ + testWriterWithConfig + (buildOutputConfig ZSH (zeroGitRepoState) customConfigNoTrackedUpstreamIndicator) + addNoTrackedUpstreamIndicator + @?= "%{\x1b[36m%}foo%{\x1b[39m%} %{\x1b[32m%}bar%{\x1b[39m%} " + + , testCase "Other: with no upstream" $ + testWriterWithConfig + (buildOutputConfig Other (zeroGitRepoState) customConfigNoTrackedUpstreamIndicator) + addNoTrackedUpstreamIndicator + @?= "\x1b[36mfoo\x1b[39m \x1b[32mbar\x1b[39m " + ] + ] + +customConfigMergeBranchCommits :: Config +customConfigMergeBranchCommits = defaultConfig { + confMergeBranchCommitsIndicator = "foo" + , confMergeBranchCommitsOnlyPull = "pull" + , confMergeBranchCommitsOnlyPush = "push" + , confMergeBranchCommitsBothPullPush = "pull-push" +} + +testAddMergeBranchCommits :: TestTree +testAddMergeBranchCommits = testGroup "#addMergeBranchCommits" + [ testGroup "Default Config" + [ testCase "ZSH: commits to pull" $ + testMergeBranchCommitsToPull ZSH defaultConfig @?= + "\120366 %{\x1b[1;32m%}\8594%{\x1b[39m%} 2 " + + , testCase "ZSH: commits to push" $ + testMergeBranchCommitsToPush ZSH defaultConfig @?= + "\120366 %{\x1b[1;32m%}\8592%{\x1b[39m%} 2 " + + , testCase "ZSH: commits to pull and to push" $ + testMergeBranchCommitsToPushAndPull ZSH defaultConfig @?= + "\120366 4%{\x1b[1;32m%}\8644%{\x1b[39m%}4 " + + , testCase "Other: commits to pull" $ + testMergeBranchCommitsToPull Other defaultConfig @?= + "\120366 \x1b[1;32m\8594\x1b[39m 2 " + + , testCase "Other: commits to push" $ + testMergeBranchCommitsToPush Other defaultConfig @?= + "\120366 \x1b[1;32m\8592\x1b[39m 2 " + + , testCase "Other: commits to pull and to push" $ + testMergeBranchCommitsToPushAndPull Other defaultConfig @?= + "\120366 4\x1b[1;32m\8644\x1b[39m4 " + ] + + , testGroup "Custom Config" + [ testCase "ZSH: commits to pull" $ + testMergeBranchCommitsToPull ZSH customConfigMergeBranchCommits @?= + "foo %{\x1b[1;32m%}pull%{\x1b[39m%} 2 " + + , testCase "ZSH: commits to push" $ + testMergeBranchCommitsToPush ZSH customConfigMergeBranchCommits @?= + "foo %{\x1b[1;32m%}push%{\x1b[39m%} 2 " + + , testCase "ZSH: commits to pull and to push" $ + testMergeBranchCommitsToPushAndPull ZSH customConfigMergeBranchCommits @?= + "foo 4%{\x1b[1;32m%}pull-push%{\x1b[39m%}4 " + + , testCase "Other: commits to pull" $ + testMergeBranchCommitsToPull Other customConfigMergeBranchCommits @?= + "foo \x1b[1;32mpull\x1b[39m 2 " + + , testCase "Other: commits to push" $ + testMergeBranchCommitsToPush Other customConfigMergeBranchCommits @?= + "foo \x1b[1;32mpush\x1b[39m 2 " + + , testCase "Other: commits to pull and to push" $ + testMergeBranchCommitsToPushAndPull Other customConfigMergeBranchCommits @?= + "foo 4\x1b[1;32mpull-push\x1b[39m4 " + ] + ] + +customConfigLocalBranchName :: Config +customConfigLocalBranchName = defaultConfig { + confLocalBranchColor = Cyan + , confLocalDetachedColor = Magenta + , confLocalBranchIntensity = Dull + , confLocalDetachedIntensity = Dull + , confLocalBranchNamePrefix = "{" + , confLocalBranchNameSuffix = "}" + , confLocalDetachedPrefix = "det#!" +} + +testAddLocalBranchName :: TestTree +testAddLocalBranchName = testGroup "#addLocalBranchName" + [ testGroup "Default Config" + [ testCase "ZSH: should display the name of the current branch if we are at the HEAD of any" $ + testWriterWithConfig + (buildOutputConfig ZSH (zeroGitRepoState { gitLocalBranch = "foo" }) defaultConfig) + addLocalBranchName + @?= "[%{\x1b[39m%}foo%{\x1b[39m%}] " + + , testCase "Other: should display the name of the current branch if we are at the HEAD of any" $ + testWriterWithConfig + (buildOutputConfig Other (zeroGitRepoState { gitLocalBranch = "foo" }) defaultConfig) + addLocalBranchName + @?= "[\x1b[39mfoo\x1b[39m] " + + , testCase "ZSH: should display the current commit tag if we are not on one" $ + testWriterWithConfig + (buildOutputConfig ZSH (zeroGitRepoState { gitCommitTag = "v1.1.1" }) defaultConfig) + addLocalBranchName + @?= "[%{\x1b[1;33m%}detached@v1.1.1%{\x1b[39m%}] " + + , testCase "Other: should display the current commit tog if we are on one" $ + testWriterWithConfig + (buildOutputConfig Other (zeroGitRepoState { gitCommitTag = "v1.1.1" }) defaultConfig) + addLocalBranchName + @?= "[\x1b[1;33mdetached@v1.1.1\x1b[39m] " + + , testCase "ZSH: should display the current commit SHA if we are not on a branch's HEAD" $ + testWriterWithConfig + (buildOutputConfig ZSH (zeroGitRepoState { gitCommitShortSHA = "3d25ef" }) defaultConfig) + addLocalBranchName + @?= "[%{\x1b[1;33m%}detached@3d25ef%{\x1b[39m%}] " + + , testCase "Other: should display the current commit SHA if we are not on a branch's HEAD" $ + testWriterWithConfig + (buildOutputConfig Other (zeroGitRepoState { gitCommitShortSHA = "3d25ef" }) defaultConfig) + addLocalBranchName + @?= "[\x1b[1;33mdetached@3d25ef\x1b[39m] " + + , testCase "ZSH: should prefer the current tag over the commit SHA if we are not on a branch's HEAD" $ + testWriterWithConfig + (buildOutputConfig ZSH (zeroGitRepoState { gitCommitShortSHA = "3d25ef", gitCommitTag = "v1.2.3" }) defaultConfig) + addLocalBranchName + @?= "[%{\x1b[1;33m%}detached@v1.2.3%{\x1b[39m%}] " + + , testCase "Other: should prefer the current tag over the commit SHA if we are not on a branch's HEAD" $ + testWriterWithConfig + (buildOutputConfig Other (zeroGitRepoState { gitCommitShortSHA = "3d25ef", gitCommitTag = "v1.2.3" }) defaultConfig) + addLocalBranchName + @?= "[\x1b[1;33mdetached@v1.2.3\x1b[39m] " + ] + , testGroup "Custom Config" + [ testCase "ZSH: should display the name of the current branch if we are at the HEAD of any" $ + testWriterWithConfig + (buildOutputConfig ZSH (zeroGitRepoState { gitLocalBranch = "foo" }) customConfigLocalBranchName) + addLocalBranchName + @?= "{%{\x1b[36m%}foo%{\x1b[39m%}} " + + , testCase "Other: should display the name of the current branch if we are at the HEAD of any" $ + testWriterWithConfig + (buildOutputConfig Other (zeroGitRepoState { gitLocalBranch = "foo" }) customConfigLocalBranchName) + addLocalBranchName + @?= "{\x1b[36mfoo\x1b[39m} " + + , testCase "ZSH: should display the current commit tag if we are not on one" $ + testWriterWithConfig + (buildOutputConfig ZSH (zeroGitRepoState { gitCommitTag = "v1.1.1" }) customConfigLocalBranchName) + addLocalBranchName + @?= "{%{\x1b[35m%}det#!v1.1.1%{\x1b[39m%}} " + + , testCase "Other: should display the current commit tog if we are on one" $ + testWriterWithConfig + (buildOutputConfig Other (zeroGitRepoState { gitCommitTag = "v1.1.1" }) customConfigLocalBranchName) + addLocalBranchName + @?= "{\x1b[35mdet#!v1.1.1\x1b[39m} " + + , testCase "ZSH: should display the current commit SHA if we are not on a branch's HEAD" $ + testWriterWithConfig + (buildOutputConfig ZSH (zeroGitRepoState { gitCommitShortSHA = "3d25ef" }) customConfigLocalBranchName) + addLocalBranchName + @?= "{%{\x1b[35m%}det#!3d25ef%{\x1b[39m%}} " + + , testCase "Other: should display the current commit SHA if we are not on a branch's HEAD" $ + testWriterWithConfig + (buildOutputConfig Other (zeroGitRepoState { gitCommitShortSHA = "3d25ef" }) customConfigLocalBranchName) + addLocalBranchName + @?= "{\x1b[35mdet#!3d25ef\x1b[39m} " + ] + ] + +customConfigLocalCommits :: Config +customConfigLocalCommits = defaultConfig { + confLocalCommitsPushSuffix = "push" + , confLocalCommitsPushSuffixColor = Cyan + , confLocalCommitsPushSuffixIntensity = Dull + , confLocalCommitsPullSuffix = "pull" + , confLocalCommitsPullSuffixColor = Magenta + , confLocalCommitsPullSuffixIntensity = Dull + , confLocalCommitsPushPullInfix = "push-pull" + , confLocalCommitsPushPullInfixColor = White + , confLocalCommitsPushPullInfixIntensity = Dull +} + +testAddLocalCommits :: TestTree +testAddLocalCommits = testGroup "#addLocalCommits" + [ testGroup "Default Config" + [ testCase "ZSH: commits to pull" $ + testCommitsToPull ZSH defaultConfig @?= + "2%{\x1b[1;31m%}\8595%{\x1b[39m%} " + + , testCase "ZSH: commits to push" $ + testCommitsToPush ZSH defaultConfig @?= + "2%{\x1b[1;32m%}\8593%{\x1b[39m%} " + + , testCase "ZSH: commits to pull and to push" $ + testCommitsToPushAndPull ZSH defaultConfig @?= + "4%{\x1b[1;32m%}⥯%{\x1b[39m%}4 " + + , testCase "Other: commits to pull" $ + testCommitsToPull Other defaultConfig @?= + "2\x1b[1;31m\8595\x1b[39m " + + , testCase "Other: commits to push" $ + testCommitsToPush Other defaultConfig @?= + "2\x1b[1;32m\8593\x1b[39m " + + , testCase "Other: commits to pull and to push" $ + testCommitsToPushAndPull Other defaultConfig @?= + "4\x1b[1;32m⥯\x1b[39m4 " + ] + , testGroup "Custom Config" + [ testCase "ZSH: commits to pull" $ + testCommitsToPull ZSH customConfigLocalCommits @?= + "2%{\x1b[35m%}pull%{\x1b[39m%} " + + , testCase "ZSH: commits to push" $ + testCommitsToPush ZSH customConfigLocalCommits @?= + "2%{\x1b[36m%}push%{\x1b[39m%} " + + , testCase "ZSH: commits to pull and to push" $ + testCommitsToPushAndPull ZSH customConfigLocalCommits @?= + "4%{\x1b[37m%}push-pull%{\x1b[39m%}4 " + + , testCase "Other: commits to pull" $ + testCommitsToPull Other customConfigLocalCommits @?= + "2\x1b[35mpull\x1b[39m " + + , testCase "Other: commits to push" $ + testCommitsToPush Other customConfigLocalCommits @?= + "2\x1b[36mpush\x1b[39m " + + , testCase "Other: commits to pull and to push" $ + testCommitsToPushAndPull Other customConfigLocalCommits @?= + "4\x1b[37mpush-pull\x1b[39m4 " + ] + ] + +customChangeConfig :: Config +customChangeConfig = defaultConfig { + confChangeIndexAddSuffix = "B" + , confChangeIndexAddSuffixColor = Cyan + , confChangeIndexAddSuffixIntensity = Dull + , confChangeIndexModSuffix = "N" + , confChangeIndexModSuffixColor = Cyan + , confChangeIndexModSuffixIntensity = Dull + , confChangeIndexDelSuffix = "E" + , confChangeIndexDelSuffixColor = Cyan + , confChangeIndexDelSuffixIntensity = Dull + , confChangeLocalAddSuffix = "B" + , confChangeLocalAddSuffixColor = Magenta + , confChangeLocalAddSuffixIntensity = Dull + , confChangeLocalModSuffix = "N" + , confChangeLocalModSuffixColor = Blue + , confChangeLocalModSuffixIntensity = Dull + , confChangeLocalDelSuffix = "E" + , confChangeLocalDelSuffixColor = Blue + , confChangeLocalDelSuffixIntensity = Dull + , confChangeRenamedSuffix = "S" + , confChangeRenamedSuffixColor = Cyan + , confChangeRenamedSuffixIntensity = Dull + , confChangeConflictedSuffix = "D" + , confChangeConflictedSuffixColor = Cyan + , confChangeConflictedSuffixIntensity = Dull +} + +testAddRepoState :: TestTree +testAddRepoState = testGroup "#addRepoState" + [ testGroup "Default Config" + [ testCase "ZSH: with Local Add Changes" $ + testLocalAddChange ZSH defaultConfig @?= "2%{\x1b[1;37m%}A%{\x1b[39m%} " + + , testCase "ZSH: with Local Mod Changes" $ + testLocalModChange ZSH defaultConfig @?= "2%{\x1b[1;31m%}M%{\x1b[39m%} " + + , testCase "ZSH: with Local Del Changes" $ + testLocalDelChange ZSH defaultConfig @?= "2%{\x1b[1;31m%}D%{\x1b[39m%} " + + , testCase "ZSH: with Index Add Changes" $ + testIndexAddChange ZSH defaultConfig @?= "2%{\x1b[1;32m%}A%{\x1b[39m%} " + + , testCase "ZSH: with Index Mod Changes" $ + testIndexModChange ZSH defaultConfig @?= "2%{\x1b[1;32m%}M%{\x1b[39m%} " + + , testCase "ZSH: with Index Del Changes" $ + testIndexDelChange ZSH defaultConfig @?= "2%{\x1b[1;32m%}D%{\x1b[39m%} " + + , testCase "ZSH: with Conflicted Changes" $ + testConflictedChange ZSH defaultConfig @?= "2%{\x1b[1;32m%}C%{\x1b[39m%} " + + , testCase "ZSH: with Renamed Changes" $ + testRenamedChange ZSH defaultConfig @?= "2%{\x1b[1;32m%}R%{\x1b[39m%} " + + , testCase "Other: with Local Add Changes" $ + testLocalAddChange Other defaultConfig @?= "2\x1b[1;37mA\x1b[39m " + + , testCase "Other: with Local Mod Changes" $ + testLocalModChange Other defaultConfig @?= "2\x1b[1;31mM\x1b[39m " + + , testCase "Other: with Local Del Changes" $ + testLocalDelChange Other defaultConfig @?= "2\x1b[1;31mD\x1b[39m " + + , testCase "Other: with Index Add Changes" $ + testIndexAddChange Other defaultConfig @?= "2\x1b[1;32mA\x1b[39m " + + , testCase "Other: with Index Mod Changes" $ + testIndexModChange Other defaultConfig @?= "2\x1b[1;32mM\x1b[39m " + + , testCase "Other: with Index Del Changes" $ + testIndexDelChange Other defaultConfig @?= "2\x1b[1;32mD\x1b[39m " + + , testCase "Other: with Conflicted Changes" $ + testConflictedChange Other defaultConfig @?= "2\x1b[1;32mC\x1b[39m " + + , testCase "Other: with Renamed Changes" $ + testRenamedChange Other defaultConfig @?= "2\x1b[1;32mR\x1b[39m " + + , testCase "ZSH: with every kind of Changes" $ + testEveryRepoChange ZSH defaultConfig @?= "6%{\x1b[1;32m%}A%{\x1b[39m%}8%{\x1b[1;32m%}D%{\x1b[39m%}7%{\x1b[1;32m%}M%{\x1b[39m%}1%{\x1b[1;32m%}R%{\x1b[39m%} 5%{\x1b[1;31m%}D%{\x1b[39m%}4%{\x1b[1;31m%}M%{\x1b[39m%} 3%{\x1b[1;37m%}A%{\x1b[39m%} 2%{\x1b[1;32m%}C%{\x1b[39m%} " + + , testCase "Other: with every kind of Changes" $ + testEveryRepoChange Other defaultConfig @?= "6\x1b[1;32mA\x1b[39m8\x1b[1;32mD\x1b[39m7\x1b[1;32mM\x1b[39m1\x1b[1;32mR\x1b[39m 5\x1b[1;31mD\x1b[39m4\x1b[1;31mM\x1b[39m 3\x1b[1;37mA\x1b[39m 2\x1b[1;32mC\x1b[39m " + ] + , testGroup "Custom Config" + [ testCase "ZSH: with Local Add Changes" $ + testLocalAddChange ZSH customChangeConfig @?= "2%{\x1b[35m%}B%{\x1b[39m%} " + + , testCase "ZSH: with Local Mod Changes" $ + testLocalModChange ZSH customChangeConfig @?= "2%{\x1b[34m%}N%{\x1b[39m%} " + + , testCase "ZSH: with Local Del Changes" $ + testLocalDelChange ZSH customChangeConfig @?= "2%{\x1b[34m%}E%{\x1b[39m%} " + + , testCase "ZSH: with Index Add Changes" $ + testIndexAddChange ZSH customChangeConfig @?= "2%{\x1b[36m%}B%{\x1b[39m%} " + + , testCase "ZSH: with Index Mod Changes" $ + testIndexModChange ZSH customChangeConfig @?= "2%{\x1b[36m%}N%{\x1b[39m%} " + + , testCase "ZSH: with Index Del Changes" $ + testIndexDelChange ZSH customChangeConfig @?= "2%{\x1b[36m%}E%{\x1b[39m%} " + + , testCase "ZSH: with Conflicted Changes" $ + testConflictedChange ZSH customChangeConfig @?= "2%{\x1b[36m%}D%{\x1b[39m%} " + + , testCase "ZSH: with Renamed Changes" $ + testRenamedChange ZSH customChangeConfig @?= "2%{\x1b[36m%}S%{\x1b[39m%} " + + , testCase "Other: with Local Add Changes" $ + testLocalAddChange Other customChangeConfig @?= "2\x1b[35mB\x1b[39m " + + , testCase "Other: with Local Mod Changes" $ + testLocalModChange Other customChangeConfig @?= "2\x1b[34mN\x1b[39m " + + , testCase "Other: with Local Del Changes" $ + testLocalDelChange Other customChangeConfig @?= "2\x1b[34mE\x1b[39m " + + , testCase "Other: with Index Add Changes" $ + testIndexAddChange Other customChangeConfig @?= "2\x1b[36mB\x1b[39m " + + , testCase "Other: with Index Mod Changes" $ + testIndexModChange Other customChangeConfig @?= "2\x1b[36mN\x1b[39m " + + , testCase "Other: with Index Del Changes" $ + testIndexDelChange Other customChangeConfig @?= "2\x1b[36mE\x1b[39m " + + , testCase "Other: with Conflicted Changes" $ + testConflictedChange Other customChangeConfig @?= "2\x1b[36mD\x1b[39m " + + , testCase "Other: with Renamed Changes" $ + testRenamedChange Other customChangeConfig @?= "2\x1b[36mS\x1b[39m " + + , testCase "ZSH: with every kind of Changes" $ + testEveryRepoChange ZSH customChangeConfig @?= "6%{\x1b[36m%}B%{\x1b[39m%}8%{\x1b[36m%}E%{\x1b[39m%}7%{\x1b[36m%}N%{\x1b[39m%}1%{\x1b[36m%}S%{\x1b[39m%} 5%{\x1b[34m%}E%{\x1b[39m%}4%{\x1b[34m%}N%{\x1b[39m%} 3%{\x1b[35m%}B%{\x1b[39m%} 2%{\x1b[36m%}D%{\x1b[39m%} " + + , testCase "Other: with every kind of Changes" $ + testEveryRepoChange Other customChangeConfig @?= "6\x1b[36mB\x1b[39m8\x1b[36mE\x1b[39m7\x1b[36mN\x1b[39m1\x1b[36mS\x1b[39m 5\x1b[34mE\x1b[39m4\x1b[34mN\x1b[39m 3\x1b[35mB\x1b[39m 2\x1b[36mD\x1b[39m " + ] + ] + +customStashConfig :: Config +customStashConfig = defaultConfig { + confStashSuffix = "stash" + , confStashSuffixColor = Cyan + , confStashSuffixIntensity = Dull +} + +testAddStashes :: TestTree +testAddStashes = testGroup "#addStashes" + [ testGroup "Default Config" + [ testCase "ZSH: hardcoded character" $ + testWriterWithConfig + (buildOutputConfig ZSH (zeroGitRepoState { gitStashCount = 2 }) defaultConfig) addStashes + @?= "2%{\x1b[1;32m%}\8801%{\x1b[39m%} " + + , testCase "Other: hardcoded character" $ + testWriterWithConfig + (buildOutputConfig Other (zeroGitRepoState { gitStashCount = 2 }) defaultConfig) addStashes + @?= "2\x1b[1;32m\8801\x1b[39m " + ] + , testGroup "Custom Config" + [ testCase "ZSH: hardcoded character" $ + testWriterWithConfig + (buildOutputConfig ZSH (zeroGitRepoState { gitStashCount = 2 }) customStashConfig) addStashes + @?= "2%{\x1b[36m%}stash%{\x1b[39m%} " + + , testCase "Other: hardcoded character" $ + testWriterWithConfig + (buildOutputConfig Other (zeroGitRepoState { gitStashCount = 2 }) customStashConfig) addStashes + @?= "2\x1b[36mstash\x1b[39m " + ] + ] + +localChangesForPartialPrompt :: GitLocalRepoChanges +localChangesForPartialPrompt = GitLocalRepoChanges { + localMod = 1 + , localAdd = 2 + , localDel = 3 + , indexMod = 4 + , indexAdd = 5 + , indexDel = 6 + , renamed = 7 + , conflict = 8 + } + +repoStateForPartialPrompt :: GitRepoState +repoStateForPartialPrompt = GitRepoState { + gitLocalRepoChanges = localChangesForPartialPrompt + , gitLocalBranch = "branch" + {- The branch supercedes both the commit SHA and the tag -} + , gitCommitShortSHA = "3de6ef" + , gitCommitTag = "v1.3" + , gitRemote = "origin" + , gitRemoteTrackingBranch = "origin/branch" + , gitStashCount = 3 + , gitCommitsToPull = 5 + , gitCommitsToPush = 6 + , gitMergeBranchCommitsToPull = 2 + , gitMergeBranchCommitsToPush = 1 + } + +{- For reference here, the full prompt would be + + "%{\ESC[39m%}\5812 \120366 2%{\ESC[1;32m%}\8644%{\ESC[39m%}1 [%{\ESC[39m%}branch%{\ESC[39m%}] 5%{\ESC[1;32m%}⥯%{\ESC[39m%}6 5%{\ESC[1;32m%}A%{\ESC[39m%}6%{\ESC[1;32m%}D%{\ESC[39m%}4%{\ESC[1;32m%}M%{\ESC[39m%}7%{\ESC[1;32m%}R%{\ESC[39m%} 3%{\ESC[1;31m%}D%{\ESC[39m%}1%{\ESC[1;31m%}M%{\ESC[39m%} 2%{\ESC[1;37m%}A%{\ESC[39m%} 8%{\ESC[1;32m%}C%{\ESC[39m%} 3%{\ESC[1;32m%}\8801%{\ESC[39m%} " + +-} +testPartialPrompt :: TestTree +testPartialPrompt = testGroup "Partial prompt display" + [ testCase "w/out repo indicator" $ + testWriterWithConfig + (buildOutputConfig ZSH repoStateForPartialPrompt defaultConfig { confShowPartRepoIndicator = False }) + buildPrompt + @?= "%{\ESC[39m%}\120366 2%{\ESC[1;32m%}\8644%{\ESC[39m%}1 [%{\ESC[39m%}branch%{\ESC[39m%}] 5%{\ESC[1;32m%}⥯%{\ESC[39m%}6 5%{\ESC[1;32m%}A%{\ESC[39m%}6%{\ESC[1;32m%}D%{\ESC[39m%}4%{\ESC[1;32m%}M%{\ESC[39m%}7%{\ESC[1;32m%}R%{\ESC[39m%} 3%{\ESC[1;31m%}D%{\ESC[39m%}1%{\ESC[1;31m%}M%{\ESC[39m%} 2%{\ESC[1;37m%}A%{\ESC[39m%} 8%{\ESC[1;32m%}C%{\ESC[39m%} 3%{\ESC[1;32m%}\8801%{\ESC[39m%} " + + , testCase "w/out merge branch commits info" $ + testWriterWithConfig + (buildOutputConfig ZSH repoStateForPartialPrompt defaultConfig { confShowPartMergeBranchCommitsDiff = False }) + buildPrompt + @?= "%{\ESC[39m%}\5812 [%{\ESC[39m%}branch%{\ESC[39m%}] 5%{\ESC[1;32m%}⥯%{\ESC[39m%}6 5%{\ESC[1;32m%}A%{\ESC[39m%}6%{\ESC[1;32m%}D%{\ESC[39m%}4%{\ESC[1;32m%}M%{\ESC[39m%}7%{\ESC[1;32m%}R%{\ESC[39m%} 3%{\ESC[1;31m%}D%{\ESC[39m%}1%{\ESC[1;31m%}M%{\ESC[39m%} 2%{\ESC[1;37m%}A%{\ESC[39m%} 8%{\ESC[1;32m%}C%{\ESC[39m%} 3%{\ESC[1;32m%}\8801%{\ESC[39m%} " + + , testCase "w/out local branch info" $ + testWriterWithConfig + (buildOutputConfig ZSH repoStateForPartialPrompt defaultConfig { confShowPartLocalBranch = False }) + buildPrompt + @?= "%{\ESC[39m%}\5812 \120366 2%{\ESC[1;32m%}\8644%{\ESC[39m%}1 5%{\ESC[1;32m%}⥯%{\ESC[39m%}6 5%{\ESC[1;32m%}A%{\ESC[39m%}6%{\ESC[1;32m%}D%{\ESC[39m%}4%{\ESC[1;32m%}M%{\ESC[39m%}7%{\ESC[1;32m%}R%{\ESC[39m%} 3%{\ESC[1;31m%}D%{\ESC[39m%}1%{\ESC[1;31m%}M%{\ESC[39m%} 2%{\ESC[1;37m%}A%{\ESC[39m%} 8%{\ESC[1;32m%}C%{\ESC[39m%} 3%{\ESC[1;32m%}\8801%{\ESC[39m%} " + + , testCase "with a branch set to ignore its merge branch" $ + testWriterWithConfig + (buildOutputConfig ZSH repoStateForPartialPrompt defaultConfig { confMergeBranchIgnoreBranches = ["branch"] }) + buildPrompt + @?= "%{\ESC[39m%}\5812 [%{\ESC[39m%}branch%{\ESC[39m%}] 5%{\ESC[1;32m%}⥯%{\ESC[39m%}6 5%{\ESC[1;32m%}A%{\ESC[39m%}6%{\ESC[1;32m%}D%{\ESC[39m%}4%{\ESC[1;32m%}M%{\ESC[39m%}7%{\ESC[1;32m%}R%{\ESC[39m%} 3%{\ESC[1;31m%}D%{\ESC[39m%}1%{\ESC[1;31m%}M%{\ESC[39m%} 2%{\ESC[1;37m%}A%{\ESC[39m%} 8%{\ESC[1;32m%}C%{\ESC[39m%} 3%{\ESC[1;32m%}\8801%{\ESC[39m%} " + + , testCase "w/out commits push/pull info" $ + testWriterWithConfig + (buildOutputConfig ZSH repoStateForPartialPrompt defaultConfig { confShowPartCommitsToOrigin = False }) + buildPrompt + @?= "%{\ESC[39m%}\5812 \120366 2%{\ESC[1;32m%}\8644%{\ESC[39m%}1 [%{\ESC[39m%}branch%{\ESC[39m%}] 5%{\ESC[1;32m%}A%{\ESC[39m%}6%{\ESC[1;32m%}D%{\ESC[39m%}4%{\ESC[1;32m%}M%{\ESC[39m%}7%{\ESC[1;32m%}R%{\ESC[39m%} 3%{\ESC[1;31m%}D%{\ESC[39m%}1%{\ESC[1;31m%}M%{\ESC[39m%} 2%{\ESC[1;37m%}A%{\ESC[39m%} 8%{\ESC[1;32m%}C%{\ESC[39m%} 3%{\ESC[1;32m%}\8801%{\ESC[39m%} " + + , testCase "w/out local repo changes" $ + testWriterWithConfig + (buildOutputConfig ZSH repoStateForPartialPrompt defaultConfig { confShowPartLocalChangesState = False }) + buildPrompt + @?= "%{\ESC[39m%}\5812 \120366 2%{\ESC[1;32m%}\8644%{\ESC[39m%}1 [%{\ESC[39m%}branch%{\ESC[39m%}] 5%{\ESC[1;32m%}⥯%{\ESC[39m%}6 3%{\ESC[1;32m%}\8801%{\ESC[39m%} " + + , testCase "w/out stashes" $ + testWriterWithConfig + (buildOutputConfig ZSH repoStateForPartialPrompt defaultConfig { confShowPartStashes = False }) + buildPrompt + @?= "%{\ESC[39m%}\5812 \120366 2%{\ESC[1;32m%}\8644%{\ESC[39m%}1 [%{\ESC[39m%}branch%{\ESC[39m%}] 5%{\ESC[1;32m%}⥯%{\ESC[39m%}6 5%{\ESC[1;32m%}A%{\ESC[39m%}6%{\ESC[1;32m%}D%{\ESC[39m%}4%{\ESC[1;32m%}M%{\ESC[39m%}7%{\ESC[1;32m%}R%{\ESC[39m%} 3%{\ESC[1;31m%}D%{\ESC[39m%}1%{\ESC[1;31m%}M%{\ESC[39m%} 2%{\ESC[1;37m%}A%{\ESC[39m%} 8%{\ESC[1;32m%}C%{\ESC[39m%} " + ] + +-- | Utility function to test a ShellOutput function and gets the prompt built +testWriterWithConfig :: OutputConfig -- ^ Starting reader state + -> ShellOutput -- ^ Function under test + -> String -- ^ Output of the function for the given config +testWriterWithConfig config functionUnderTest = + runReader (runWriterT functionUnderTest >>= (\(_, out) -> return out)) config + +zeroOutputConfig :: Shell + -> OutputConfig +zeroOutputConfig shell = buildOutputConfig shell zeroGitRepoState defaultConfig + +testMergeBranchCommitsToPull :: Shell -> Config -> String +testMergeBranchCommitsToPull shell config = testWriterWithConfig + (buildOutputConfig shell (zeroGitRepoState { gitMergeBranchCommitsToPull = 2 }) config) + addMergeBranchCommits + +testMergeBranchCommitsToPush :: Shell -> Config -> String +testMergeBranchCommitsToPush shell config = testWriterWithConfig + (buildOutputConfig shell (zeroGitRepoState { gitMergeBranchCommitsToPush = 2 }) config) + addMergeBranchCommits + +testMergeBranchCommitsToPushAndPull :: Shell -> Config -> String +testMergeBranchCommitsToPushAndPull shell config = testWriterWithConfig + (buildOutputConfig shell + (zeroGitRepoState { gitMergeBranchCommitsToPull = 4, gitMergeBranchCommitsToPush = 4 }) + config + ) + addMergeBranchCommits + +testCommitsToPull :: Shell -> Config -> String +testCommitsToPull shell config = testWriterWithConfig + (buildOutputConfig shell (zeroGitRepoState { gitCommitsToPull = 2 }) config) + addLocalCommits + +testCommitsToPush :: Shell -> Config -> String +testCommitsToPush shell config = testWriterWithConfig + (buildOutputConfig shell (zeroGitRepoState { gitCommitsToPush = 2 }) config) + addLocalCommits + +testCommitsToPushAndPull :: Shell -> Config -> String +testCommitsToPushAndPull shell config = testWriterWithConfig + (buildOutputConfig shell + (zeroGitRepoState { gitCommitsToPull = 4, gitCommitsToPush = 4 }) + config + ) + addLocalCommits + +testLocalAddChange :: Shell -> Config -> String +testLocalAddChange shell config = testWriterWithConfig + (buildOutputConfig shell + (zeroGitRepoState { gitLocalRepoChanges = + (zeroLocalRepoChanges { localAdd = 2 }) + }) + config + ) + addRepoState + +testLocalModChange :: Shell -> Config -> String +testLocalModChange shell config = testWriterWithConfig + (buildOutputConfig shell + (zeroGitRepoState { gitLocalRepoChanges = + (zeroLocalRepoChanges { localMod = 2 }) + }) + config + ) + addRepoState + +testLocalDelChange :: Shell -> Config -> String +testLocalDelChange shell config = testWriterWithConfig + (buildOutputConfig shell + (zeroGitRepoState { gitLocalRepoChanges = + (zeroLocalRepoChanges { localDel = 2 }) + }) + config + ) + addRepoState + +testIndexAddChange :: Shell -> Config -> String +testIndexAddChange shell config = testWriterWithConfig + (buildOutputConfig shell + (zeroGitRepoState { gitLocalRepoChanges = + (zeroLocalRepoChanges { indexAdd = 2 }) + }) + config + ) + addRepoState + +testIndexModChange :: Shell -> Config -> String +testIndexModChange shell config = testWriterWithConfig + (buildOutputConfig shell + (zeroGitRepoState { gitLocalRepoChanges = + (zeroLocalRepoChanges { indexMod = 2 }) + }) + config + ) + addRepoState + +testIndexDelChange :: Shell -> Config -> String +testIndexDelChange shell config = testWriterWithConfig + (buildOutputConfig shell + (zeroGitRepoState { gitLocalRepoChanges = + (zeroLocalRepoChanges { indexDel = 2 }) + }) + config + ) + addRepoState + +testConflictedChange :: Shell -> Config -> String +testConflictedChange shell config = testWriterWithConfig + (buildOutputConfig shell + (zeroGitRepoState { gitLocalRepoChanges = + (zeroLocalRepoChanges { conflict = 2 }) + }) + config + ) + addRepoState + +testRenamedChange :: Shell -> Config -> String +testRenamedChange shell config = testWriterWithConfig + (buildOutputConfig shell + (zeroGitRepoState { gitLocalRepoChanges = + (zeroLocalRepoChanges { renamed = 2 }) + }) + config + ) + addRepoState + +testEveryRepoChange :: Shell -> Config -> String +testEveryRepoChange shell config = testWriterWithConfig + (buildOutputConfig shell + (zeroGitRepoState { gitLocalRepoChanges = + (zeroLocalRepoChanges { renamed = 1 + , conflict = 2 + , localAdd = 3 + , localMod = 4 + , localDel = 5 + , indexAdd = 6 + , indexMod = 7 + , indexDel = 8 + }) + }) + config + ) + addRepoState