diff --git a/gitHUD.cabal b/gitHUD.cabal --- a/gitHUD.cabal +++ b/gitHUD.cabal @@ -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 diff --git a/src/GitHUD.hs b/src/GitHUD.hs --- a/src/GitHUD.hs +++ b/src/GitHUD.hs @@ -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 diff --git a/src/GitHUD/Config/Parse.hs b/src/GitHUD/Config/Parse.hs new file mode 100644 --- /dev/null +++ b/src/GitHUD/Config/Parse.hs @@ -0,0 +1,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" diff --git a/src/GitHUD/Config/Types.hs b/src/GitHUD/Config/Types.hs new file mode 100644 --- /dev/null +++ b/src/GitHUD/Config/Types.hs @@ -0,0 +1,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 +} diff --git a/src/GitHUD/Git/Parse/Base.hs b/src/GitHUD/Git/Parse/Base.hs --- a/src/GitHUD/Git/Parse/Base.hs +++ b/src/GitHUD/Git/Parse/Base.hs @@ -2,6 +2,7 @@ getGitRepoState ) where +import Control.Applicative ((<$>)) import Control.Concurrent (forkIO) import Control.Concurrent.MVar (newEmptyMVar, takeMVar) diff --git a/src/GitHUD/Terminal/Base.hs b/src/GitHUD/Terminal/Base.hs --- a/src/GitHUD/Terminal/Base.hs +++ b/src/GitHUD/Terminal/Base.hs @@ -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 diff --git a/src/GitHUD/Terminal/Prompt.hs b/src/GitHUD/Terminal/Prompt.hs new file mode 100644 --- /dev/null +++ b/src/GitHUD/Terminal/Prompt.hs @@ -0,0 +1,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 " " + diff --git a/src/GitHUD/Terminal/Types.hs b/src/GitHUD/Terminal/Types.hs --- a/src/GitHUD/Terminal/Types.hs +++ b/src/GitHUD/Terminal/Types.hs @@ -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) diff --git a/src/GitHUD/Types.hs b/src/GitHUD/Types.hs new file mode 100644 --- /dev/null +++ b/src/GitHUD/Types.hs @@ -0,0 +1,51 @@ +{-# Language FlexibleContexts #-} + +module GitHUD.Types ( + OutputConfig(..) + , buildOutputConfig + , Prompt + , TerminalState + , ShellOutput + , 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) () + diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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] diff --git a/test/Test/GitHUD/Config/Parse.hs b/test/Test/GitHUD/Config/Parse.hs new file mode 100644 --- /dev/null +++ b/test/Test/GitHUD/Config/Parse.hs @@ -0,0 +1,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 + ] diff --git a/test/Test/GitHUD/Git/Common.hs b/test/Test/GitHUD/Git/Common.hs new file mode 100644 --- /dev/null +++ b/test/Test/GitHUD/Git/Common.hs @@ -0,0 +1,20 @@ +module Test.GitHUD.Git.Common ( + gitCommonTests + ) where + +import Test.Tasty +import Test.Tasty.HUnit + +import GitHUD.Git.Common + +gitCommonTests :: TestTree +gitCommonTests = testGroup "Git Common Test" + [ testCase "Getting the config key for the remote of a given local branch" $ + gitRemoteTrackingConfigKey "master" @?= "branch.master.remote" + + , testCase "Getting the config key for the remote tracking branch of a local branch" $ + gitRemoteBranchConfigKey "master" @?= "branch.master.merge" + + , testCase "Getting a commit span between 2 commits" $ + mergeBaseDiffFromTo "b2d35" "ef25d" @?= "b2d35...ef25d" + ] diff --git a/test/Test/GitHUD/Git/Types.hs b/test/Test/GitHUD/Git/Types.hs new file mode 100644 --- /dev/null +++ b/test/Test/GitHUD/Git/Types.hs @@ -0,0 +1,54 @@ +module Test.GitHUD.Git.Types ( + gitTypesTests + ) where + +import Test.Tasty +import Test.Tasty.HUnit + +import GitHUD.Git.Types + +gitTypesTests :: TestTree +gitTypesTests = testGroup "Git Types Test" + [ testCase "Merging 2 repoChanges object should lead to the sum of its parts" $ + testMergeGitLocalRepoChanges + ] + +testMergeGitLocalRepoChanges :: Assertion +testMergeGitLocalRepoChanges = + mergeGitLocalRepoChanges glrc1 glrc2 @?= glrcMerged + +glrc1 :: GitLocalRepoChanges +glrc1 = GitLocalRepoChanges { + localMod = 3 + , localAdd = 2 + , localDel = 4 + , indexMod = 6 + , indexAdd = 10 + , indexDel = 7 + , renamed = 12 + , conflict = 50 +} + +glrc2 :: GitLocalRepoChanges +glrc2 = GitLocalRepoChanges { + localMod = 6 + , localAdd = 20 + , localDel = 48 + , indexMod = 3 + , indexAdd = 56 + , indexDel = 10 + , renamed = 44 + , conflict = 2 +} + +glrcMerged :: GitLocalRepoChanges +glrcMerged = GitLocalRepoChanges { + localMod = 9 + , localAdd = 22 + , localDel = 52 + , indexMod = 9 + , indexAdd = 66 + , indexDel = 17 + , renamed = 56 + , conflict = 52 +} diff --git a/test/Test/GitHUD/Terminal/Base.hs b/test/Test/GitHUD/Terminal/Base.hs new file mode 100644 --- /dev/null +++ b/test/Test/GitHUD/Terminal/Base.hs @@ -0,0 +1,19 @@ +module Test.GitHUD.Terminal.Base ( + terminalTests + ) where + +import Test.Tasty +import Test.Tasty.HUnit + +import GitHUD.Terminal.Base +import GitHUD.Terminal.Types + +terminalTests :: TestTree +terminalTests = testGroup "Terminal Base Tests" + [ testCase "#applyShellMarkers should not do anything for non ZSH shell" $ + applyShellMarkers Other "foo" @?= "foo" + + , testCase "#applyShellMarkers should add 0-width markers for ZSH shell" $ + applyShellMarkers ZSH "foo" @?= "%{foo%}" + + ] diff --git a/test/Test/GitHUD/Terminal/Prompt.hs b/test/Test/GitHUD/Terminal/Prompt.hs new file mode 100644 --- /dev/null +++ b/test/Test/GitHUD/Terminal/Prompt.hs @@ -0,0 +1,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