gitHUD 1.0.0.0 → 1.1.0
raw patch · 15 files changed
+1866/−187 lines, 15 filesdep +unixPVP ok
version bump matches the API change (PVP)
Dependencies added: unix
API changes (from Hackage documentation)
- GitHUD.Terminal.Base: showStrInColor :: Color -> ColorIntensity -> String -> ShellOutput
- GitHUD.Terminal.Types: type ShellOutput = ReaderT Shell IO ()
+ GitHUD.Config.Parse: Comment :: ConfigItem
+ GitHUD.Config.Parse: ErrorLine :: ConfigItem
+ GitHUD.Config.Parse: Item :: String -> String -> ConfigItem
+ GitHUD.Config.Parse: colorConfigToColor :: String -> Color
+ GitHUD.Config.Parse: commentParser :: Parser ConfigItem
+ GitHUD.Config.Parse: configItemsFolder :: Config -> ConfigItem -> Config
+ GitHUD.Config.Parse: data ConfigItem
+ GitHUD.Config.Parse: fallThroughItemParser :: Parser ConfigItem
+ GitHUD.Config.Parse: instance GHC.Classes.Eq GitHUD.Config.Parse.ConfigItem
+ GitHUD.Config.Parse: instance GHC.Show.Show GitHUD.Config.Parse.ConfigItem
+ GitHUD.Config.Parse: intensityConfigToIntensity :: String -> ColorIntensity
+ GitHUD.Config.Parse: itemParser :: Parser ConfigItem
+ GitHUD.Config.Parse: parseConfigFile :: FilePath -> IO Config
+ GitHUD.Config.Types: Config :: String -> String -> String -> Color -> ColorIntensity -> String -> String -> String -> String -> String -> String -> String -> Color -> ColorIntensity -> Color -> ColorIntensity -> String -> Color -> ColorIntensity -> String -> Color -> ColorIntensity -> String -> Color -> ColorIntensity -> String -> Color -> ColorIntensity -> String -> Color -> ColorIntensity -> String -> Color -> ColorIntensity -> String -> Color -> ColorIntensity -> String -> Color -> ColorIntensity -> String -> Color -> ColorIntensity -> String -> Color -> ColorIntensity -> String -> Color -> ColorIntensity -> String -> Color -> ColorIntensity -> Config
+ GitHUD.Config.Types: [confChangeConflictedSuffixColor] :: Config -> Color
+ GitHUD.Config.Types: [confChangeConflictedSuffixIntensity] :: Config -> ColorIntensity
+ GitHUD.Config.Types: [confChangeConflictedSuffix] :: Config -> String
+ GitHUD.Config.Types: [confChangeIndexAddSuffixColor] :: Config -> Color
+ GitHUD.Config.Types: [confChangeIndexAddSuffixIntensity] :: Config -> ColorIntensity
+ GitHUD.Config.Types: [confChangeIndexAddSuffix] :: Config -> String
+ GitHUD.Config.Types: [confChangeIndexDelSuffixColor] :: Config -> Color
+ GitHUD.Config.Types: [confChangeIndexDelSuffixIntensity] :: Config -> ColorIntensity
+ GitHUD.Config.Types: [confChangeIndexDelSuffix] :: Config -> String
+ GitHUD.Config.Types: [confChangeIndexModSuffixColor] :: Config -> Color
+ GitHUD.Config.Types: [confChangeIndexModSuffixIntensity] :: Config -> ColorIntensity
+ GitHUD.Config.Types: [confChangeIndexModSuffix] :: Config -> String
+ GitHUD.Config.Types: [confChangeLocalAddSuffixColor] :: Config -> Color
+ GitHUD.Config.Types: [confChangeLocalAddSuffixIntensity] :: Config -> ColorIntensity
+ GitHUD.Config.Types: [confChangeLocalAddSuffix] :: Config -> String
+ GitHUD.Config.Types: [confChangeLocalDelSuffixColor] :: Config -> Color
+ GitHUD.Config.Types: [confChangeLocalDelSuffixIntensity] :: Config -> ColorIntensity
+ GitHUD.Config.Types: [confChangeLocalDelSuffix] :: Config -> String
+ GitHUD.Config.Types: [confChangeLocalModSuffixColor] :: Config -> Color
+ GitHUD.Config.Types: [confChangeLocalModSuffixIntensity] :: Config -> ColorIntensity
+ GitHUD.Config.Types: [confChangeLocalModSuffix] :: Config -> String
+ GitHUD.Config.Types: [confChangeRenamedSuffixColor] :: Config -> Color
+ GitHUD.Config.Types: [confChangeRenamedSuffixIntensity] :: Config -> ColorIntensity
+ GitHUD.Config.Types: [confChangeRenamedSuffix] :: Config -> String
+ GitHUD.Config.Types: [confLocalBranchColor] :: Config -> Color
+ GitHUD.Config.Types: [confLocalBranchIntensity] :: Config -> ColorIntensity
+ GitHUD.Config.Types: [confLocalBranchNamePrefix] :: Config -> String
+ GitHUD.Config.Types: [confLocalBranchNameSuffix] :: Config -> String
+ GitHUD.Config.Types: [confLocalCommitsPullSuffixColor] :: Config -> Color
+ GitHUD.Config.Types: [confLocalCommitsPullSuffixIntensity] :: Config -> ColorIntensity
+ GitHUD.Config.Types: [confLocalCommitsPullSuffix] :: Config -> String
+ GitHUD.Config.Types: [confLocalCommitsPushPullInfixColor] :: Config -> Color
+ GitHUD.Config.Types: [confLocalCommitsPushPullInfixIntensity] :: Config -> ColorIntensity
+ GitHUD.Config.Types: [confLocalCommitsPushPullInfix] :: Config -> String
+ GitHUD.Config.Types: [confLocalCommitsPushSuffixColor] :: Config -> Color
+ GitHUD.Config.Types: [confLocalCommitsPushSuffixIntensity] :: Config -> ColorIntensity
+ GitHUD.Config.Types: [confLocalCommitsPushSuffix] :: Config -> String
+ GitHUD.Config.Types: [confLocalDetachedColor] :: Config -> Color
+ GitHUD.Config.Types: [confLocalDetachedIntensity] :: Config -> ColorIntensity
+ GitHUD.Config.Types: [confLocalDetachedPrefix] :: Config -> String
+ GitHUD.Config.Types: [confNoUpstreamIndicatorColor] :: Config -> Color
+ GitHUD.Config.Types: [confNoUpstreamIndicatorIntensity] :: Config -> ColorIntensity
+ GitHUD.Config.Types: [confNoUpstreamIndicator] :: Config -> String
+ GitHUD.Config.Types: [confNoUpstreamString] :: Config -> String
+ GitHUD.Config.Types: [confRemoteCommitsBothPullPush] :: Config -> String
+ GitHUD.Config.Types: [confRemoteCommitsIndicator] :: Config -> String
+ GitHUD.Config.Types: [confRemoteCommitsOnlyPull] :: Config -> String
+ GitHUD.Config.Types: [confRemoteCommitsOnlyPush] :: Config -> String
+ GitHUD.Config.Types: [confRepoIndicator] :: Config -> String
+ GitHUD.Config.Types: [confStashSuffixColor] :: Config -> Color
+ GitHUD.Config.Types: [confStashSuffixIntensity] :: Config -> ColorIntensity
+ GitHUD.Config.Types: [confStashSuffix] :: Config -> String
+ GitHUD.Config.Types: data Config
+ GitHUD.Config.Types: defaultConfig :: Config
+ GitHUD.Config.Types: instance GHC.Classes.Eq GitHUD.Config.Types.Config
+ GitHUD.Config.Types: instance GHC.Show.Show GitHUD.Config.Types.Config
+ GitHUD.Terminal.Base: applyShellMarkers :: Shell -> String -> String
+ GitHUD.Terminal.Base: tellStringInColor :: Color -> ColorIntensity -> String -> ShellOutput
+ GitHUD.Terminal.Base: terminalEndCode :: String
+ GitHUD.Terminal.Base: terminalStartCode :: Color -> ColorIntensity -> String
+ GitHUD.Terminal.Prompt: addGitRepoIndicator :: ShellOutput
+ GitHUD.Terminal.Prompt: addLocalBranchName :: ShellOutput
+ GitHUD.Terminal.Prompt: addLocalCommits :: ShellOutput
+ GitHUD.Terminal.Prompt: addRemoteCommits :: ShellOutput
+ GitHUD.Terminal.Prompt: addRepoState :: ShellOutput
+ GitHUD.Terminal.Prompt: addStashes :: ShellOutput
+ GitHUD.Terminal.Prompt: addUpstreamIndicator :: ShellOutput
+ GitHUD.Terminal.Prompt: buildPromptWithConfig :: TerminalState
+ GitHUD.Terminal.Types: instance GHC.Classes.Eq GitHUD.Terminal.Types.Color
+ GitHUD.Terminal.Types: instance GHC.Classes.Eq GitHUD.Terminal.Types.ColorIntensity
+ GitHUD.Terminal.Types: instance GHC.Read.Read GitHUD.Terminal.Types.Color
+ GitHUD.Terminal.Types: instance GHC.Read.Read GitHUD.Terminal.Types.ColorIntensity
+ GitHUD.Terminal.Types: instance GHC.Show.Show GitHUD.Terminal.Types.Color
+ GitHUD.Terminal.Types: instance GHC.Show.Show GitHUD.Terminal.Types.ColorIntensity
+ GitHUD.Terminal.Types: instance GHC.Show.Show GitHUD.Terminal.Types.Shell
+ GitHUD.Types: OutputConfig :: Shell -> GitRepoState -> Config -> OutputConfig
+ GitHUD.Types: [_config] :: OutputConfig -> Config
+ GitHUD.Types: [_repoState] :: OutputConfig -> GitRepoState
+ GitHUD.Types: [_shell] :: OutputConfig -> Shell
+ GitHUD.Types: buildOutputConfig :: Shell -> GitRepoState -> Config -> OutputConfig
+ GitHUD.Types: data OutputConfig
+ GitHUD.Types: getConfig :: MonadReader OutputConfig m => m Config
+ GitHUD.Types: getRepoState :: MonadReader OutputConfig m => m GitRepoState
+ GitHUD.Types: getShell :: MonadReader OutputConfig m => m Shell
+ GitHUD.Types: type Prompt = String
+ GitHUD.Types: type ShellOutput = WriterT Prompt (Reader OutputConfig) ()
+ GitHUD.Types: type TerminalState = Reader OutputConfig String
Files
- gitHUD.cabal +14/−2
- src/GitHUD.hs +23/−153
- src/GitHUD/Config/Parse.hs +219/−0
- src/GitHUD/Config/Types.hs +129/−0
- src/GitHUD/Git/Parse/Base.hs +1/−0
- src/GitHUD/Terminal/Base.hs +30/−21
- src/GitHUD/Terminal/Prompt.hs +235/−0
- src/GitHUD/Terminal/Types.hs +3/−8
- src/GitHUD/Types.hs +51/−0
- test/Spec.hs +14/−3
- test/Test/GitHUD/Config/Parse.hs +429/−0
- test/Test/GitHUD/Git/Common.hs +20/−0
- test/Test/GitHUD/Git/Types.hs +54/−0
- test/Test/GitHUD/Terminal/Base.hs +19/−0
- test/Test/GitHUD/Terminal/Prompt.hs +625/−0
gitHUD.cabal view
@@ -1,5 +1,5 @@ name: gitHUD-version: 1.0.0.0+version: 1.1.0 synopsis: More efficient replacement to the great git-radar description: Please see README.md homepage: http://github.com/gbataille/gitHUD#readme@@ -16,7 +16,8 @@ library hs-source-dirs: src exposed-modules: GitHUD- , GitHUD.Process+ , GitHUD.Config.Parse+ , GitHUD.Config.Types , GitHUD.Git.Types , GitHUD.Git.Common , GitHUD.Git.Command@@ -24,12 +25,16 @@ , 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+ , unix >= 2.7 && < 3 default-language: Haskell2010 executable gitHUD@@ -49,11 +54,18 @@ , 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
src/GitHUD.hs view
@@ -2,26 +2,33 @@ githud ) where -import Control.Monad.Reader+import Control.Monad (when)+import Control.Monad.Reader (runReader) 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.Terminal.Base-import GitHUD.Git.Types import GitHUD.Git.Parse.Base import GitHUD.Git.Command+import GitHUD.Types githud :: IO () githud = do- shell <- processArguments getArgs-+ -- Exit ASAP if we are not in a git repository isGit <- checkInGitDirectory when isGit $ do+ shell <- processArguments getArgs+ config <- getAppConfig repoState <- getGitRepoState- runReaderT (buildOutput repoState) shell- -- Necessary to properly terminate the output- putStrLn ""+ let prompt = runReader buildPromptWithConfig $ buildOutputConfig shell repoState config + -- Necessary to use putStrLn to properly terminate the output (needs the CR)+ putStrLn prompt+ processArguments :: IO [String] -> IO Shell processArguments args = do@@ -30,148 +37,11 @@ then return ZSH else return Other -buildOutput :: GitRepoState- -> ShellOutput-buildOutput repoState = do- outputGitRepoIndicator- outputUpstreamAbsence (gitRemoteTrackingBranch repoState)- outputRCommits (gitRemoteCommitsToPull repoState) (gitRemoteCommitsToPush repoState)- outputLocalBranchName (gitLocalBranch repoState) (gitCommitShortSHA repoState)- outputCommitsToPullPush (gitCommitsToPull repoState) (gitCommitsToPush repoState)- outputRepoState (gitLocalRepoChanges repoState)- outputStashCount (gitStashCount repoState)---- | Requires patched fonts for Powerline (Monaco Powerline)-outputGitRepoIndicator :: ShellOutput-outputGitRepoIndicator = do- liftIO $ do- putChar '\57504'- putChar ' '--outputUpstreamAbsence :: String -> ShellOutput-outputUpstreamAbsence remoteTrackingBranch =- when (remoteTrackingBranch == "") $ do- liftIO . putStr $ "upstream "- showStrInColor Red Vivid "\9889"- liftIO . putChar $ ' '--outputLocalBranchName :: String -- ^ the local branch name- -> String -- ^ the HEAD commit short sha- -> ShellOutput-outputLocalBranchName localBranchName commitSHA = do- if (localBranchName /= "")- then liftIO $ do- putStr "["- mapM_ putStr (lines localBranchName)- putStr "]"- putStr " "- else do- liftIO . putStr $ "["- showStrInColor Yellow Vivid "detached@"- showStrInColor Yellow Vivid commitSHA- liftIO . putStr $ "]"- liftIO . putStr $ " "--outputcommitsToPush :: Int- -> ShellOutput-outputcommitsToPush commitCount = do- when (commitCount > 0) $ do- liftIO . putStr . show $ commitCount- showStrInColor Green Vivid "\8593"--outputcommitsToPull :: Int- -> ShellOutput-outputcommitsToPull commitCount = do- when (commitCount > 0) $ do- liftIO . putStr . show $ commitCount- showStrInColor Red Vivid "\8595"--outputRCommits :: Int -- ^ commits to pull- -> Int -- ^ commits to push- -> ShellOutput-outputRCommits pull push = do- if (pull > 0) && (push > 0)- then do- liftIO . putStr $ "\120366 "- liftIO . putStr . show $ pull- showStrInColor Green Vivid "\8644"- liftIO . putStr . show $ push- else (- if (pull > 0)- then do- liftIO . putStr $ "\120366 "- showStrInColor Green Vivid "\8594"- liftIO . putStr $ " "- liftIO . putStr . show $ pull- else (- when (push > 0) $ do- liftIO . putStr $ "\120366 "- showStrInColor Green Vivid "\8592"- liftIO . putStr $ " "- liftIO . putStr . show $ push- )- )-- when ((pull > 0) || (push > 0)) . liftIO . putStr $ " "--outputCommitsToPullPush :: Int -- ^ commits to pull- -> Int -- ^ commits to push- -> ShellOutput-outputCommitsToPullPush pull push = do- if (pull > 0) && (push > 0)- then do- liftIO . putStr . show $ pull- showStrInColor Green Vivid "\8645"- liftIO . putStr . show $ push- else- if (pull > 0)- then outputcommitsToPull pull- else- when (push > 0) $ outputcommitsToPush push-- when ((pull > 0) || (push > 0)) . liftIO . putStr $ " "--outputStashCount :: Int- -> ShellOutput-outputStashCount stashCount = do- when (stashCount /= 0) $ do- liftIO . putStr . show $ stashCount- showStrInColor Green Vivid "≡ "--outputRepoState :: GitLocalRepoChanges- -> ShellOutput-outputRepoState repoState = do- showElem indexAdd repoState Green Vivid "A"- showElem indexDel repoState Green Vivid "D"- showElem indexMod repoState Green Vivid "M"- showElem renamed repoState Green Vivid "R"- when ((indexAdd repoState > 0) || (indexDel repoState > 0) || (indexMod repoState > 0) || (renamed repoState > 0)) . liftIO . putStr $ " "-- showElem localDel repoState Red Vivid "D"- showElem localMod repoState Red Vivid "M"- when ((localDel repoState > 0) || (localMod repoState > 0)) . liftIO . putStr $ " "-- showElem localAdd repoState White Vivid "A"- when (localAdd repoState > 0) . liftIO . putStr $ " "-- showElem conflict repoState Green Vivid "C"- when (conflict repoState > 0) . liftIO . putStr $ " "--showElem :: (GitLocalRepoChanges -> Int)- -> GitLocalRepoChanges- -> Color- -> ColorIntensity- -> String- -> ShellOutput-showElem elemFunc repoState color intensity letter = do- let num = elemFunc repoState- when (num > 0) $ showNumState num color intensity letter--showNumState :: Int- -> Color- -> ColorIntensity- -> String- -> ShellOutput-showNumState num color intensity letter = do- liftIO . putStr . show $ num- showStrInColor color intensity letter+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,219 @@+module GitHUD.Config.Parse (+ parseConfigFile+ , commentParser+ , itemParser+ , fallThroughItemParser+ , configItemsFolder+ , ConfigItem(..)+ , colorConfigToColor+ , intensityConfigToIntensity+ ) where++import Control.Monad (void, when)+import Text.Parsec (parse)+import Text.Parsec.Char (anyChar, char, newline, letter, string)+import Text.Parsec.Combinator (choice, eof, manyTill)+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 "git_repo_indicator" repoIndicator) = conf { confRepoIndicator = repoIndicator }++configItemsFolder conf (Item "no_upstream_text" noUpstreamText) =+ conf { confNoUpstreamString = noUpstreamText }+configItemsFolder conf (Item "no_upstream_indicator" noUpstreamIndicator) =+ conf { confNoUpstreamIndicator = noUpstreamIndicator }+configItemsFolder conf (Item "no_upstream_indicator_color" noUpstreamIndColor) =+ conf { confNoUpstreamIndicatorColor = colorConfigToColor noUpstreamIndColor }+configItemsFolder conf (Item "no_upstream_indicator_intensity" noUpstreamIndIntensity) =+ conf { confNoUpstreamIndicatorIntensity = intensityConfigToIntensity noUpstreamIndIntensity }++configItemsFolder conf (Item "remote_commits_indicator" value) =+ conf { confRemoteCommitsIndicator = value }+configItemsFolder conf (Item "remote_commits_pull_prefix" value) =+ conf { confRemoteCommitsOnlyPull = value }+configItemsFolder conf (Item "remote_commits_push_prefix" value) =+ conf { confRemoteCommitsOnlyPush = value }+configItemsFolder conf (Item "remote_commits_push_pull_infix" value) =+ conf { confRemoteCommitsBothPullPush = 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 Blue)+ 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+ ] <?> "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"
+ src/GitHUD/Config/Types.hs view
@@ -0,0 +1,129 @@+module GitHUD.Config.Types (+ Config(..)+ , defaultConfig+ ) where++import GitHUD.Terminal.Types++data Config = Config {+ confRepoIndicator :: String++ , confNoUpstreamString :: String+ , confNoUpstreamIndicator :: String+ , confNoUpstreamIndicatorColor :: Color+ , confNoUpstreamIndicatorIntensity :: ColorIntensity++ , confRemoteCommitsIndicator :: String+ , confRemoteCommitsOnlyPush :: String+ , confRemoteCommitsOnlyPull :: String+ , confRemoteCommitsBothPullPush :: 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 {+ confRepoIndicator = "\57504"++ , confNoUpstreamString = "upstream"+ , confNoUpstreamIndicator = "\9889"+ , confNoUpstreamIndicatorColor = Red+ , confNoUpstreamIndicatorIntensity = Vivid++ , confRemoteCommitsIndicator = "\120366"+ , confRemoteCommitsOnlyPush = "\8592"+ , confRemoteCommitsOnlyPull = "\8594"+ , confRemoteCommitsBothPullPush = "\8644"++ , confLocalBranchNamePrefix = "["+ , confLocalBranchNameSuffix = "]"+ , confLocalDetachedPrefix = "detached@"+ , confLocalBranchColor = Blue+ , confLocalBranchIntensity = Vivid+ , confLocalDetachedColor = Yellow+ , confLocalDetachedIntensity = Vivid++ , confLocalCommitsPushSuffix = "\8593"+ , confLocalCommitsPushSuffixColor = Green+ , confLocalCommitsPushSuffixIntensity = Vivid+ , confLocalCommitsPullSuffix = "\8595"+ , confLocalCommitsPullSuffixColor = Red+ , confLocalCommitsPullSuffixIntensity = Vivid+ , confLocalCommitsPushPullInfix = "\8645"+ , 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/Parse/Base.hs view
@@ -2,6 +2,7 @@ getGitRepoState ) where +import Control.Applicative ((<$>)) import Control.Concurrent (forkIO) import Control.Concurrent.MVar (newEmptyMVar, takeMVar)
src/GitHUD/Terminal/Base.hs view
@@ -1,34 +1,43 @@ module GitHUD.Terminal.Base (- showStrInColor+ tellStringInColor+ , applyShellMarkers+ , terminalEndCode+ , terminalStartCode ) where -import Control.Monad.Reader+import Control.Monad.Writer (tell)+import Data.Monoid (mappend) +import GitHUD.Types import GitHUD.Terminal.Types -showStrInColor :: Color -- ^ The terminal color to use- -> ColorIntensity -- ^ The intensity to use- -> String -- ^ The string to output- -> ShellOutput-showStrInColor color intensity str = do- shell <- ask- liftIO $ outputStrInColor color intensity str shell+tellStringInColor :: Color -- ^ The terminal color to use+ -> ColorIntensity -- ^ The intensity to use+ -> String -- ^ The string to output+ -> ShellOutput+tellStringInColor color intensity str = do+ shell <- getShell+ tell $ startColorMarker color intensity shell+ tell $ str+ tell $ endColorMarker shell -outputStrInColor :: Color+startColorMarker :: Color -> ColorIntensity- -> String -> Shell- -> IO()-outputStrInColor color intensity str shell = do- let startCode = terminalStartCode color intensity- if (shell == ZSH)- then putStr $ zshMarkZeroWidth startCode- else putStr $ startCode+ -> String+startColorMarker color intensity shell =+ applyShellMarkers shell $ terminalStartCode color intensity - putStr str- if (shell == ZSH)- then putStr $ zshMarkZeroWidth terminalEndCode- else putStr $ terminalEndCode+endColorMarker :: Shell+ -> String+endColorMarker shell =+ applyShellMarkers shell $ terminalEndCode++applyShellMarkers :: Shell+ -> String+ -> String+applyShellMarkers ZSH = zshMarkZeroWidth+applyShellMarkers _ = id zshMarkZeroWidth :: String -> String
+ src/GitHUD/Terminal/Prompt.hs view
@@ -0,0 +1,235 @@+module GitHUD.Terminal.Prompt (+ buildPromptWithConfig+ , addGitRepoIndicator+ , addUpstreamIndicator+ , addRemoteCommits+ , addLocalBranchName+ , addLocalCommits+ , addRepoState+ , addStashes+ ) where++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+ addGitRepoIndicator+ addUpstreamIndicator+ addRemoteCommits+ addLocalBranchName+ addLocalCommits+ addRepoState+ addStashes+ return ()++addGitRepoIndicator :: ShellOutput+addGitRepoIndicator = do+ config <- getConfig+ tell $ confRepoIndicator config+ tell " "++addUpstreamIndicator :: ShellOutput+addUpstreamIndicator = do+ repoState <- getRepoState+ config <- getConfig+ when (gitRemoteTrackingBranch repoState == "") $ do+ tell $ confNoUpstreamString config+ tell " "+ tellStringInColor+ (confNoUpstreamIndicatorColor config)+ (confNoUpstreamIndicatorIntensity config)+ (confNoUpstreamIndicator config)+ tell " "+ return ()++addRemoteCommits :: ShellOutput+addRemoteCommits = do+ repoState <- getRepoState+ config <- getConfig+ let push = gitRemoteCommitsToPush repoState+ let pull = gitRemoteCommitsToPull repoState+ if (push > 0) && (pull > 0)+ then do+ tell (confRemoteCommitsIndicator config)+ tell " "+ tell . show $ pull+ tellStringInColor Green Vivid (confRemoteCommitsBothPullPush config)+ tell . show $ push+ else (+ if (pull > 0)+ then do+ tell (confRemoteCommitsIndicator config)+ tell " "+ tellStringInColor Green Vivid (confRemoteCommitsOnlyPull config)+ tell " "+ tell . show $ pull+ else (+ when (push > 0) $ do+ tell (confRemoteCommitsIndicator config)+ tell " "+ tellStringInColor Green Vivid (confRemoteCommitsOnlyPush config)+ tell " "+ tell . show $ push+ )+ )+ addSpaceIfAnyBiggerThanZero [pull, push]+ return ()++addLocalBranchName :: ShellOutput+addLocalBranchName = do+ repoState <- getRepoState+ config <- getConfig+ let localBranchName = gitLocalBranch repoState+ tell (confLocalBranchNamePrefix config)++ if (localBranchName /= "")+ then do+ tellStringInColor (confLocalBranchColor config) (confLocalBranchIntensity config) $+ localBranchName+ else do+ tellStringInColor (confLocalDetachedColor config) (confLocalDetachedIntensity config) $+ (confLocalDetachedPrefix config) ++ (gitCommitShortSHA repoState)++ tell (confLocalBranchNameSuffix config)+ tell " "+ return ()++addLocalCommits :: ShellOutput+addLocalCommits = do+ repoState <- getRepoState+ config <- getConfig+ 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 <- getRepoState+ config <- getConfig+ 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 <- getRepoState+ config <- getConfig+ 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
@@ -2,13 +2,8 @@ Color(..) , ColorIntensity(..) , Shell(..)- , ShellOutput(..) ) where -import Control.Monad.Reader--data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White-data ColorIntensity = Dull | Vivid-data Shell = ZSH | Other deriving (Eq)-type ShellOutput = ReaderT Shell IO ()-+data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White deriving (Eq, Show, Read)+data ColorIntensity = Dull | Vivid deriving (Eq, Show, Read)+data Shell = ZSH | Other deriving (Eq, Show)
+ src/GitHUD/Types.hs view
@@ -0,0 +1,51 @@+{-# Language FlexibleContexts #-}++module GitHUD.Types (+ OutputConfig(..)+ , buildOutputConfig+ , Prompt+ , TerminalState+ , ShellOutput+ , getShell+ , getRepoState+ , getConfig+ ) where++import Control.Monad.Reader (Reader, MonadReader, ask, liftM)+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+}++getShell :: MonadReader OutputConfig m => m Shell+getShell = liftM _shell $ ask++getRepoState :: MonadReader OutputConfig m => m GitRepoState+getRepoState = liftM _repoState $ ask++getConfig :: MonadReader OutputConfig m => m Config+getConfig = liftM _config $ ask++type Prompt = String++type TerminalState = Reader OutputConfig String++type ShellOutput = WriterT Prompt (Reader OutputConfig) ()+
test/Spec.hs view
@@ -1,15 +1,26 @@ import Test.Tasty--- import Test.Tasty.SmallCheck as SC--- import Test.Tasty.QuickCheck as QC +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]+tests = testGroup "Tests"+ [ statusTests+ , branchTests+ , gitTypesTests+ , gitCommonTests+ , terminalTests+ , terminalPromptTests+ , configParserTests+ ] -- -- tests :: TestTree -- tests = testGroup "Tests" [properties, unitTests]
+ test/Test/GitHUD/Config/Parse.hs view
@@ -0,0 +1,429 @@+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+ ]++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 "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_upstream_text" $+ expectValue "foo" $+ toBeInField confNoUpstreamString $+ forConfigItemKey "no_upstream_text" $+ withValue "foo"++ , testCase "Key: no_upstream_indicator" $+ expectValue "foo" $+ toBeInField confNoUpstreamIndicator $+ forConfigItemKey "no_upstream_indicator" $+ withValue "foo"++ , testCase "Key: no_upstream_indicator_color" $+ expectValue Black $+ toBeInField confNoUpstreamIndicatorColor $+ forConfigItemKey "no_upstream_indicator_color" $+ withValue "Black"++ , testCase "Key: no_upstream_indicator_color - invalid color" $+ expectValue Blue $+ toBeInField confNoUpstreamIndicatorColor $+ forConfigItemKey "no_upstream_indicator_color" $+ withValue "FOO"++ , testCase "Key: no_upstream_indicator_intensity" $+ expectValue Dull $+ toBeInField confNoUpstreamIndicatorIntensity $+ forConfigItemKey "no_upstream_indicator_intensity" $+ withValue "Dull"++ , testCase "Key: no_upstream_indicator_intensity - invalid intensity" $+ expectValue Vivid $+ toBeInField confNoUpstreamIndicatorIntensity $+ forConfigItemKey "no_upstream_indicator_intensity" $+ withValue "FOO"++ , testCase "Key: remote_commits_indicator" $+ expectValue "FOO" $+ toBeInField confRemoteCommitsIndicator $+ forConfigItemKey "remote_commits_indicator" $+ withValue "FOO"++ , testCase "Key: remote_commits_pull_prefix" $+ expectValue "FOO" $+ toBeInField confRemoteCommitsOnlyPull $+ forConfigItemKey "remote_commits_pull_prefix" $+ withValue "FOO"++ , testCase "Key: remote_commits_push_prefix" $+ expectValue "FOO" $+ toBeInField confRemoteCommitsOnlyPush $+ forConfigItemKey "remote_commits_push_prefix" $+ withValue "FOO"++ , testCase "Key: remote_commits_push_pull_infix" $+ expectValue "FOO" $+ toBeInField confRemoteCommitsBothPullPush $+ forConfigItemKey "remote_commits_push_pull_infix" $+ withValue "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" @?= Blue+ ]
+ 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/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,625 @@+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"+ [ testAddGitRepoIndicator+ , testAddUpstreamIndicator+ , testAddRemoteCommits+ , testAddLocalBranchName+ , testAddLocalCommits+ , testAddRepoState+ , testAddStashes+ ]++testAddGitRepoIndicator :: TestTree+testAddGitRepoIndicator = testGroup "#addGitRepoIndicator"+ [ testGroup "Default Config"+ [ testCase "ZSH: default config: hardcoded character" $+ testWriterWithConfig (zeroOutputConfig ZSH) addGitRepoIndicator @?= "\57504 "++ , testCase "Other: default config: hardcoded character" $+ testWriterWithConfig (zeroOutputConfig Other) addGitRepoIndicator @?= "\57504 "+ ]+ , 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 "+ ]+ ]++customConfigUpstreamIndicator :: Config+customConfigUpstreamIndicator = defaultConfig {+ confNoUpstreamString = "foo"+ , confNoUpstreamIndicator = "bar"+ , confNoUpstreamIndicatorColor = Green+ , confNoUpstreamIndicatorIntensity = Dull+}++testAddUpstreamIndicator :: TestTree+testAddUpstreamIndicator = testGroup "#addUpstreamIndicator"+ [ testGroup "Default Config"+ [ testCase "ZSH: with an upstream" $+ testWriterWithConfig+ (buildOutputConfig ZSH (zeroGitRepoState { gitRemoteTrackingBranch = "foo" }) defaultConfig)+ addUpstreamIndicator+ @?= ""++ , testCase "Other: with an upstream" $+ testWriterWithConfig+ (buildOutputConfig Other (zeroGitRepoState { gitRemoteTrackingBranch = "foo" }) defaultConfig)+ addUpstreamIndicator+ @?= ""++ , testCase "ZSH: with no upstream" $+ testWriterWithConfig+ (zeroOutputConfig ZSH) addUpstreamIndicator+ @?= "upstream %{\x1b[1;31m%}\9889%{\x1b[0m%} "++ , testCase "Other: with no upstream" $+ testWriterWithConfig+ (zeroOutputConfig Other) addUpstreamIndicator+ @?= "upstream \x1b[1;31m\9889\x1b[0m "+ ]+ , testGroup "Custom Config"+ [ testCase "ZSH: with an upstream" $+ testWriterWithConfig+ (buildOutputConfig ZSH (zeroGitRepoState { gitRemoteTrackingBranch = "foo" }) customConfigUpstreamIndicator)+ addUpstreamIndicator+ @?= ""++ , testCase "Other: with an upstream" $+ testWriterWithConfig+ (buildOutputConfig Other (zeroGitRepoState { gitRemoteTrackingBranch = "foo" }) customConfigUpstreamIndicator)+ addUpstreamIndicator+ @?= ""++ , testCase "ZSH: with no upstream" $+ testWriterWithConfig+ (buildOutputConfig ZSH (zeroGitRepoState) customConfigUpstreamIndicator)+ addUpstreamIndicator+ @?= "foo %{\x1b[32m%}bar%{\x1b[0m%} "++ , testCase "Other: with no upstream" $+ testWriterWithConfig+ (buildOutputConfig Other (zeroGitRepoState) customConfigUpstreamIndicator)+ addUpstreamIndicator+ @?= "foo \x1b[32mbar\x1b[0m "+ ]+ ]++customConfigRemoteCommits :: Config+customConfigRemoteCommits = defaultConfig {+ confRemoteCommitsIndicator = "foo"+ , confRemoteCommitsOnlyPull = "pull"+ , confRemoteCommitsOnlyPush = "push"+ , confRemoteCommitsBothPullPush = "pull-push"+}++testAddRemoteCommits :: TestTree+testAddRemoteCommits = testGroup "#addRemoteCommits"+ [ testGroup "Default Config"+ [ testCase "ZSH: commits to pull" $+ testRemoteCommitsToPull ZSH defaultConfig @?=+ "\120366 %{\x1b[1;32m%}\8594%{\x1b[0m%} 2 "++ , testCase "ZSH: commits to push" $+ testRemoteCommitsToPush ZSH defaultConfig @?=+ "\120366 %{\x1b[1;32m%}\8592%{\x1b[0m%} 2 "++ , testCase "ZSH: commits to pull and to push" $+ testRemoteCommitsToPushAndPull ZSH defaultConfig @?=+ "\120366 4%{\x1b[1;32m%}\8644%{\x1b[0m%}4 "++ , testCase "Other: commits to pull" $+ testRemoteCommitsToPull Other defaultConfig @?=+ "\120366 \x1b[1;32m\8594\x1b[0m 2 "++ , testCase "Other: commits to push" $+ testRemoteCommitsToPush Other defaultConfig @?=+ "\120366 \x1b[1;32m\8592\x1b[0m 2 "++ , testCase "Other: commits to pull and to push" $+ testRemoteCommitsToPushAndPull Other defaultConfig @?=+ "\120366 4\x1b[1;32m\8644\x1b[0m4 "+ ]++ , testGroup "Custom Config"+ [ testCase "ZSH: commits to pull" $+ testRemoteCommitsToPull ZSH customConfigRemoteCommits @?=+ "foo %{\x1b[1;32m%}pull%{\x1b[0m%} 2 "++ , testCase "ZSH: commits to push" $+ testRemoteCommitsToPush ZSH customConfigRemoteCommits @?=+ "foo %{\x1b[1;32m%}push%{\x1b[0m%} 2 "++ , testCase "ZSH: commits to pull and to push" $+ testRemoteCommitsToPushAndPull ZSH customConfigRemoteCommits @?=+ "foo 4%{\x1b[1;32m%}pull-push%{\x1b[0m%}4 "++ , testCase "Other: commits to pull" $+ testRemoteCommitsToPull Other customConfigRemoteCommits @?=+ "foo \x1b[1;32mpull\x1b[0m 2 "++ , testCase "Other: commits to push" $+ testRemoteCommitsToPush Other customConfigRemoteCommits @?=+ "foo \x1b[1;32mpush\x1b[0m 2 "++ , testCase "Other: commits to pull and to push" $+ testRemoteCommitsToPushAndPull Other customConfigRemoteCommits @?=+ "foo 4\x1b[1;32mpull-push\x1b[0m4 "+ ]+ ]++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[1;34m%}foo%{\x1b[0m%}] "++ , 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[1;34mfoo\x1b[0m] "++ , 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[0m%}] "++ , 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[0m] "+ ]+ , 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[0m%}} "++ , 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[0m} "++ , 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[0m%}} "++ , 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[0m} "+ ]+ ]++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[0m%} "++ , testCase "ZSH: commits to push" $+ testCommitsToPush ZSH defaultConfig @?=+ "2%{\x1b[1;32m%}\8593%{\x1b[0m%} "++ , testCase "ZSH: commits to pull and to push" $+ testCommitsToPushAndPull ZSH defaultConfig @?=+ "4%{\x1b[1;32m%}\8645%{\x1b[0m%}4 "++ , testCase "Other: commits to pull" $+ testCommitsToPull Other defaultConfig @?=+ "2\x1b[1;31m\8595\x1b[0m "++ , testCase "Other: commits to push" $+ testCommitsToPush Other defaultConfig @?=+ "2\x1b[1;32m\8593\x1b[0m "++ , testCase "Other: commits to pull and to push" $+ testCommitsToPushAndPull Other defaultConfig @?=+ "4\x1b[1;32m\8645\x1b[0m4 "+ ]+ , testGroup "Custom Config"+ [ testCase "ZSH: commits to pull" $+ testCommitsToPull ZSH customConfigLocalCommits @?=+ "2%{\x1b[35m%}pull%{\x1b[0m%} "++ , testCase "ZSH: commits to push" $+ testCommitsToPush ZSH customConfigLocalCommits @?=+ "2%{\x1b[36m%}push%{\x1b[0m%} "++ , testCase "ZSH: commits to pull and to push" $+ testCommitsToPushAndPull ZSH customConfigLocalCommits @?=+ "4%{\x1b[37m%}push-pull%{\x1b[0m%}4 "++ , testCase "Other: commits to pull" $+ testCommitsToPull Other customConfigLocalCommits @?=+ "2\x1b[35mpull\x1b[0m "++ , testCase "Other: commits to push" $+ testCommitsToPush Other customConfigLocalCommits @?=+ "2\x1b[36mpush\x1b[0m "++ , testCase "Other: commits to pull and to push" $+ testCommitsToPushAndPull Other customConfigLocalCommits @?=+ "4\x1b[37mpush-pull\x1b[0m4 "+ ]+ ]++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[0m%} "++ , testCase "ZSH: with Local Mod Changes" $+ testLocalModChange ZSH defaultConfig @?= "2%{\x1b[1;31m%}M%{\x1b[0m%} "++ , testCase "ZSH: with Local Del Changes" $+ testLocalDelChange ZSH defaultConfig @?= "2%{\x1b[1;31m%}D%{\x1b[0m%} "++ , testCase "ZSH: with Index Add Changes" $+ testIndexAddChange ZSH defaultConfig @?= "2%{\x1b[1;32m%}A%{\x1b[0m%} "++ , testCase "ZSH: with Index Mod Changes" $+ testIndexModChange ZSH defaultConfig @?= "2%{\x1b[1;32m%}M%{\x1b[0m%} "++ , testCase "ZSH: with Index Del Changes" $+ testIndexDelChange ZSH defaultConfig @?= "2%{\x1b[1;32m%}D%{\x1b[0m%} "++ , testCase "ZSH: with Conflicted Changes" $+ testConflictedChange ZSH defaultConfig @?= "2%{\x1b[1;32m%}C%{\x1b[0m%} "++ , testCase "ZSH: with Renamed Changes" $+ testRenamedChange ZSH defaultConfig @?= "2%{\x1b[1;32m%}R%{\x1b[0m%} "++ , testCase "Other: with Local Add Changes" $+ testLocalAddChange Other defaultConfig @?= "2\x1b[1;37mA\x1b[0m "++ , testCase "Other: with Local Mod Changes" $+ testLocalModChange Other defaultConfig @?= "2\x1b[1;31mM\x1b[0m "++ , testCase "Other: with Local Del Changes" $+ testLocalDelChange Other defaultConfig @?= "2\x1b[1;31mD\x1b[0m "++ , testCase "Other: with Index Add Changes" $+ testIndexAddChange Other defaultConfig @?= "2\x1b[1;32mA\x1b[0m "++ , testCase "Other: with Index Mod Changes" $+ testIndexModChange Other defaultConfig @?= "2\x1b[1;32mM\x1b[0m "++ , testCase "Other: with Index Del Changes" $+ testIndexDelChange Other defaultConfig @?= "2\x1b[1;32mD\x1b[0m "++ , testCase "Other: with Conflicted Changes" $+ testConflictedChange Other defaultConfig @?= "2\x1b[1;32mC\x1b[0m "++ , testCase "Other: with Renamed Changes" $+ testRenamedChange Other defaultConfig @?= "2\x1b[1;32mR\x1b[0m "++ , testCase "ZSH: with every kind of Changes" $+ testEveryRepoChange ZSH defaultConfig @?= "6%{\x1b[1;32m%}A%{\x1b[0m%}8%{\x1b[1;32m%}D%{\x1b[0m%}7%{\x1b[1;32m%}M%{\x1b[0m%}1%{\x1b[1;32m%}R%{\x1b[0m%} 5%{\x1b[1;31m%}D%{\x1b[0m%}4%{\x1b[1;31m%}M%{\x1b[0m%} 3%{\x1b[1;37m%}A%{\x1b[0m%} 2%{\x1b[1;32m%}C%{\x1b[0m%} "++ , testCase "Other: with every kind of Changes" $+ testEveryRepoChange Other defaultConfig @?= "6\x1b[1;32mA\x1b[0m8\x1b[1;32mD\x1b[0m7\x1b[1;32mM\x1b[0m1\x1b[1;32mR\x1b[0m 5\x1b[1;31mD\x1b[0m4\x1b[1;31mM\x1b[0m 3\x1b[1;37mA\x1b[0m 2\x1b[1;32mC\x1b[0m "+ ]+ , testGroup "Custom Config"+ [ testCase "ZSH: with Local Add Changes" $+ testLocalAddChange ZSH customChangeConfig @?= "2%{\x1b[35m%}B%{\x1b[0m%} "++ , testCase "ZSH: with Local Mod Changes" $+ testLocalModChange ZSH customChangeConfig @?= "2%{\x1b[34m%}N%{\x1b[0m%} "++ , testCase "ZSH: with Local Del Changes" $+ testLocalDelChange ZSH customChangeConfig @?= "2%{\x1b[34m%}E%{\x1b[0m%} "++ , testCase "ZSH: with Index Add Changes" $+ testIndexAddChange ZSH customChangeConfig @?= "2%{\x1b[36m%}B%{\x1b[0m%} "++ , testCase "ZSH: with Index Mod Changes" $+ testIndexModChange ZSH customChangeConfig @?= "2%{\x1b[36m%}N%{\x1b[0m%} "++ , testCase "ZSH: with Index Del Changes" $+ testIndexDelChange ZSH customChangeConfig @?= "2%{\x1b[36m%}E%{\x1b[0m%} "++ , testCase "ZSH: with Conflicted Changes" $+ testConflictedChange ZSH customChangeConfig @?= "2%{\x1b[36m%}D%{\x1b[0m%} "++ , testCase "ZSH: with Renamed Changes" $+ testRenamedChange ZSH customChangeConfig @?= "2%{\x1b[36m%}S%{\x1b[0m%} "++ , testCase "Other: with Local Add Changes" $+ testLocalAddChange Other customChangeConfig @?= "2\x1b[35mB\x1b[0m "++ , testCase "Other: with Local Mod Changes" $+ testLocalModChange Other customChangeConfig @?= "2\x1b[34mN\x1b[0m "++ , testCase "Other: with Local Del Changes" $+ testLocalDelChange Other customChangeConfig @?= "2\x1b[34mE\x1b[0m "++ , testCase "Other: with Index Add Changes" $+ testIndexAddChange Other customChangeConfig @?= "2\x1b[36mB\x1b[0m "++ , testCase "Other: with Index Mod Changes" $+ testIndexModChange Other customChangeConfig @?= "2\x1b[36mN\x1b[0m "++ , testCase "Other: with Index Del Changes" $+ testIndexDelChange Other customChangeConfig @?= "2\x1b[36mE\x1b[0m "++ , testCase "Other: with Conflicted Changes" $+ testConflictedChange Other customChangeConfig @?= "2\x1b[36mD\x1b[0m "++ , testCase "Other: with Renamed Changes" $+ testRenamedChange Other customChangeConfig @?= "2\x1b[36mS\x1b[0m "++ , testCase "ZSH: with every kind of Changes" $+ testEveryRepoChange ZSH customChangeConfig @?= "6%{\x1b[36m%}B%{\x1b[0m%}8%{\x1b[36m%}E%{\x1b[0m%}7%{\x1b[36m%}N%{\x1b[0m%}1%{\x1b[36m%}S%{\x1b[0m%} 5%{\x1b[34m%}E%{\x1b[0m%}4%{\x1b[34m%}N%{\x1b[0m%} 3%{\x1b[35m%}B%{\x1b[0m%} 2%{\x1b[36m%}D%{\x1b[0m%} "++ , testCase "Other: with every kind of Changes" $+ testEveryRepoChange Other customChangeConfig @?= "6\x1b[36mB\x1b[0m8\x1b[36mE\x1b[0m7\x1b[36mN\x1b[0m1\x1b[36mS\x1b[0m 5\x1b[34mE\x1b[0m4\x1b[34mN\x1b[0m 3\x1b[35mB\x1b[0m 2\x1b[36mD\x1b[0m "+ ]+ ]++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[0m%} "++ , testCase "Other: hardcoded character" $+ testWriterWithConfig+ (buildOutputConfig Other (zeroGitRepoState { gitStashCount = 2 }) defaultConfig) addStashes+ @?= "2\x1b[1;32m\8801\x1b[0m "+ ]+ , testGroup "Custom Config"+ [ testCase "ZSH: hardcoded character" $+ testWriterWithConfig+ (buildOutputConfig ZSH (zeroGitRepoState { gitStashCount = 2 }) customStashConfig) addStashes+ @?= "2%{\x1b[36m%}stash%{\x1b[0m%} "++ , testCase "Other: hardcoded character" $+ testWriterWithConfig+ (buildOutputConfig Other (zeroGitRepoState { gitStashCount = 2 }) customStashConfig) addStashes+ @?= "2\x1b[36mstash\x1b[0m "+ ]+ ]++-- | 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++testRemoteCommitsToPull :: Shell -> Config -> String+testRemoteCommitsToPull shell config = testWriterWithConfig+ (buildOutputConfig shell (zeroGitRepoState { gitRemoteCommitsToPull = 2 }) config)+ addRemoteCommits++testRemoteCommitsToPush :: Shell -> Config -> String+testRemoteCommitsToPush shell config = testWriterWithConfig+ (buildOutputConfig shell (zeroGitRepoState { gitRemoteCommitsToPush = 2 }) config)+ addRemoteCommits++testRemoteCommitsToPushAndPull :: Shell -> Config -> String+testRemoteCommitsToPushAndPull shell config = testWriterWithConfig+ (buildOutputConfig shell+ (zeroGitRepoState { gitRemoteCommitsToPull = 4, gitRemoteCommitsToPush = 4 })+ config+ )+ addRemoteCommits++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