githud (empty) → 2.0.0
raw patch · 27 files changed
+3000/−0 lines, 27 filesdep +basedep +githuddep +mtlsetup-changed
Dependencies added: base, githud, mtl, parsec, process, tasty, tasty-hunit, tasty-quickcheck, tasty-smallcheck, text, unix
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- app/Main.hs +6/−0
- githud.cabal +74/−0
- src/GitHUD.hs +54/−0
- src/GitHUD/Config/Parse.hs +289/−0
- src/GitHUD/Config/Types.hs +149/−0
- src/GitHUD/Git/Command.hs +98/−0
- src/GitHUD/Git/Common.hs +16/−0
- src/GitHUD/Git/Parse/Base.hs +103/−0
- src/GitHUD/Git/Parse/Branch.hs +29/−0
- src/GitHUD/Git/Parse/Count.hs +23/−0
- src/GitHUD/Git/Parse/Status.hs +149/−0
- src/GitHUD/Git/Types.hs +73/−0
- src/GitHUD/Process.hs +14/−0
- src/GitHUD/Terminal/Base.hs +73/−0
- src/GitHUD/Terminal/Prompt.hs +260/−0
- src/GitHUD/Terminal/Types.hs +9/−0
- src/GitHUD/Types.hs +51/−0
- test/Spec.hs +60/−0
- test/Test/GitHUD/Config/Parse.hs +497/−0
- test/Test/GitHUD/Git/Common.hs +20/−0
- test/Test/GitHUD/Git/Parse/Branch.hs +15/−0
- test/Test/GitHUD/Git/Parse/Status.hs +82/−0
- test/Test/GitHUD/Git/Types.hs +54/−0
- test/Test/GitHUD/Terminal/Base.hs +19/−0
- test/Test/GitHUD/Terminal/Prompt.hs +751/−0
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,6 @@+module Main where++import GitHUD++main :: IO ()+main = githud
+ githud.cabal view
@@ -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
+ src/GitHUD.hs view
@@ -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
+ src/GitHUD/Config/Parse.hs view
@@ -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"
+ src/GitHUD/Config/Types.hs view
@@ -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+}
+ src/GitHUD/Git/Command.hs view
@@ -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
+ src/GitHUD/Git/Common.hs view
@@ -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+
+ src/GitHUD/Git/Parse/Base.hs view
@@ -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)
+ src/GitHUD/Git/Parse/Branch.hs view
@@ -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++
+ src/GitHUD/Git/Parse/Count.hs view
@@ -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)+
+ src/GitHUD/Git/Parse/Status.hs view
@@ -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
+ src/GitHUD/Git/Types.hs view
@@ -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+ }
+ src/GitHUD/Process.hs view
@@ -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 ""+
+ src/GitHUD/Terminal/Base.hs view
@@ -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"
+ src/GitHUD/Terminal/Prompt.hs view
@@ -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 " "+
+ src/GitHUD/Terminal/Types.hs view
@@ -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)
+ src/GitHUD/Types.hs view
@@ -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) ()+
+ test/Spec.hs view
@@ -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+-- ]
+ test/Test/GitHUD/Config/Parse.hs view
@@ -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"]+ ]+
+ test/Test/GitHUD/Git/Common.hs view
@@ -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"+ ]
+ test/Test/GitHUD/Git/Parse/Branch.hs view
@@ -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"+ ]
+ test/Test/GitHUD/Git/Parse/Status.hs view
@@ -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"
+ test/Test/GitHUD/Git/Types.hs view
@@ -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+}
+ test/Test/GitHUD/Terminal/Base.hs view
@@ -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%}"++ ]
+ test/Test/GitHUD/Terminal/Prompt.hs view
@@ -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