├── .envrc
├── .github
└── FUNDING.yml
├── .githudrc
├── .gitignore
├── .travis.yml
├── CHANGELOG.md
├── HLint.hs
├── LICENSE
├── README.md
├── Setup.hs
├── app
├── githud
│ └── Main.hs
└── githudd
│ └── Main.hs
├── bench
├── bench.html
└── bench.png
├── docs
├── PROMPT_EXPLAINED.md
└── auto-fetch
│ ├── daemon-logic.png
│ └── daemon-logic.puml
├── flake.lock
├── flake.nix
├── githud.cabal
├── images
├── gitgraph_commits_pull.png
├── gitgraph_commits_pull_push.png
├── gitgraph_commits_push.png
├── gitgraph_merge_branch_pull.png
├── gitgraph_merge_branch_push.png
├── gitgraph_merge_branch_push_pull.png
├── prompt.png
├── prompt_commits_pull.png
├── prompt_commits_push.png
├── prompt_commits_push_pull.png
├── prompt_conflicts.png
├── prompt_detached.png
├── prompt_local_branch.png
├── prompt_merge_branch_pull.png
├── prompt_merge_branch_push.png
├── prompt_merge_branch_push_pull.png
├── prompt_no_upstream.png
├── prompt_repo_changes.png
├── prompt_repo_indicator.png
└── prompt_stash.png
├── src
├── GitHUD.hs
└── GitHUD
│ ├── Config
│ ├── Parse.hs
│ └── Types.hs
│ ├── Daemon
│ ├── Network.hs
│ └── Runner.hs
│ ├── Debug.hs
│ ├── Git
│ ├── Command.hs
│ ├── Common.hs
│ ├── Parse
│ │ ├── Base.hs
│ │ ├── Branch.hs
│ │ ├── Count.hs
│ │ └── Status.hs
│ └── Types.hs
│ ├── Process.hs
│ ├── Terminal
│ ├── Base.hs
│ ├── Prompt.hs
│ └── Types.hs
│ └── Types.hs
└── test
├── Spec.hs
└── Test
└── GitHUD
├── Config
└── Parse.hs
├── Git
├── Common.hs
├── Parse
│ ├── Branch.hs
│ └── Status.hs
└── Types.hs
└── Terminal
├── Base.hs
└── Prompt.hs
/.envrc:
--------------------------------------------------------------------------------
1 | use flake
2 |
3 | watch_file githud.cabal
4 |
--------------------------------------------------------------------------------
/.github/FUNDING.yml:
--------------------------------------------------------------------------------
1 | patreon: gbataille
2 |
--------------------------------------------------------------------------------
/.githudrc:
--------------------------------------------------------------------------------
1 | # Lines beginning with a '#' in the first column are comments
2 | #
3 | # The file contains a list of key - value pairs, separated by an equal "=" sign
4 | # Careful, all spaces are meaningful
5 | # There generally should not be any before or after the equal "=" sign
6 | #
7 | # Githud puts spaces inbetween every "section" of the prompt.
8 | # Generally, you should not put any spaces at the end yourself
9 | #
10 | # Empty lines are ignored.
11 | # Lines that are not understood by githud are silently ignored
12 | #
13 | # Colors are from [Black, Red, Green, Yellow, Blue, Magenta, Cyan, White, NoColor]
14 | # NoColor is a special keyword to remove any specific color and use the
15 | # terminal foreground color
16 | #
17 | # Intensities are from [Vivid, Dull]
18 | #
19 | # The show_part_xxx key tell githud whether to display this part of the prompt
20 | # It takes a boolean value [True, False]
21 | #
22 | # The following values are the defaults.
23 | # Uncomment one and change it to obtain a different prompt
24 | #
25 | #
26 | # The following character is a better repo indicator to me but needs the
27 | # powerline patched font https://github.com/powerline/fonts
28 | # it's not a default anymore
29 | # Don't use it unless it displays a nice fork symbol
30 | # git_repo_indicator=
31 | #
32 | # ------------------------------------------------------
33 | # ---------------------- DEFAULTS ----------------------
34 | # ------------------------------------------------------
35 | #
36 | # --
37 | # show_part_repo_indicator=True
38 | # git_repo_indicator=ᚴ
39 | #
40 | # --
41 | # show_part_merge_branch_commits_diff=True
42 | # no_tracked_upstream_text=upstream
43 | # no_tracked_upstream_text_color=Red
44 | # no_tracked_upstream_text_intensity=Vivid
45 | # no_tracked_upstream_indicator=⚡
46 | # no_tracked_upstream_indicator_color=Red
47 | # no_tracked_upstream_indicator_intensity=Vivid
48 | #
49 | # merge_branch_commits_indicator=𝘮
50 | # merge_branch_commits_pull_prefix=→
51 | # merge_branch_commits_push_prefix=←
52 | # merge_branch_commits_push_pull_infix=⇄
53 | # -------------------------------------------------------------------------------------------
54 | # The following config controls the conditional rendering of the merge-branch part of the
55 | # prompt. The condition is based on the branch name.
56 | # This is typically useful for branches which content is not linked to the rest of the repo
57 | # like the gh-pages branch that github uses for building static websites
58 | #
59 | # If the orphan branch was created properly though (git branch --orphan gh-pages)
60 | # gitHUD will autodetect that it is orphan and not show this part of the prompt automatically
61 | # -------------------------------------------------------------------------------------------
62 | # merge_branch_ignore_branches=gh-pages,
63 | #
64 | # --
65 | # show_part_local_branch=True
66 | # local_branch_prefix=[
67 | # local_branch_suffix=]
68 | # local_branch_color=NoColor
69 | # local_branch_intensity=Vivid
70 | # local_detached_prefix=detached@
71 | # local_detached_color=Yellow
72 | # local_detached_intensity=Vivid
73 | #
74 | # --
75 | # show_part_commits_to_origin=True
76 | # local_commits_push_suffix=↑
77 | # local_commits_push_suffix_color=Green
78 | # local_commits_push_suffix_intensity=Vivid
79 | # local_commits_pull_suffix=↓
80 | # local_commits_pull_suffix_color=Red
81 | # local_commits_pull_suffix_intensity=Vivid
82 | # local_commits_push_pull_infix=⥯
83 | # local_commits_push_pull_infix_color=Green
84 | # local_commits_push_pull_infix_intensity=Vivid
85 | #
86 | # --
87 | # show_part_local_changes_state=True
88 | # change_index_add_suffix=A
89 | # change_index_add_suffix_color=Green
90 | # change_index_add_suffix_intensity=Vivid
91 | # change_index_mod_suffix=M
92 | # change_index_mod_suffix_color=Green
93 | # change_index_mod_suffix_intensity=Vivid
94 | # change_index_del_suffix=D
95 | # change_index_del_suffix_color=Green
96 | # change_index_del_suffix_intensity=Vivid
97 | # change_renamed_suffix=R
98 | # change_renamed_suffix_color=Green
99 | # change_renamed_suffix_intensity=Vivid
100 | # change_local_add_suffix=A
101 | # change_local_add_suffix_color=White
102 | # change_local_add_suffix_intensity=Vivid
103 | # change_local_mod_suffix=M
104 | # change_local_mod_suffix_color=Red
105 | # change_local_mod_suffix_intensity=Vivid
106 | # change_local_del_suffix=D
107 | # change_local_del_suffix_color=Red
108 | # change_local_del_suffix_intensity=Vivid
109 | # change_conflicted_suffix=C
110 | # change_conflicted_suffix_color=Green
111 | # change_conflicted_suffix_intensity=Vivid
112 | #
113 | # --
114 | # show_part_stashes=True
115 | # stash_suffix=≡
116 | # stash_suffix_color=Green
117 | # stash_suffix_intensity=Vivid
118 | #
119 | # -------------------------------------------------------------------------------------------
120 | # The following config controls the background fetcher daemon behavior called githudd
121 | # -------------------------------------------------------------------------------------------
122 | # # Whether githud will launch the background daemon
123 | # run_fetcher_daemon=True
124 | # # How long does the daemon sleep between cycles
125 | # githudd_sleep_seconds=30
126 | # # Path where the githudd pid file will be stored. Needs to exist and be accessible by the current
127 | # # user
128 | # githudd_pid_file_path=/$TMPDIR/githudd.pid
129 | # # Path where the githudd lock file will be stored. Needs to exist and be accessible by the current
130 | # # user
131 | # githudd_lock_file_path=/$TMPDIR/githudd.lock
132 | # # Path where the githudd socket file will be stored. Needs to exist and be accessible by the current
133 | # # user
134 | # githudd_socket_file_path=/$TMPDIR/githudd.socket
135 | # # Path where the githudd stdout/stderr capture logfile will be store.
136 | # # Githudd logs can be verbose. They are here for debugging only. It is not advised that you
137 | # # activate them
138 | # # Use the value /dev/null to disable the logs
139 | # githudd_log_file_path=/dev/null
140 |
--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | EXEC
2 | result
3 | .direnv
4 | dist-newstyle
5 |
--------------------------------------------------------------------------------
/.travis.yml:
--------------------------------------------------------------------------------
1 | # This is the simple Travis configuration, which is intended for use
2 | # on applications which do not require cross-platform and
3 | # multiple-GHC-version support. For more information and other
4 | # options, see:
5 | #
6 | # https://docs.haskellstack.org/en/stable/travis_ci/
7 | #
8 | # Copy these contents into the root directory of your Github project in a file
9 | # named .travis.yml
10 | language: nix
11 | script: nix-build
12 |
--------------------------------------------------------------------------------
/CHANGELOG.md:
--------------------------------------------------------------------------------
1 | 3.3.0
2 | -----
3 | Contributed from https://github.com/voidus
4 |
5 | * Fix ([#28](https://github.com/gbataille/gitHUD/issues/28): The `run_fetcher_daemon` option was not taken into account.
6 | * [DEV] upgrading the dev environment to use nix flake and the latest nix distribution
7 |
8 | 3.2.2
9 | -----
10 |
11 | * Fix ([#27](https://github.com/gbataille/gitHUD/issues/27): Concurrency issue starting many `githudd`
12 | daemon that would never be cleaned up
13 |
14 | 3.2.0
15 | -----
16 |
17 | * Fix ([#21](https://github.com/gbataille/gitHUD/issues/21)): use the system defined temp location
18 | as default for the PID and socket location rather than an hardcoded path that does not exist on
19 | all systems
20 | * Feat: Do not display background server error/restart on STDERR by default. Only display it if the
21 | env variable `GITHUD_DEBUG` is set to `TRUE`
22 |
23 | 3.1.0
24 | -----
25 |
26 | * Fix: everything that was wrong with 3.0 :)
27 | Been running this version locally for a week without issues. Everything seems to recover properly
28 | on error and I get my background refresh
29 | * Config: Re-enable `githudd` background fetcher by default
30 |
31 | 3.0.2
32 | -----
33 |
34 | * Fix: `githudd` to restart from scratch if there is an issue with the pid file / background process
35 | * Fix: `githudd` to ignore failing `git fetch` return code
36 | * Fix: `githudd` recover on client/server exception
37 |
38 | 3.0.1
39 | -----
40 |
41 | * Fix: Disable `githudd` by default. Seems that due to the socket communication I have made it
42 | unstable resulting in `githud` not displaying anything. Let's say that `githudd` is **Beta**. I'll
43 | work on making it recover on failure
44 |
45 | 3.0.0
46 | -----
47 | * Feat: Add a daemon called `githudd` that will continuously fetch the last git folder where
48 | `githud` was executed. In a typical install where `githud` is used in the prompt, that means the
49 | last git folder browsed.
50 | * Config: some new configuration has been added for the `githudd` daemon. The default values have
51 | been tested on Mac. You can find this new section in the `.githudrc` file in this repo. The new
52 | parameters are also pasted below along with their default values.
53 | ```
54 | # -------------------------------------------------------------------------------------------
55 | # The following config controls the background fetcher daemon behavior called githudd
56 | # -------------------------------------------------------------------------------------------
57 | # run_fetcher_daemon=True
58 | # githudd_sleep_seconds=30 # how long does the daemon sleep between cycles
59 | # githudd_pid_file_path=/usr/local/var/run/githudd.pid
60 | # githudd_socket_file_path=/usr/local/var/run/githudd.socket
61 | #
62 | # # Githudd logs can be verbose. They are here for debugging only. It is not advised that you
63 | # # activate them
64 | # githudd_log_file_path=/dev/null
65 | ```
66 |
67 | 2.1.0
68 | -----
69 | * Feat: Add support for TMUX with `githud tmux`. You can now use tmux inside the status bar or the
70 | pane title of TMUX for example
71 | * Feat: Add support for no output formatting with `githud none`.
72 |
73 | 2.0.2
74 | -----
75 | * Fix: Properly reset "normal" styling after displaying "Bold" characters (#13)
76 |
77 | 2.0.1
78 | -----
79 | * BREAKING: the executable is renamed from `gitHUD` to `githud`, as suggested in
80 | [#14](https://github.com/gbataille/gitHUD/issues/14) by [@voidus](https://github.com/voidus)
81 |
82 | 1.3.7
83 | -----
84 | * When in detached, but on a commit that has a tag, display the tag name rather than the commit SHA
85 |
86 | 1.3.6
87 | -----
88 | * BASH shell: properly escape invisible control characters so that the prompt length is computed
89 | properly
90 |
91 | 1.3.5
92 | -----
93 | * in 1.3.1 I introduced `merge_branch_ignore_branches` to be able to deal with
94 | "false" branches like the famous gh-pages. It happens that if this branch
95 | was properly created as an orphan branch (`git branch --orphan gh-pages`),
96 | then I can detect that it does not merge back into master and not show this
97 | part of the prompt automatically without people having to manually maintain
98 | exception. Thanks to [Markus](https://github.com/mgee) for pointing that out
99 |
100 | 1.3.4
101 | -----
102 | * Minor breaking change: Removed the trailing space. If you need it, just put
103 | it in your prompt definition
104 | * Do not override background color. Just act on foreground text color
105 |
106 | 1.3.3
107 | -----
108 | * Merge branch count indicator will not include merge-commit anymore. This is
109 | actually redundant in all case. In fact, in a develop/master typical flow,
110 | when develop merges into master and develop and master are actually equal, if
111 | you count the merge-commit, you'll have the impression that there is a delta
112 | between the 2 branches
113 |
114 | 1.3.2
115 | -----
116 | * Introduce `merge_branch_ignore_branches` config list that allows to not
117 | display the merge-branch part of the prompt for certain branch names
118 |
119 | 1.3.1
120 | -----
121 | * Allow for a special "NoColor" configuration color to reset to the terminal
122 | foreground color
123 | * NoColor is the default if the config file cannot be read
124 | * Protect the prompt from possible color set before gitHUD is invoked
125 | * Branch name has no color by default
126 | * The default commit pull-push symbol is changed to a (hopefully) clearer '⥯'
127 |
128 | 1.3.0
129 | -----
130 | * Remove dependency on a patched font in the default config
131 | * Allow for partial prompt through configuration
132 |
133 | 1.2.0
134 | -----
135 | * Configurable "no remote tracking branch" color
136 | * Fix brew formula in gbataille/homebrew-gba which failed on some configs
137 |
138 | 1.1.0
139 | -----
140 | * Configurable prompt parts (text and colors)
141 | * Tech: refactoring to a writer and wide test coverage
142 |
--------------------------------------------------------------------------------
/HLint.hs:
--------------------------------------------------------------------------------
1 | import "hint" HLint.Default
2 | import "hint" HLint.Dollar
3 |
4 | ignore "Redundant bracket"
5 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | Copyright Grégory Bataille (c) 2015
2 |
3 | All rights reserved.
4 |
5 | Redistribution and use in source and binary forms, with or without
6 | modification, are permitted provided that the following conditions are met:
7 |
8 | * Redistributions of source code must retain the above copyright
9 | notice, this list of conditions and the following disclaimer.
10 |
11 | * Redistributions in binary form must reproduce the above
12 | copyright notice, this list of conditions and the following
13 | disclaimer in the documentation and/or other materials provided
14 | with the distribution.
15 |
16 | * Neither the name of Grégory Bataille nor the names of other
17 | contributors may be used to endorse or promote products derived
18 | from this software without specific prior written permission.
19 |
20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | [](https://travis-ci.org/gbataille/gitHUD)
2 | [](https://github.com/gbataille/gitHUD/releases)
3 | [](https://hackage.haskell.org/package/githud)
4 | [](https://hackage.haskell.org/package/githud)
5 |
6 | Unmaintained!
7 | -------------
8 | Although this application still works (for now), I don't intend to maintain it anymore.
9 | I have moved my workflow to `jj` (which I highly recommend, whatever the rest of your team does). Because `jj` works in detached head and does not have stashes or an index, `githud` has become useless to me.
10 |
11 | There is a somewhat maintained fork at https://github.com/voidus/gitHUD
12 |
13 | Description
14 | -----------
15 |
16 | As you might have guessed from its name, githud is a heads up display for the
17 | command line that will show git information. The focus is on information and performance.
18 |
19 | If you are as crazy as I am about your prompt, you might want to check my somewhat related project
20 | [envstatus](https://github.com/gbataille/envstatus)
21 |
22 | ![Example]
23 | See [Prompt explained](docs/PROMPT_EXPLAINED.md) for a detailled element by element description of what
24 | you see
25 |
26 | _**Note:** this example is taken from the iTerm2 OSX terminal, with custom
27 | colors from the Solarized Dark theme_
28 |
29 | * [Why githud?](#why_githud?)
30 | * [Install](#install)
31 | * [Setup](#setup)
32 | * [Configuration](#configuration)
33 | * [Understanding the githud prompt](#understanding-the-githud-prompt)
34 | * [Benefits](#benefits)
35 | * [Benchmarks](#benchmarks)
36 | * [Thanks](#thanks)
37 |
38 | Why githud?
39 | -----------
40 |
41 | I was really psyched a few months ago (mid-2015) by
42 | [git-radar](https://github.com/michaeldfallen/git-radar). Git-radar does the exact
43 | same thing as githud, but is implemented in shell. While I had a great time
44 | using it for a while, I realized that on my particular setup, git-radar was
45 | introducing a visible delay (>200ms, too long for me) in the displaying of my
46 | prompt.
47 |
48 | At that time, I was looking for an exercise to implement in Haskell, so that's
49 | how I created githud
50 |
51 | Install
52 | -------
53 |
54 | Whichever way you install githud, don't forget to complete the [Setup](#setup)
55 |
56 | ### Mac OSX with brew
57 |
58 | _(Maintained on each release)_
59 |
60 | * link my tap
61 |
62 | ```
63 | brew tap gbataille/homebrew-gba
64 | ```
65 |
66 | * install githud
67 |
68 | ```
69 | brew install githud
70 | ```
71 |
72 | #### Binary packages on linux
73 |
74 | _Looking for contributor to provide a recipe (in github actions form?)_
75 |
76 | ### With cabal and Nix
77 |
78 | _(Used in the development process, therefore it is maintained and up-to-date)_
79 |
80 | A Nix config is maintained in compatibility with the cabal file. So to be sure to use a compatible
81 | ghc version, and corresponding libraries, just
82 |
83 | ```sh
84 | nix-shell
85 | cabal v2-install
86 | ```
87 |
88 | ### With Stack
89 |
90 | _(Not maintained. Dev happens using Nix + Cabal. Don't hesitate to contribute)_
91 |
92 | Stack is a haskell package manager. 1 command install can be found
93 | [here](https://docs.haskellstack.org/en/stable/README/)
94 |
95 | githud is available on hackage, but some dependencies have to be explicited.
96 | You need to add the following to the extra-deps in your stack.yml file
97 |
98 | ``` ./.stack/global-project/stack.yaml
99 | extra-deps:
100 | - daemons-0.4.0
101 | - network-2.8.0.1
102 | ```
103 |
104 | then you can run
105 |
106 | ```
107 | stack install githud
108 | ```
109 |
110 | ### With Cabal
111 |
112 | _(Not maintained. Dev happens using Nix + Cabal. Don't hesitate to contribute)_
113 |
114 | githud is available on hackage. Therefore just get it as usual
115 |
116 | ```
117 | cabal v2-install exe:githud
118 | ```
119 |
120 | You can then update your path to include your installation directory (typically `~/.cabal/bin`) or
121 | copy the installed executable to a common location like `/usr/local/bin`
122 |
123 | Setup
124 | -----
125 |
126 | If you simply call the githud executable, you'll get a short status of your
127 | repository. It's meant to be called each time you display your prompt.
128 | Therefore you want to put it in your PS1 env variable.
129 |
130 | Shells have some fancy way of managing prompt when you do things like
131 | autocompletion and the like. For that it needs to know the size of the prompt.
132 | Special characters used to express the color of the prompt need to be
133 | surrounded by special markup for them not to be counted.
134 |
135 | GitHUD knows how to handle this. All you have to do is to run the program with
136 | a parameter depending on your shell of choice and those special characters will be used in the
137 | output
138 |
139 | #### Bash
140 |
141 | ```
142 | githud bash
143 | ```
144 |
145 | For example, in my `.bashrc` file, with the executable at
146 | `/usr/local/bin/githud`, I have a prompt definition that looks like that:
147 |
148 | ```
149 | export PS1="\[\033[0;37m\][\A]\[\033[0m\] \[\033[0;36m\]\u\[\033[0m\]
150 | \W\[\033[0;32m\]\$(/usr/local/bin/githud bash)\[\033[0m\]\$ "
151 | ```
152 |
153 | _(it has a lot more things into it, including the current directory, the hour,
154 | and a prompt '$' terminating character)_
155 |
156 | #### ZSH
157 |
158 | ```
159 | githud zsh
160 | ```
161 |
162 | _**Note**: Those special characters `%{` `%}` are only interpreted and hidden when
163 | zsh renders a prompt. If you simply call githud with this parameter 'zsh' from
164 | the command line, you'll see them in the output!_
165 |
166 | Putting it together in my `.zshrc`, I have the following PROMPT variable with
167 | the executable at `/usr/local/bin/githud`
168 |
169 |
170 | ```
171 | setopt PROMPT_SUBST
172 | export PROMPT='%F{white}%T%F{cyan} %n%{$reset_color%} $(/usr/local/bin/githud zsh) $'
173 | ```
174 |
175 | _(it has a lot more things into it, including the current directory, the
176 | current user, the hour, and a prompt '$' terminating character)_
177 |
178 | #### Fish
179 |
180 | Add this code to your config.fish file.
181 |
182 | ```
183 | function fish_prompt
184 | set_color white
185 | echo -n [(date "+%H:%M")]
186 | set_color cyan
187 | echo -n (whoami):
188 | set_color yellow
189 | echo -n (prompt_pwd)
190 | set_color $fish_color_cwd
191 | echo -n (/usr/local/bin/githud)
192 | set_color normal
193 | echo -n "> "
194 | end
195 | ```
196 |
197 | #### TMUX
198 |
199 | Proposed by @Thermatix
200 |
201 | ```
202 | githud tmux
203 | ```
204 |
205 | Putting it together in my `.tmux.conf`, I have the following `status-right` variable with
206 | ```
207 | set -g status-right '#{pane_current_command} #(~/.zsh/bin/githud_status "#{pane_current_path}")'
208 | ```
209 | which necessitates a small script `~/.zsh/bin/githud_status`
210 | ```
211 | #!/usr/local/bin/zsh -f
212 | cd $1 && /usr/local/bin/githud zsh
213 | ```
214 |
215 | and the executable at `/usr/local/bin/githud`
216 |
217 | #### NONE
218 |
219 | Proposed by @Thermatix
220 |
221 | You can get a raw text output (no special formatting) by calling
222 |
223 | ```
224 | githud none
225 | ```
226 |
227 | Configuration
228 | -------------
229 |
230 | The prompt format is nicely configurable. The defaults give you the look and
231 | feel from the screenshot above, with a terminal configured with the Solarized
232 | Dark theme colors.
233 |
234 | To change those colors, or the markers used in the prompt:
235 | * Copy the `.githudrc` file from this repository into your home directory.
236 | Then, from your home directory
237 | ```
238 | wget https://raw.githubusercontent.com/gbataille/gitHUD/master/.githudrc
239 | ```
240 | * Edit the file by uncommenting some fields and changing their values
241 | (instructions are enclosed in the file)
242 |
243 | You can control which section of the output are shown (if you want to mask
244 | some) with the configuration keys starting with "show\_part\_"
245 |
246 | #### The fetcher daemon
247 |
248 | `githud` includes a companion daemon called `githudd`. This daemon will start the first time
249 | `githud` is invoked and will run forever.
250 |
251 | This daemon will simply execute a `git fetch` periodically in the last git repository in which
252 | `githud` was executed. In the standard installation where you use `githud` in your prompt, this
253 | means that the daemon executes `git fetch` in the last git repository visited.
254 |
255 | The `.githudrc` configuration file can contain the following configuration for the daemon (default
256 | values given here)
257 | ```ini
258 | # Whether githud will launch the background daemon
259 | run_fetcher_daemon=True
260 | # How long does the daemon sleep between cycles
261 | githudd_sleep_seconds=30
262 | # Path where the githudd pid file will be stored. Needs to exist and be accessible by the current
263 | # user
264 | githudd_pid_file_path=/usr/local/var/run/githudd.pid
265 | # Path where the githudd lock file will be stored. Needs to exist and be accessible by the current
266 | # user
267 | githudd_lock_file_path=/$TMPDIR/githudd.lock
268 | # Path where the githudd socket file will be stored. Needs to exist and be accessible by the current
269 | # user
270 | githudd_socket_file_path=/usr/local/var/run/githudd.socket
271 | # Path where the githudd stdout/stderr capture logfile will be store.
272 | # Githudd logs can be verbose. They are here for debugging only. It is not advised that you
273 | # activate them
274 | # Use the value /dev/null to disable the logs
275 | githudd_log_file_path=/dev/null
276 | ```
277 |
278 | To stop the daemon, you can simply do
279 | ```bash
280 | pkill githudd
281 | ```
282 |
283 | Note that due to instability, the daemon is currently disabled by default
284 |
285 | The health of the `githudd` daemon is indicated by a red hearth (broken when unhealthy) at the start
286 | of the prompt (only when the daemon is activated)
287 |
288 |
289 | Understanding the githud prompt
290 | -------------------------------
291 |
292 | See [Prompt explained](docs/PROMPT_EXPLAINED.md)
293 |
294 | Benefits
295 | --------
296 |
297 | - githud is fast (on my system, about twice as fast as git-radar, with exec
298 | times below 100ms)
299 | - githud is easily maintainable through proper test coverage
300 |
301 | The only downside compared to git-radar is that you need to compile it on your
302 | platform, as opposed to being just shell.
303 |
304 | On Mac, it's now easy since I packaged it as a brew bottle. For Linux, I'm
305 | waiting for contributions to put it in RPM or DEB packages :)
306 |
307 | Benchmarks
308 | ----------
309 |
310 | So of course, I wanted to check that whatever I was doing was useful. So I did
311 | a couple of benchmarks with the Haskell Criterion library. It's based on my
312 | system and does not guarantee any performances but it gives you an idea of the
313 | improvements. Here goes:
314 | * git-radar - full shell implementation
315 | * githud-syncIO - with normal IOs done one at a time
316 | * githud-asyncIO - with IOs programmed asynchronously for better performance.
317 |
318 | ![Bench]
319 |
320 | [Here](./bench/bench.html) you can find the details
321 |
322 | For information: I ran that on a Macbook Pro 13", 2014, fully boosted, running
323 | with iTerm 2, tmux, oh-my-zsh, inside a git repo with quite some information
324 | to parse
325 |
326 | Thanks
327 | ------
328 |
329 | Well, my thanks to [git-radar](https://github.com/michaeldfallen/git-radar) for the great idea, and to
330 | [guibou](https://github.com/guibou) for the code
331 | reviews
332 |
333 |
334 | [Example]: ./images/prompt.png
335 | [Bench]: ./bench/bench.png
336 |
--------------------------------------------------------------------------------
/Setup.hs:
--------------------------------------------------------------------------------
1 | import Distribution.Simple
2 | main = defaultMain
3 |
--------------------------------------------------------------------------------
/app/githud/Main.hs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import GitHUD
4 |
5 | main :: IO ()
6 | main = githud
7 |
--------------------------------------------------------------------------------
/app/githudd/Main.hs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import GitHUD
4 |
5 | main :: IO ()
6 | main = githudd
7 |
--------------------------------------------------------------------------------
/bench/bench.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/gbataille/gitHUD/9b862a2801516d79b26affef253fce7d09afefc6/bench/bench.png
--------------------------------------------------------------------------------
/docs/PROMPT_EXPLAINED.md:
--------------------------------------------------------------------------------
1 | Prompt Explained
2 | ================
3 |
4 | The prompt built by gitHUD is made of 6 parts:
5 | * [Git Repo Indicator](#git-repo-indicator)
6 | * [Merge branch information](#merge-branch-information)
7 | * [Local branch](#local-branch---detached-information)
8 | * [Commits to push-pull](#commits-to-push-pull)
9 | * [Local repository state](#local-repository-state)
10 | * [Stashes](stashes)
11 |
12 | Each of these parts are described below and each of these parts are actually
13 | optional (all "on" by default). The specific documentation of each part tells
14 | you how to hide it if you wish to.
15 |
16 | ### When not in a git repository
17 |
18 | The gitHUD program exists promptly and does not display anything, i.e. leaves
19 | your prompt empty of any git-related information
20 |
21 | ## Git Repo Indicator
22 |
23 | _Hidden by:_ `show_part_repo_indicator=False`
24 |
25 | | Output part | Description |
26 | |:-----------:| ----------- |
27 | | ![repo_indicator] | This is a small prefix to the gitHUD output that indicates that you are in a git repository and that therefore gitHUD is doing some output. |
28 |
29 | ## Merge Branch information
30 |
31 | _Hidden by:_ `show_part_merge_branch_commits_diff=False`
32 |
33 | This section is for branches that have a remote counterpart (typically long
34 | lived branches). It tells you the difference between your remote
35 | tracking branch and the branch it was created from (both of which can evolve
36 | because of you or because of your colleagues.
37 |
38 | By default, this count does not include merge commits (that are redundant
39 | since the count includes the commits that are on the branch being merged)
40 |
41 | ### No merge branch
42 |
43 | When there is no remote merge branch, this section of the prompt is empty.
44 | This is typically the case when you work on master, or when you work on a
45 | local __short lived__ feature branch that has no remote counterpart.
46 |
47 | | Output part | Description |
48 | |:-----------:| ----------- |
49 | | ![no_upstream] | This means that the current branch (other than master) has no remote tracking branch (typically a short lived feature branch) |
50 |
51 | ### Merge branch
52 |
53 | | Output part | Description | Viz |
54 | |:-----------:| ----------- |:---:|
55 | | ![merge_branch_pull] | This means that the remote parent of your current remote tracking branch has some commits that will need to be merged back in your branch | ![gitgraph_merge_branch_pull] |
56 | | ![merge_branch_push] | This means that your remote tracking branch has some commits that have not yet been merged and pushed to its parent branch | ![gitgraph_merge_branch_push] |
57 | | ![merge_branch_push_pull] | This means that both your remote tracking branch and its parent have evolved and you'll have some merge work to do | ![gitgraph_merge_branch_push_pull] |
58 |
59 | ## Local branch - detached information
60 |
61 | _Hidden by:_ `show_part_local_branch=False`
62 |
63 | | Output part | Description |
64 | |:-----------:| ----------- |
65 | | ![local_branch] | This is the name of the local branch you are working on |
66 | | ![detached] | This is the commit sha on which you are, if you are not at the HEAD of a branch
(typically on rebase situations, conflict resolution, or exploration of an old repo state) |
67 |
68 | ## Commits to push-pull
69 |
70 | _Hidden by:_ `show_part_commits_to_origin=False`
71 |
72 | | Output part | Description | Viz |
73 | |:-----------:| ----------- |:--- |
74 | | ![commits_pull] | This means that some commits on you remote tracking branch have not been pulled (rebased?) locally | ![gitgraph_commits_pull] |
75 | | ![commits_push] | This means that some local commits have not yet been pushed to the remote tracking branch | ![gitgraph_commits_push] |
76 | | ![commits_push_pull] | This means that some commits are to be pulled (rebased?) and some have to be pushed | ![gitgraph_commits_pull_push] |
77 |
78 | ## Local repository state
79 |
80 | _Hidden by:_ `show_part_local_changes_state=False`
81 |
82 | | Output part | Description |
83 | |:-----------:| ----------- |
84 | | ![repo_changes] | The first group is for the status of files in the index:
- A: New files
- D: Deleted files
- M: Modified files
- R: Renamed Files
The second and third groups are about local unstaged file modifications:
- D: Deleted files
- M: Modified files
- A: New Files
|
85 | | ![conflicts] | This indicates files in a conflicted state (typically in the middle of a merge or rebase) |
86 |
87 | ## Stashes
88 |
89 | _Hidden by:_ `show_part_stashes=False`
90 |
91 | | Output part | Description |
92 | |:-----------:| ----------- |
93 | | ![stash] | This means that there are some stashes in your repo |
94 |
95 | [repo_indicator]: ../images/prompt_repo_indicator.png
96 | [commits_pull]: ../images/prompt_commits_pull.png
97 | [commits_push]: ../images/prompt_commits_push.png
98 | [commits_push_pull]: ../images/prompt_commits_push_pull.png
99 | [conflicts]: ../images/prompt_conflicts.png
100 | [detached]: ../images/prompt_detached.png
101 | [local_branch]: ../images/prompt_local_branch.png
102 | [no_upstream]: ../images/prompt_no_upstream.png
103 | [merge_branch_pull]: ../images/prompt_merge_branch_pull.png
104 | [merge_branch_push]: ../images/prompt_merge_branch_push.png
105 | [repo_changes]: ../images/prompt_repo_changes.png
106 | [repo_indicator]: ../images/prompt_repo_indicator.png
107 | [stash]: ../images/prompt_stash.png
108 | [merge_branch_push_pull]: ../images/prompt_merge_branch_push_pull.png
109 |
110 | [gitgraph_merge_branch_pull]: ../images/gitgraph_merge_branch_pull.png
111 | [gitgraph_merge_branch_push]: ../images/gitgraph_merge_branch_push.png
112 | [gitgraph_merge_branch_push_pull]: ../images/gitgraph_merge_branch_push_pull.png
113 |
114 | [gitgraph_commits_pull]: ../images/gitgraph_commits_pull.png
115 | [gitgraph_commits_push]: ../images/gitgraph_commits_push.png
116 | [gitgraph_commits_pull_push]: ../images/gitgraph_commits_pull_push.png
117 |
--------------------------------------------------------------------------------
/docs/auto-fetch/daemon-logic.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/gbataille/gitHUD/9b862a2801516d79b26affef253fce7d09afefc6/docs/auto-fetch/daemon-logic.png
--------------------------------------------------------------------------------
/docs/auto-fetch/daemon-logic.puml:
--------------------------------------------------------------------------------
1 | @startuml
2 | control githudd
3 | control fetcher
4 | database MVar
5 | control listener
6 | control reader
7 |
8 | -> githudd : CLI invocation
9 | githudd -> githudd : parse arguments
10 | githudd -> githudd : get Config
11 |
12 | alt Fetcher not running
13 | githudd -> fetcher : Launch
14 | fetcher -> MVar : Create MVar\nPut current path in it
15 | fetcher -> listener : Open socket
16 | group forever
17 | listener -> listener : Accept
18 | end
19 | else standard
20 | githudd -> listener : Post message on socket
21 | listener -> reader : Create
22 | reader -> reader : Read socket
23 | reader -> MVar : Update MVar
24 | end
25 |
26 | group forever
27 | MVar -> fetcher : Read MVar for path
28 | fetcher -> : git fetch path
29 | end
30 | @enduml
31 |
--------------------------------------------------------------------------------
/flake.lock:
--------------------------------------------------------------------------------
1 | {
2 | "nodes": {
3 | "flake-utils": {
4 | "inputs": {
5 | "systems": "systems"
6 | },
7 | "locked": {
8 | "lastModified": 1694529238,
9 | "narHash": "sha256-zsNZZGTGnMOf9YpHKJqMSsa0dXbfmxeoJ7xHlrt+xmY=",
10 | "owner": "numtide",
11 | "repo": "flake-utils",
12 | "rev": "ff7b65b44d01cf9ba6a71320833626af21126384",
13 | "type": "github"
14 | },
15 | "original": {
16 | "owner": "numtide",
17 | "repo": "flake-utils",
18 | "type": "github"
19 | }
20 | },
21 | "nixpkgs": {
22 | "locked": {
23 | "lastModified": 1700214285,
24 | "narHash": "sha256-KVO8PSTYqkv9zDllar0vAqDy3RXXmJ1zNpOxfWlUqnE=",
25 | "owner": "NixOS",
26 | "repo": "nixpkgs",
27 | "rev": "6769eec801ed1c10b0ed3b7541e693161a8b7c26",
28 | "type": "github"
29 | },
30 | "original": {
31 | "owner": "NixOS",
32 | "repo": "nixpkgs",
33 | "type": "github"
34 | }
35 | },
36 | "root": {
37 | "inputs": {
38 | "flake-utils": "flake-utils",
39 | "nixpkgs": "nixpkgs"
40 | }
41 | },
42 | "systems": {
43 | "locked": {
44 | "lastModified": 1681028828,
45 | "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
46 | "owner": "nix-systems",
47 | "repo": "default",
48 | "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
49 | "type": "github"
50 | },
51 | "original": {
52 | "owner": "nix-systems",
53 | "repo": "default",
54 | "type": "github"
55 | }
56 | }
57 | },
58 | "root": "root",
59 | "version": 7
60 | }
61 |
--------------------------------------------------------------------------------
/flake.nix:
--------------------------------------------------------------------------------
1 | {
2 | description = "githud flake";
3 |
4 | inputs = {
5 | nixpkgs.url = "github:NixOS/nixpkgs";
6 | flake-utils.url = "github:numtide/flake-utils";
7 | };
8 |
9 | outputs = { self, nixpkgs, flake-utils }:
10 | let
11 | overlay = final: prev: {
12 | haskell = prev.haskell // {
13 | packageOverrides = hfinal: hprev:
14 | prev.haskell.packageOverrides hfinal hprev // {
15 | githud =
16 | let
17 | src = builtins.path {
18 | name = "githud-src";
19 | path = ./.;
20 | };
21 | in
22 | hfinal.callCabal2nix "githud" src { };
23 | };
24 | };
25 | githud = final.haskell.lib.justStaticExecutables final.haskellPackages.githud;
26 | };
27 | in
28 | {
29 | overlays.default = overlay;
30 | } // flake-utils.lib.eachDefaultSystem (system:
31 | let
32 | pkgs = import nixpkgs {
33 | inherit system;
34 | overlays = [ self.overlays.default ];
35 | };
36 | in
37 | {
38 | packages.default = pkgs.githud;
39 | devShells.default = pkgs.mkShell {
40 | buildInputs = [
41 | (pkgs.haskell.lib.justStaticExecutables pkgs.haskellPackages.ghcid)
42 | (pkgs.cabal-install)
43 | ];
44 | inputsFrom = [ self.packages.${system}.default.env ];
45 | };
46 | });
47 | }
48 |
--------------------------------------------------------------------------------
/githud.cabal:
--------------------------------------------------------------------------------
1 | cabal-version: 2.2
2 | name: githud
3 | version: 3.3.0
4 | synopsis: Heads up, and you see your GIT context
5 | description: GIT Heads Up Display for your terminal prompt. More efficient replacement to the great git-radar. Please see README.md for more info
6 | homepage: http://github.com/gbataille/gitHUD#readme
7 | license: BSD-3-Clause
8 | license-file: LICENSE
9 | author: Grégory Bataille
10 | maintainer: gregory.bataille@gmail.com
11 | copyright: Grégory Bataille 2015-2020
12 | category: Development
13 | build-type: Simple
14 | -- extra-source-files:
15 |
16 | library
17 | hs-source-dirs: src
18 | exposed-modules: GitHUD
19 | , GitHUD.Config.Parse
20 | , GitHUD.Config.Types
21 | , GitHUD.Daemon.Network
22 | , GitHUD.Daemon.Runner
23 | , GitHUD.Debug
24 | , GitHUD.Git.Types
25 | , GitHUD.Git.Common
26 | , GitHUD.Git.Command
27 | , GitHUD.Git.Parse.Base
28 | , GitHUD.Git.Parse.Status
29 | , GitHUD.Git.Parse.Branch
30 | , GitHUD.Git.Parse.Count
31 | , GitHUD.Process
32 | , GitHUD.Terminal.Base
33 | , GitHUD.Terminal.Prompt
34 | , GitHUD.Terminal.Types
35 | , GitHUD.Types
36 | build-depends: base >= 4.11 && < 5
37 | , bytestring >= 0.10 && < 0.12
38 | , daemons >= 0.3 && < 0.5
39 | , data-default >= 0.7 && < 0.8
40 | , directory >= 1.3 && < 1.4
41 | , filelock >= 0.1.1.4 && < 0.1.2.0
42 | , mtl >= 2.2.2 && < 3
43 | , network >= 2.8 && < 4.0
44 | , parsec >= 3.1.13 && < 4
45 | , process
46 | , text >= 1.2 && < 2.2
47 | , temporary >= 1.3 && < 2
48 | , unix >= 2.7 && < 3
49 | , utf8-string >= 1.0 && < 1.1
50 | default-language: Haskell2010
51 |
52 | executable githud
53 | hs-source-dirs: app/githud
54 | main-is: Main.hs
55 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
56 | build-depends: base
57 | , githud
58 | default-language: Haskell2010
59 |
60 | executable githudd
61 | hs-source-dirs: app/githudd
62 | main-is: Main.hs
63 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
64 | build-depends: base
65 | , githud
66 | default-language: Haskell2010
67 |
68 | test-suite githud-test
69 | type: exitcode-stdio-1.0
70 | hs-source-dirs: test
71 | main-is: Spec.hs
72 | build-depends: base
73 | , tasty >= 1.2 && < 1.5
74 | , tasty-hunit >= 0.10 && < 0.11
75 | , tasty-smallcheck >= 0.8 && < 0.9
76 | , tasty-quickcheck >= 0.10 && < 0.11
77 | , daemons >= 0.3 && < 0.5
78 | , parsec >= 3.1.13 && < 4
79 | , mtl >= 2.2.2 && < 3
80 | , githud
81 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -fsimpl-tick-factor=120
82 | default-language: Haskell2010
83 | Other-modules: Test.GitHUD.Git.Parse.Status
84 | , Test.GitHUD.Git.Parse.Branch
85 | , Test.GitHUD.Git.Common
86 | , Test.GitHUD.Git.Types
87 | , Test.GitHUD.Terminal.Base
88 | , Test.GitHUD.Terminal.Prompt
89 | , Test.GitHUD.Config.Parse
90 |
91 | source-repository head
92 | type: git
93 | location: https://github.com/gbataille/gitHUD
94 |
--------------------------------------------------------------------------------
/images/gitgraph_commits_pull.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/gbataille/gitHUD/9b862a2801516d79b26affef253fce7d09afefc6/images/gitgraph_commits_pull.png
--------------------------------------------------------------------------------
/images/gitgraph_commits_pull_push.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/gbataille/gitHUD/9b862a2801516d79b26affef253fce7d09afefc6/images/gitgraph_commits_pull_push.png
--------------------------------------------------------------------------------
/images/gitgraph_commits_push.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/gbataille/gitHUD/9b862a2801516d79b26affef253fce7d09afefc6/images/gitgraph_commits_push.png
--------------------------------------------------------------------------------
/images/gitgraph_merge_branch_pull.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/gbataille/gitHUD/9b862a2801516d79b26affef253fce7d09afefc6/images/gitgraph_merge_branch_pull.png
--------------------------------------------------------------------------------
/images/gitgraph_merge_branch_push.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/gbataille/gitHUD/9b862a2801516d79b26affef253fce7d09afefc6/images/gitgraph_merge_branch_push.png
--------------------------------------------------------------------------------
/images/gitgraph_merge_branch_push_pull.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/gbataille/gitHUD/9b862a2801516d79b26affef253fce7d09afefc6/images/gitgraph_merge_branch_push_pull.png
--------------------------------------------------------------------------------
/images/prompt.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/gbataille/gitHUD/9b862a2801516d79b26affef253fce7d09afefc6/images/prompt.png
--------------------------------------------------------------------------------
/images/prompt_commits_pull.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/gbataille/gitHUD/9b862a2801516d79b26affef253fce7d09afefc6/images/prompt_commits_pull.png
--------------------------------------------------------------------------------
/images/prompt_commits_push.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/gbataille/gitHUD/9b862a2801516d79b26affef253fce7d09afefc6/images/prompt_commits_push.png
--------------------------------------------------------------------------------
/images/prompt_commits_push_pull.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/gbataille/gitHUD/9b862a2801516d79b26affef253fce7d09afefc6/images/prompt_commits_push_pull.png
--------------------------------------------------------------------------------
/images/prompt_conflicts.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/gbataille/gitHUD/9b862a2801516d79b26affef253fce7d09afefc6/images/prompt_conflicts.png
--------------------------------------------------------------------------------
/images/prompt_detached.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/gbataille/gitHUD/9b862a2801516d79b26affef253fce7d09afefc6/images/prompt_detached.png
--------------------------------------------------------------------------------
/images/prompt_local_branch.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/gbataille/gitHUD/9b862a2801516d79b26affef253fce7d09afefc6/images/prompt_local_branch.png
--------------------------------------------------------------------------------
/images/prompt_merge_branch_pull.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/gbataille/gitHUD/9b862a2801516d79b26affef253fce7d09afefc6/images/prompt_merge_branch_pull.png
--------------------------------------------------------------------------------
/images/prompt_merge_branch_push.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/gbataille/gitHUD/9b862a2801516d79b26affef253fce7d09afefc6/images/prompt_merge_branch_push.png
--------------------------------------------------------------------------------
/images/prompt_merge_branch_push_pull.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/gbataille/gitHUD/9b862a2801516d79b26affef253fce7d09afefc6/images/prompt_merge_branch_push_pull.png
--------------------------------------------------------------------------------
/images/prompt_no_upstream.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/gbataille/gitHUD/9b862a2801516d79b26affef253fce7d09afefc6/images/prompt_no_upstream.png
--------------------------------------------------------------------------------
/images/prompt_repo_changes.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/gbataille/gitHUD/9b862a2801516d79b26affef253fce7d09afefc6/images/prompt_repo_changes.png
--------------------------------------------------------------------------------
/images/prompt_repo_indicator.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/gbataille/gitHUD/9b862a2801516d79b26affef253fce7d09afefc6/images/prompt_repo_indicator.png
--------------------------------------------------------------------------------
/images/prompt_stash.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/gbataille/gitHUD/9b862a2801516d79b26affef253fce7d09afefc6/images/prompt_stash.png
--------------------------------------------------------------------------------
/src/GitHUD.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE OverloadedStrings #-}
2 |
3 | module GitHUD
4 | ( githud,
5 | githudd,
6 | )
7 | where
8 |
9 | import Control.Monad (unless, void, when)
10 | import Control.Monad.Reader (runReader)
11 | import Data.Text
12 | import GitHUD.Config.Parse
13 | import GitHUD.Config.Types
14 | import GitHUD.Daemon.Runner
15 | import GitHUD.Git.Command
16 | import GitHUD.Git.Parse.Base
17 | import GitHUD.Terminal.Prompt
18 | import GitHUD.Terminal.Types
19 | import GitHUD.Types
20 | import System.Directory (getCurrentDirectory)
21 | import System.Environment (getArgs)
22 | import System.Exit (ExitCode (ExitSuccess))
23 | import System.FileLock (SharedExclusive (Exclusive), withTryFileLock)
24 | import System.Posix.Files (fileExist)
25 | import System.Posix.User (getRealUserID, getUserEntryForID, homeDirectory)
26 | import System.Process (readProcessWithExitCode)
27 |
28 | githud :: IO ()
29 | githud = do
30 | -- Exit ASAP if we are not in a git repository
31 | isGit <- checkInGitDirectory
32 | when isGit $ do
33 | shell <- processArguments getArgs
34 | config <- getAppConfig
35 | curDir <- getCurrentDirectory
36 | when (confRunFetcherDaemon config) $
37 | tryRunFetcherDaemon curDir (confGithuddLockFilePath config)
38 | repoState <- getGitRepoState
39 | let prompt = runReader buildPromptWithConfig $ buildOutputConfig shell repoState config
40 | -- Necessary to use putStrLn to properly terminate the output (needs the CR)
41 | putStrLn $ unpack (strip (pack prompt))
42 |
43 | tryRunFetcherDaemon ::
44 | String ->
45 | FilePath ->
46 | IO ()
47 | tryRunFetcherDaemon dir lockPath = do
48 | withTryFileLock lockPath Exclusive (\f -> runFetcherDaemon dir)
49 | return ()
50 | where
51 | runFetcherDaemon dir = do
52 | (code, out, err) <- readProcessWithExitCode "githudd" [dir] ""
53 | unless (Prelude.null err) (putStrLn $ "Issue with githudd: " ++ err)
54 |
55 | processArguments ::
56 | IO [String] ->
57 | IO Shell
58 | processArguments args = getShell <$> args
59 |
60 | getShell ::
61 | [String] ->
62 | Shell
63 | getShell ("zsh" : _) = ZSH
64 | getShell ("bash" : _) = BASH
65 | getShell ("tmux" : _) = TMUX
66 | getShell ("none" : _) = NONE
67 | getShell _ = Other
68 |
69 | getAppConfig :: IO Config
70 | getAppConfig = do
71 | userEntry <- getRealUserID >>= getUserEntryForID
72 | let configFilePath = (homeDirectory userEntry) ++ "/.githudrc"
73 | configFilePresent <- fileExist configFilePath
74 | if configFilePresent
75 | then parseConfigFile configFilePath
76 | else return defaultConfig
77 |
78 | githudd :: IO ()
79 | githudd = do
80 | mArg <- processDaemonArguments <$> getArgs
81 | config <- getAppConfig
82 | runDaemon config mArg
83 |
84 | processDaemonArguments ::
85 | [String] ->
86 | Maybe String
87 | processDaemonArguments [] = Nothing
88 | processDaemonArguments (fst : _) = Just fst
89 |
--------------------------------------------------------------------------------
/src/GitHUD/Config/Parse.hs:
--------------------------------------------------------------------------------
1 | module GitHUD.Config.Parse (
2 | parseConfigFile
3 | , commentParser
4 | , itemParser
5 | , fallThroughItemParser
6 | , configItemsFolder
7 | , ConfigItem(..)
8 | , colorConfigToColor
9 | , intensityConfigToIntensity
10 | , stringConfigToStringList
11 | , redirectionParser
12 | , strConfigToRedirection
13 | , boolConfigToBool
14 | , intConfigToInt
15 | ) where
16 |
17 | import Control.Monad (void, when)
18 | import System.Posix.Daemon (Redirection(ToFile, DevNull))
19 | import Text.Parsec (parse)
20 | import Text.Parsec.Char (anyChar, char, digit, newline, noneOf, letter, spaces, string)
21 | import Text.Parsec.Combinator (choice, eof, many1, manyTill, optional, sepBy)
22 | import Text.Parsec.Prim (many, try, unexpected, (<|>), (>))
23 | import Text.Parsec.String (parseFromFile, Parser)
24 |
25 | import GitHUD.Config.Types
26 | import GitHUD.Terminal.Types
27 |
28 | data ConfigItem = Item String String
29 | | Comment
30 | | ErrorLine deriving (Eq, Show)
31 |
32 | parseConfigFile :: FilePath -> IO Config
33 | parseConfigFile filePath = do
34 | eitherParsed <- parseFromFile configFileParser filePath
35 | return $ either
36 | (const defaultConfig)
37 | id
38 | eitherParsed
39 |
40 | configFileParser :: Parser Config
41 | configFileParser = do
42 | items <- many configItemParser
43 | return $ foldl configItemsFolder defaultConfig items
44 |
45 | configItemParser :: Parser ConfigItem
46 | configItemParser = choice [
47 | commentParser
48 | , itemParser
49 | , fallThroughItemParser
50 | ] > "config file line"
51 |
52 | endItem :: Parser ()
53 | endItem = choice [
54 | void newline
55 | , eof
56 | ] > "end of item"
57 |
58 | commentParser :: Parser ConfigItem
59 | commentParser = try $ do
60 | char '#'
61 | manyTill anyChar (try endItem)
62 | return Comment
63 |
64 | itemParser :: Parser ConfigItem
65 | itemParser = try $ do
66 | key <- manyTill validKeyChar (char '=')
67 | when (key == "") $ unexpected "A key in the config file should not be empty"
68 | value <- manyTill anyChar (try endItem)
69 | return $ Item key value
70 |
71 | validKeyChar :: Parser Char
72 | validKeyChar = letter <|> (char '_')
73 |
74 | -- | Must not be able to process an empty string
75 | -- This is mandated by the use of 'many' in configFileParser
76 | -- Therefore the definition `manyTill anyChar eof` is invalid, thus using newline
77 | fallThroughItemParser :: Parser ConfigItem
78 | fallThroughItemParser = do
79 | manyTill anyChar (try newline)
80 | return ErrorLine
81 |
82 | configItemsFolder :: Config -> ConfigItem -> Config
83 | configItemsFolder conf (Item "show_part_repo_indicator" value) =
84 | conf { confShowPartRepoIndicator = boolConfigToIntensity value }
85 | configItemsFolder conf (Item "show_part_merge_branch_commits_diff" value) =
86 | conf { confShowPartMergeBranchCommitsDiff = boolConfigToIntensity value }
87 | configItemsFolder conf (Item "show_part_local_branch" value) =
88 | conf { confShowPartLocalBranch = boolConfigToIntensity value }
89 | configItemsFolder conf (Item "show_part_commits_to_origin" value) =
90 | conf { confShowPartCommitsToOrigin = boolConfigToIntensity value }
91 | configItemsFolder conf (Item "show_part_local_changes_state" value) =
92 | conf { confShowPartLocalChangesState = boolConfigToIntensity value }
93 | configItemsFolder conf (Item "show_part_stashes" value) =
94 | conf { confShowPartStashes = boolConfigToIntensity value }
95 |
96 | configItemsFolder conf (Item "git_repo_indicator" repoIndicator) = conf { confRepoIndicator = repoIndicator }
97 |
98 | configItemsFolder conf (Item "no_tracked_upstream_text" value) =
99 | conf { confNoTrackedUpstreamString = value }
100 | configItemsFolder conf (Item "no_tracked_upstream_text_color" value) =
101 | conf { confNoTrackedUpstreamStringColor = colorConfigToColor value }
102 | configItemsFolder conf (Item "no_tracked_upstream_text_intensity" value) =
103 | conf { confNoTrackedUpstreamStringIntensity = intensityConfigToIntensity value }
104 | configItemsFolder conf (Item "no_tracked_upstream_indicator" value) =
105 | conf { confNoTrackedUpstreamIndicator = value }
106 | configItemsFolder conf (Item "no_tracked_upstream_indicator_color" value) =
107 | conf { confNoTrackedUpstreamIndicatorColor = colorConfigToColor value }
108 | configItemsFolder conf (Item "no_tracked_upstream_indicator_intensity" value) =
109 | conf { confNoTrackedUpstreamIndicatorIntensity = intensityConfigToIntensity value }
110 |
111 | configItemsFolder conf (Item "merge_branch_commits_indicator" value) =
112 | conf { confMergeBranchCommitsIndicator = value }
113 | configItemsFolder conf (Item "merge_branch_commits_pull_prefix" value) =
114 | conf { confMergeBranchCommitsOnlyPull = value }
115 | configItemsFolder conf (Item "merge_branch_commits_push_prefix" value) =
116 | conf { confMergeBranchCommitsOnlyPush = value }
117 | configItemsFolder conf (Item "merge_branch_commits_push_pull_infix" value) =
118 | conf { confMergeBranchCommitsBothPullPush = value }
119 | configItemsFolder conf (Item "merge_branch_ignore_branches" value) =
120 | conf { confMergeBranchIgnoreBranches = stringConfigToStringList value }
121 |
122 | configItemsFolder conf (Item "local_branch_prefix" value) =
123 | conf { confLocalBranchNamePrefix = value }
124 | configItemsFolder conf (Item "local_branch_suffix" value) =
125 | conf { confLocalBranchNameSuffix = value }
126 | configItemsFolder conf (Item "local_branch_color" value) =
127 | conf { confLocalBranchColor = colorConfigToColor value }
128 | configItemsFolder conf (Item "local_branch_intensity" value) =
129 | conf { confLocalBranchIntensity = intensityConfigToIntensity value }
130 | configItemsFolder conf (Item "local_detached_prefix" value) =
131 | conf { confLocalDetachedPrefix = value }
132 | configItemsFolder conf (Item "local_detached_color" value) =
133 | conf { confLocalDetachedColor = colorConfigToColor value }
134 | configItemsFolder conf (Item "local_detached_intensity" value) =
135 | conf { confLocalDetachedIntensity = intensityConfigToIntensity value }
136 |
137 | configItemsFolder conf (Item "local_commits_push_suffix" value) =
138 | conf { confLocalCommitsPushSuffix = value }
139 | configItemsFolder conf (Item "local_commits_push_suffix_color" value) =
140 | conf { confLocalCommitsPushSuffixColor = colorConfigToColor value }
141 | configItemsFolder conf (Item "local_commits_push_suffix_intensity" value) =
142 | conf { confLocalCommitsPushSuffixIntensity = intensityConfigToIntensity value }
143 | configItemsFolder conf (Item "local_commits_pull_suffix" value) =
144 | conf { confLocalCommitsPullSuffix = value }
145 | configItemsFolder conf (Item "local_commits_pull_suffix_color" value) =
146 | conf { confLocalCommitsPullSuffixColor = colorConfigToColor value }
147 | configItemsFolder conf (Item "local_commits_pull_suffix_intensity" value) =
148 | conf { confLocalCommitsPullSuffixIntensity = intensityConfigToIntensity value }
149 | configItemsFolder conf (Item "local_commits_push_pull_infix" value) =
150 | conf { confLocalCommitsPushPullInfix = value }
151 | configItemsFolder conf (Item "local_commits_push_pull_infix_color" value) =
152 | conf { confLocalCommitsPushPullInfixColor = colorConfigToColor value }
153 | configItemsFolder conf (Item "local_commits_push_pull_infix_intensity" value) =
154 | conf { confLocalCommitsPushPullInfixIntensity = intensityConfigToIntensity value }
155 |
156 | configItemsFolder conf (Item "change_index_add_suffix" value) =
157 | conf { confChangeIndexAddSuffix = value }
158 | configItemsFolder conf (Item "change_index_add_suffix_color" value) =
159 | conf { confChangeIndexAddSuffixColor = colorConfigToColor value }
160 | configItemsFolder conf (Item "change_index_add_suffix_intensity" value) =
161 | conf { confChangeIndexAddSuffixIntensity = intensityConfigToIntensity value }
162 | configItemsFolder conf (Item "change_index_mod_suffix" value) =
163 | conf { confChangeIndexModSuffix = value }
164 | configItemsFolder conf (Item "change_index_mod_suffix_color" value) =
165 | conf { confChangeIndexModSuffixColor = colorConfigToColor value }
166 | configItemsFolder conf (Item "change_index_mod_suffix_intensity" value) =
167 | conf { confChangeIndexModSuffixIntensity = intensityConfigToIntensity value }
168 | configItemsFolder conf (Item "change_index_del_suffix" value) =
169 | conf { confChangeIndexDelSuffix = value }
170 | configItemsFolder conf (Item "change_index_del_suffix_color" value) =
171 | conf { confChangeIndexDelSuffixColor = colorConfigToColor value }
172 | configItemsFolder conf (Item "change_index_del_suffix_intensity" value) =
173 | conf { confChangeIndexDelSuffixIntensity = intensityConfigToIntensity value }
174 | configItemsFolder conf (Item "change_local_add_suffix" value) =
175 | conf { confChangeLocalAddSuffix = value }
176 | configItemsFolder conf (Item "change_local_add_suffix_color" value) =
177 | conf { confChangeLocalAddSuffixColor = colorConfigToColor value }
178 | configItemsFolder conf (Item "change_local_add_suffix_intensity" value) =
179 | conf { confChangeLocalAddSuffixIntensity = intensityConfigToIntensity value }
180 | configItemsFolder conf (Item "change_local_mod_suffix" value) =
181 | conf { confChangeLocalModSuffix = value }
182 | configItemsFolder conf (Item "change_local_mod_suffix_color" value) =
183 | conf { confChangeLocalModSuffixColor = colorConfigToColor value }
184 | configItemsFolder conf (Item "change_local_mod_suffix_intensity" value) =
185 | conf { confChangeLocalModSuffixIntensity = intensityConfigToIntensity value }
186 | configItemsFolder conf (Item "change_local_del_suffix" value) =
187 | conf { confChangeLocalDelSuffix = value }
188 | configItemsFolder conf (Item "change_local_del_suffix_color" value) =
189 | conf { confChangeLocalDelSuffixColor = colorConfigToColor value }
190 | configItemsFolder conf (Item "change_local_del_suffix_intensity" value) =
191 | conf { confChangeLocalDelSuffixIntensity = intensityConfigToIntensity value }
192 | configItemsFolder conf (Item "change_renamed_suffix" value) =
193 | conf { confChangeRenamedSuffix = value }
194 | configItemsFolder conf (Item "change_renamed_suffix_color" value) =
195 | conf { confChangeRenamedSuffixColor = colorConfigToColor value }
196 | configItemsFolder conf (Item "change_renamed_suffix_intensity" value) =
197 | conf { confChangeRenamedSuffixIntensity = intensityConfigToIntensity value }
198 | configItemsFolder conf (Item "change_conflicted_suffix" value) =
199 | conf { confChangeConflictedSuffix = value }
200 | configItemsFolder conf (Item "change_conflicted_suffix_color" value) =
201 | conf { confChangeConflictedSuffixColor = colorConfigToColor value }
202 | configItemsFolder conf (Item "change_conflicted_suffix_intensity" value) =
203 | conf { confChangeConflictedSuffixIntensity = intensityConfigToIntensity value }
204 |
205 | configItemsFolder conf (Item "stash_suffix" value) =
206 | conf { confStashSuffix = value }
207 | configItemsFolder conf (Item "stash_suffix_color" value) =
208 | conf { confStashSuffixColor = colorConfigToColor value }
209 | configItemsFolder conf (Item "stash_suffix_intensity" value) =
210 | conf { confStashSuffixIntensity = intensityConfigToIntensity value }
211 |
212 | configItemsFolder conf (Item "run_fetcher_daemon" value) =
213 | conf { confRunFetcherDaemon = boolConfigToBool value }
214 | configItemsFolder conf (Item "githudd_sleep_seconds" value) =
215 | conf { confGithuddSleepSeconds = intConfigToInt value }
216 | configItemsFolder conf (Item "githudd_pid_file_path" value) =
217 | conf { confGithuddPidFilePath = value }
218 | configItemsFolder conf (Item "githudd_lock_file_path" value) =
219 | conf { confGithuddLockFilePath = value }
220 | configItemsFolder conf (Item "githudd_socket_file_path" value) =
221 | conf { confGithuddSocketFilePath = value }
222 | configItemsFolder conf (Item "githudd_log_file_path" value) =
223 | conf { confGithuddLogFilePath = strConfigToRedirection value }
224 |
225 | configItemsFolder conf _ = conf
226 |
227 | colorConfigToColor :: String -> Color
228 | colorConfigToColor str =
229 | either
230 | (const NoColor)
231 | id
232 | (parse colorParser "" str)
233 |
234 | colorParser :: Parser Color
235 | colorParser = choice [
236 | string "Black" >> return Black
237 | , string "Red" >> return Red
238 | , string "Green" >> return Green
239 | , string "Yellow" >> return Yellow
240 | , string "Blue" >> return Blue
241 | , string "Magenta" >> return Magenta
242 | , string "Cyan" >> return Cyan
243 | , string "White" >> return White
244 | , string "NoColor" >> return NoColor
245 | ] > "color"
246 |
247 | intensityConfigToIntensity :: String -> ColorIntensity
248 | intensityConfigToIntensity str =
249 | either
250 | (const Vivid)
251 | id
252 | (parse intensityParser "" str)
253 |
254 | intensityParser :: Parser ColorIntensity
255 | intensityParser = choice [
256 | string "Dull" >> return Dull
257 | , string "Vivid" >> return Vivid
258 | ] > "intensity"
259 |
260 | boolConfigToIntensity :: String -> Bool
261 | boolConfigToIntensity str =
262 | either
263 | (const True)
264 | id
265 | (parse boolParser "" str)
266 |
267 | stringConfigToStringList :: String -> [String]
268 | stringConfigToStringList str =
269 | either
270 | (const [])
271 | id
272 | (parse stringListParser "" str)
273 |
274 | stringListParser :: Parser [String]
275 | stringListParser = do
276 | branchNameList <- sepBy stripedBranchName (char ',')
277 | return $ filter noEmptyStringFilter branchNameList
278 |
279 | noEmptyStringFilter :: String -> Bool
280 | noEmptyStringFilter = (/=) ""
281 |
282 | stripedBranchName :: Parser String
283 | stripedBranchName = do
284 | spaces
285 | branchName <- many (noneOf [',', ' '])
286 | spaces
287 | return branchName
288 |
289 | intParser :: Parser Int
290 | intParser = read <$> many1 digit
291 |
292 | intConfigToInt :: String -> Int
293 | intConfigToInt str =
294 | either
295 | (const 30)
296 | id
297 | (parse intParser "" str)
298 |
299 | boolParser :: Parser Bool
300 | boolParser = choice [
301 | string "False" >> return False
302 | , string "F" >> return False
303 | , string "false" >> return False
304 | , string "f" >> return False
305 | , string "No" >> return False
306 | , string "N" >> return False
307 | , string "no" >> return False
308 | , string "n" >> return False
309 | , string "True" >> return True
310 | , string "T" >> return True
311 | , string "true" >> return True
312 | , string "t" >> return True
313 | , string "Yes" >> return True
314 | , string "Y" >> return True
315 | , string "yes" >> return True
316 | , string "y" >> return True
317 | ] > "bool"
318 |
319 | boolConfigToBool :: String -> Bool
320 | boolConfigToBool str =
321 | either
322 | (const False)
323 | id
324 | (parse boolParser "" str)
325 |
326 | strConfigToRedirection :: String -> Redirection
327 | strConfigToRedirection str =
328 | either
329 | (const DevNull)
330 | id
331 | (parse redirectionParser "" str)
332 |
333 | redirectionParser :: Parser Redirection
334 | redirectionParser =
335 | choice [
336 | try (string "/dev/null") >> return DevNull
337 | , ToFile <$> many1 anyChar
338 | ] > "Redirection"
339 |
--------------------------------------------------------------------------------
/src/GitHUD/Config/Types.hs:
--------------------------------------------------------------------------------
1 | module GitHUD.Config.Types (
2 | Config(..)
3 | , defaultConfig
4 | ) where
5 |
6 | import System.IO.Temp (getCanonicalTemporaryDirectory)
7 | import System.IO.Unsafe (unsafePerformIO)
8 | import System.Posix.Daemon (Redirection(DevNull, ToFile))
9 |
10 | import GitHUD.Terminal.Types
11 |
12 | instance Eq Redirection where
13 | (==) DevNull DevNull = True
14 | (==) _ DevNull = False
15 | (==) DevNull _ = False
16 | (==) (ToFile a) (ToFile b) = a == b
17 |
18 | data Config = Config {
19 | confShowPartRepoIndicator :: Bool
20 | , confShowPartMergeBranchCommitsDiff :: Bool
21 | , confShowPartLocalBranch :: Bool
22 | , confShowPartCommitsToOrigin :: Bool
23 | , confShowPartLocalChangesState :: Bool
24 | , confShowPartStashes :: Bool
25 |
26 | , confRepoIndicator :: String
27 |
28 | , confNoTrackedUpstreamString :: String
29 | , confNoTrackedUpstreamStringColor :: Color
30 | , confNoTrackedUpstreamStringIntensity :: ColorIntensity
31 | , confNoTrackedUpstreamIndicator :: String
32 | , confNoTrackedUpstreamIndicatorColor :: Color
33 | , confNoTrackedUpstreamIndicatorIntensity :: ColorIntensity
34 |
35 | , confMergeBranchCommitsIndicator :: String
36 | , confMergeBranchCommitsOnlyPush :: String
37 | , confMergeBranchCommitsOnlyPull :: String
38 | , confMergeBranchCommitsBothPullPush :: String
39 | , confMergeBranchIgnoreBranches :: [String]
40 |
41 | , confLocalBranchNamePrefix :: String
42 | , confLocalBranchNameSuffix :: String
43 | , confLocalDetachedPrefix :: String
44 | , confLocalBranchColor :: Color
45 | , confLocalBranchIntensity :: ColorIntensity
46 | , confLocalDetachedColor :: Color
47 | , confLocalDetachedIntensity :: ColorIntensity
48 |
49 | , confLocalCommitsPushSuffix :: String
50 | , confLocalCommitsPushSuffixColor :: Color
51 | , confLocalCommitsPushSuffixIntensity :: ColorIntensity
52 | , confLocalCommitsPullSuffix :: String
53 | , confLocalCommitsPullSuffixColor :: Color
54 | , confLocalCommitsPullSuffixIntensity :: ColorIntensity
55 | , confLocalCommitsPushPullInfix :: String
56 | , confLocalCommitsPushPullInfixColor :: Color
57 | , confLocalCommitsPushPullInfixIntensity :: ColorIntensity
58 |
59 | , confChangeIndexAddSuffix :: String
60 | , confChangeIndexAddSuffixColor :: Color
61 | , confChangeIndexAddSuffixIntensity :: ColorIntensity
62 | , confChangeIndexModSuffix :: String
63 | , confChangeIndexModSuffixColor :: Color
64 | , confChangeIndexModSuffixIntensity :: ColorIntensity
65 | , confChangeIndexDelSuffix :: String
66 | , confChangeIndexDelSuffixColor :: Color
67 | , confChangeIndexDelSuffixIntensity :: ColorIntensity
68 | , confChangeLocalAddSuffix :: String
69 | , confChangeLocalAddSuffixColor :: Color
70 | , confChangeLocalAddSuffixIntensity :: ColorIntensity
71 | , confChangeLocalModSuffix :: String
72 | , confChangeLocalModSuffixColor :: Color
73 | , confChangeLocalModSuffixIntensity :: ColorIntensity
74 | , confChangeLocalDelSuffix :: String
75 | , confChangeLocalDelSuffixColor :: Color
76 | , confChangeLocalDelSuffixIntensity :: ColorIntensity
77 | , confChangeRenamedSuffix :: String
78 | , confChangeRenamedSuffixColor :: Color
79 | , confChangeRenamedSuffixIntensity :: ColorIntensity
80 | , confChangeConflictedSuffix :: String
81 | , confChangeConflictedSuffixColor :: Color
82 | , confChangeConflictedSuffixIntensity :: ColorIntensity
83 |
84 | , confStashSuffix :: String
85 | , confStashSuffixColor :: Color
86 | , confStashSuffixIntensity :: ColorIntensity
87 |
88 | , confRunFetcherDaemon :: Bool
89 | , confGithuddSleepSeconds :: Int
90 | , confGithuddPidFilePath :: FilePath
91 | , confGithuddLockFilePath :: FilePath
92 | , confGithuddSocketFilePath :: FilePath
93 |
94 | , confGithuddLogFilePath :: Redirection
95 | } deriving (Eq, Show)
96 |
97 | tempDir :: String
98 | tempDir = unsafePerformIO getCanonicalTemporaryDirectory
99 |
100 | defaultConfig :: Config
101 | defaultConfig = Config {
102 | confShowPartRepoIndicator = True
103 | , confShowPartMergeBranchCommitsDiff = True
104 | , confShowPartLocalBranch = True
105 | , confShowPartCommitsToOrigin = True
106 | , confShowPartLocalChangesState = True
107 | , confShowPartStashes = True
108 |
109 | , confRepoIndicator = "ᚴ"
110 |
111 | , confNoTrackedUpstreamString = "upstream"
112 | , confNoTrackedUpstreamStringColor = Red
113 | , confNoTrackedUpstreamStringIntensity = Vivid
114 | , confNoTrackedUpstreamIndicator = "\9889"
115 | , confNoTrackedUpstreamIndicatorColor = Red
116 | , confNoTrackedUpstreamIndicatorIntensity = Vivid
117 |
118 | , confMergeBranchCommitsIndicator = "\120366"
119 | , confMergeBranchCommitsOnlyPush = "\8592"
120 | , confMergeBranchCommitsOnlyPull = "\8594"
121 | , confMergeBranchCommitsBothPullPush = "\8644"
122 | , confMergeBranchIgnoreBranches = ["gh-pages"]
123 |
124 | , confLocalBranchNamePrefix = "["
125 | , confLocalBranchNameSuffix = "]"
126 | , confLocalDetachedPrefix = "detached@"
127 | , confLocalBranchColor = NoColor
128 | , confLocalBranchIntensity = Vivid
129 | , confLocalDetachedColor = Yellow
130 | , confLocalDetachedIntensity = Vivid
131 |
132 | , confLocalCommitsPushSuffix = "\8593"
133 | , confLocalCommitsPushSuffixColor = Green
134 | , confLocalCommitsPushSuffixIntensity = Vivid
135 | , confLocalCommitsPullSuffix = "\8595"
136 | , confLocalCommitsPullSuffixColor = Red
137 | , confLocalCommitsPullSuffixIntensity = Vivid
138 | , confLocalCommitsPushPullInfix = "⥯"
139 | , confLocalCommitsPushPullInfixColor = Green
140 | , confLocalCommitsPushPullInfixIntensity = Vivid
141 |
142 | , confChangeIndexAddSuffix = "A"
143 | , confChangeIndexAddSuffixColor = Green
144 | , confChangeIndexAddSuffixIntensity = Vivid
145 | , confChangeIndexModSuffix = "M"
146 | , confChangeIndexModSuffixColor = Green
147 | , confChangeIndexModSuffixIntensity = Vivid
148 | , confChangeIndexDelSuffix = "D"
149 | , confChangeIndexDelSuffixColor = Green
150 | , confChangeIndexDelSuffixIntensity = Vivid
151 | , confChangeLocalAddSuffix = "A"
152 | , confChangeLocalAddSuffixColor = White
153 | , confChangeLocalAddSuffixIntensity = Vivid
154 | , confChangeLocalModSuffix = "M"
155 | , confChangeLocalModSuffixColor = Red
156 | , confChangeLocalModSuffixIntensity = Vivid
157 | , confChangeLocalDelSuffix = "D"
158 | , confChangeLocalDelSuffixColor = Red
159 | , confChangeLocalDelSuffixIntensity = Vivid
160 | , confChangeRenamedSuffix = "R"
161 | , confChangeRenamedSuffixColor = Green
162 | , confChangeRenamedSuffixIntensity = Vivid
163 | , confChangeConflictedSuffix = "C"
164 | , confChangeConflictedSuffixColor = Green
165 | , confChangeConflictedSuffixIntensity = Vivid
166 |
167 | , confStashSuffix = "≡"
168 | , confStashSuffixColor = Green
169 | , confStashSuffixIntensity = Vivid
170 |
171 | , confRunFetcherDaemon = True
172 | , confGithuddSleepSeconds = 30
173 | , confGithuddPidFilePath = tempDir ++ "/githudd.pid"
174 | , confGithuddLockFilePath = tempDir ++ "/githudd.lock"
175 | , confGithuddSocketFilePath = tempDir ++ "/githudd.socket"
176 |
177 | , confGithuddLogFilePath = DevNull
178 | }
179 |
--------------------------------------------------------------------------------
/src/GitHUD/Daemon/Network.hs:
--------------------------------------------------------------------------------
1 | module GitHUD.Daemon.Network (
2 | sendOnSocket,
3 | receiveOnSocket,
4 | ) where
5 |
6 | import Control.Concurrent (forkFinally)
7 | import qualified Control.Exception as E
8 | import Control.Monad (forever, void, when)
9 | import qualified Data.ByteString as S
10 | import qualified Data.ByteString.UTF8 as BSU
11 | import Network.Socket (Family(AF_UNIX), socket, defaultProtocol, Socket, SocketType(Stream), close, listen, accept, bind, SockAddr(SockAddrUnix), connect)
12 | import Network.Socket.ByteString (recv, sendAll)
13 | import System.Directory (removeFile)
14 | import System.Posix.Files (fileExist)
15 |
16 | sendOnSocket :: FilePath
17 | -> String
18 | -> IO ()
19 | sendOnSocket socketPath msg =
20 | E.bracket open mClose (mTalkOnClientSocket msg)
21 | where
22 | open = do
23 | socketExists <- fileExist socketPath
24 | if socketExists
25 | then do
26 | sock <- socket AF_UNIX Stream defaultProtocol
27 | connect sock (SockAddrUnix socketPath)
28 | return $ Just sock
29 | else return Nothing
30 | mClose = maybe (return ()) close
31 |
32 | mTalkOnClientSocket :: String
33 | -> Maybe Socket
34 | -> IO ()
35 | mTalkOnClientSocket _ Nothing = return ()
36 | mTalkOnClientSocket msg (Just sock) = sendAll sock $ BSU.fromString msg
37 |
38 | receiveOnSocket :: FilePath
39 | -> (String -> IO m)
40 | -> IO ()
41 | receiveOnSocket socketPath withMessageCb = do
42 | socketExists <- fileExist socketPath
43 | when socketExists (removeFile socketPath)
44 | E.bracket open close loop
45 | where
46 | open = do
47 | sock <- socket AF_UNIX Stream defaultProtocol
48 | bind sock (SockAddrUnix socketPath)
49 | listen sock 1
50 | return sock
51 | loop sock = forever $ do
52 | (conn, peer) <- accept sock
53 | void $ forkFinally (talk conn) (\_ -> close conn)
54 | talk conn = (readPacket conn "") >>= withMessageCb
55 | readPacket conn acc = do
56 | msg <- recv conn 1024
57 | if (S.null msg)
58 | then return acc
59 | else readPacket conn (acc ++ (BSU.toString msg))
60 |
--------------------------------------------------------------------------------
/src/GitHUD/Daemon/Runner.hs:
--------------------------------------------------------------------------------
1 | {-# LANGUAGE NumericUnderscores #-}
2 | {-# LANGUAGE TypeApplications #-}
3 | module GitHUD.Daemon.Runner (
4 | runDaemon
5 | ) where
6 |
7 | import Control.Concurrent (forkIO, threadDelay)
8 | import Control.Concurrent.MVar (MVar, readMVar, newMVar, swapMVar)
9 | import qualified Control.Exception as E
10 | import Control.Monad (when, forever, void, unless)
11 | import qualified Data.ByteString.UTF8 as BSU
12 | import Data.Maybe (fromMaybe)
13 | import System.Directory (removeFile)
14 | import System.Exit (exitFailure)
15 | import System.Posix.Daemon (brutalKill, isRunning, runDetached, Redirection(DevNull, ToFile))
16 | import System.Posix.Files (fileExist)
17 |
18 | import GitHUD.Config.Types
19 | import GitHUD.Daemon.Network
20 | import GitHUD.Debug
21 | import GitHUD.Git.Command
22 |
23 | runDaemon :: Config
24 | -> Maybe String
25 | -> IO ()
26 | runDaemon = tryRunDaemon 5
27 |
28 | tryRunDaemon :: Int
29 | -> Config
30 | -> Maybe String
31 | -> IO ()
32 | tryRunDaemon attempt config mArg = do
33 | let pathToPoll = (fromMaybe "/" mArg)
34 | -- If there are exception trying to access the pid file or the socket,
35 | -- we just kill the process and start again
36 | success <- E.try @E.SomeException $ do
37 | ensureDaemonRunning config socketFile pathToPoll
38 | sendOnSocket socketFile pathToPoll
39 | restartIfNeeded attempt success
40 | where
41 | socketFile = confGithuddSocketFilePath config
42 | pidFilePath = confGithuddPidFilePath config
43 | restartIfNeeded 0 _ = void exitFailure
44 | restartIfNeeded _ (Right _) = return ()
45 | restartIfNeeded attempt (Left e) = do
46 | debugOnStderr $ show e
47 | debugOnStderr "Error on client. Restarting daemon"
48 | E.try @E.SomeException (brutalKill pidFilePath) -- ignore possible errors
49 | threadDelay 100_000
50 | pidFileExists <- fileExist pidFilePath
51 | when pidFileExists (removeFile pidFilePath)
52 | tryRunDaemon (attempt - 1) config mArg
53 |
54 | ensureDaemonRunning :: Config
55 | -> FilePath
56 | -> FilePath
57 | -> IO ()
58 | ensureDaemonRunning config socketPath pathToPoll = do
59 | running <- isRunning pidFilePath
60 | unless running $ do
61 | removeLogFile stdoutFile
62 | runDetached (Just pidFilePath) stdoutFile (daemon delaySec pathToPoll socketPath)
63 | threadDelay 100_000 -- Give the daemon some time to start
64 | where
65 | stdoutFile = confGithuddLogFilePath config
66 | pidFilePath = confGithuddPidFilePath config
67 | delaySec = confGithuddSleepSeconds config
68 |
69 | removeLogFile :: Redirection
70 | -> IO ()
71 | removeLogFile DevNull = return ()
72 | removeLogFile (ToFile file) = do
73 | debugFileExists <- fileExist file
74 | when debugFileExists (removeFile file)
75 |
76 | daemon :: Int
77 | -> FilePath
78 | -> FilePath
79 | -> IO ()
80 | daemon delaySec path socket = do
81 | pathToPoll <- newMVar path
82 | forkIO $ socketServer socket pathToPoll
83 | forever $ fetcher delaySec pathToPoll
84 |
85 | socketServer :: FilePath
86 | -> MVar String
87 | -> IO ()
88 | socketServer socketPath mvar = do
89 | success <- E.try @E.SomeException (receiveOnSocket socketPath withMessage)
90 | restartIfNeeded success
91 | where
92 | withMessage = swapMVar mvar
93 | restartIfNeeded (Right _) = return ()
94 | restartIfNeeded (Left e) = do
95 | debug "Error on server. Restarting socket"
96 | debug $ show e
97 | threadDelay 100_000
98 | socketServer socketPath mvar
99 |
100 | fetcher :: Int
101 | -> MVar String
102 | -> IO ()
103 | fetcher delaySec mvar = do
104 | path <- readMVar mvar
105 | gitCmdFetch path
106 | threadDelay $ delaySec * 1_000_000
107 | return ()
108 |
--------------------------------------------------------------------------------
/src/GitHUD/Debug.hs:
--------------------------------------------------------------------------------
1 | module GitHUD.Debug (
2 | debug,
3 | debugOnStderr
4 | ) where
5 |
6 | import Control.Monad (when)
7 | import Data.Maybe (fromMaybe)
8 | import System.Environment (lookupEnv)
9 | import System.IO (stdout, stderr, hFlush, hPutStrLn)
10 |
11 | debugEnvVar :: String
12 | debugEnvVar = "GITHUD_DEBUG"
13 |
14 | debugEnvVarValue :: String
15 | debugEnvVarValue = "TRUE"
16 |
17 | isDebugActive :: IO Bool
18 | isDebugActive = do
19 | env <- lookupEnv debugEnvVar
20 | let debug = fromMaybe "FALSE" env
21 | return $ debug == debugEnvVarValue
22 |
23 | whenDebugActive :: IO () -> IO ()
24 | whenDebugActive effect = do
25 | debugActive <- isDebugActive
26 | if debugActive then effect else return ()
27 |
28 | debug :: String
29 | -> IO ()
30 | debug msg = whenDebugActive $ do
31 | putStrLn msg
32 | hFlush stdout
33 |
34 | debugOnStderr :: String
35 | -> IO ()
36 | debugOnStderr msg = whenDebugActive $ do
37 | hPutStrLn stderr msg
38 | hFlush stderr
39 |
--------------------------------------------------------------------------------
/src/GitHUD/Git/Command.hs:
--------------------------------------------------------------------------------
1 | module GitHUD.Git.Command (
2 | gitCmdLocalBranchName
3 | , gitCmdMergeBase
4 | , gitCmdRemoteName
5 | , gitCmdRemoteBranchName
6 | , gitCmdPorcelainStatus
7 | , gitCmdRevToPush
8 | , gitCmdRevToPull
9 | , gitCmdStashCount
10 | , gitCmdCommitShortSHA
11 | , gitCmdCommitTag
12 | , gitCmdFetch
13 | , checkInGitDirectory
14 | ) where
15 |
16 | import Control.Concurrent.MVar (MVar, putMVar)
17 | import Control.Monad (void)
18 | import GHC.IO.Handle (hGetLine)
19 | import System.Directory (doesDirectoryExist)
20 | import System.Exit (ExitCode(ExitSuccess))
21 | import System.Process (readCreateProcessWithExitCode, readProcessWithExitCode, proc, StdStream(CreatePipe, UseHandle), createProcess, CreateProcess(..))
22 |
23 | import GitHUD.Process (readProcessWithIgnoreExitCode)
24 | import GitHUD.Git.Common
25 |
26 | checkInGitDirectory :: IO Bool
27 | checkInGitDirectory = do
28 | (exCode, _, _) <- readProcessWithExitCode "git" ["rev-parse", "--git-dir"] ""
29 | return (exCode == ExitSuccess)
30 |
31 | gitCmdLocalBranchName :: MVar String -> IO ()
32 | gitCmdLocalBranchName out = do
33 | localBranch <- readProcessWithIgnoreExitCode "git" ["symbolic-ref", "--short", "HEAD"] ""
34 | putMVar out localBranch
35 |
36 | gitCmdMergeBase :: String -- ^ local branch name
37 | -> MVar String -- ^ output Mvar
38 | -> IO ()
39 | gitCmdMergeBase localBranchName out = do
40 | mergeBase <- readProcessWithIgnoreExitCode "git" ["merge-base", "origin/master", localBranchName] ""
41 | putMVar out mergeBase
42 |
43 | gitCmdRemoteName :: String -- ^ local branch name
44 | -> MVar String -- ^ the output mvar
45 | -> IO ()
46 | gitCmdRemoteName localBranchName out = do
47 | remoteName <- readProcessWithIgnoreExitCode "git" ["config", "--get", gitRemoteTrackingConfigKey localBranchName] ""
48 | putMVar out remoteName
49 |
50 | gitCmdRemoteBranchName :: String -- ^ remote name
51 | -> MVar String -- ^ The output mvar
52 | -> IO ()
53 | gitCmdRemoteBranchName remoteName out = do
54 | remoteBranch <- readProcessWithIgnoreExitCode "git" ["config", "--get", gitRemoteBranchConfigKey remoteName] ""
55 | putMVar out remoteBranch
56 |
57 |
58 | gitCmdPorcelainStatus :: MVar String -> IO ()
59 | gitCmdPorcelainStatus out = do
60 | porcelainStatus <- readProcessWithIgnoreExitCode "git" ["status", "--porcelain"] ""
61 | putMVar out porcelainStatus
62 |
63 | gitCmdRevToPush :: String -- ^ from revision
64 | -> String -- ^ to revision
65 | -> MVar String -- ^ The output mvar
66 | -> IO ()
67 | gitCmdRevToPush fromCommit toCommit out = do
68 | revToPush <- readProcessWithIgnoreExitCode "git" ["rev-list", "--no-merges", "--right-only", "--count", mergeBaseDiffFromTo fromCommit toCommit] ""
69 | putMVar out revToPush
70 |
71 | gitCmdRevToPull :: String -- ^ from revision
72 | -> String -- ^ to revision
73 | -> MVar String -- ^ The output mvar
74 | -> IO ()
75 | gitCmdRevToPull fromCommit toCommit out = do
76 | revToPull <- readProcessWithIgnoreExitCode "git" ["rev-list", "--no-merges", "--left-only", "--count", mergeBaseDiffFromTo fromCommit toCommit] ""
77 | putMVar out revToPull
78 |
79 | gitCmdStashCount :: MVar String -- ^ The output mvar
80 | -> IO ()
81 | gitCmdStashCount out = do
82 | ( _, Just hGitStashList, _, _) <- createProcess
83 | (proc "git" ["stash", "list"])
84 | { std_out = CreatePipe }
85 | ( _, Just hCountStr, _, _) <- createProcess
86 | (proc "wc" ["-l"])
87 | { std_in = UseHandle hGitStashList, std_out = CreatePipe }
88 | count <- hGetLine hCountStr
89 | putMVar out count
90 |
91 | gitCmdCommitShortSHA :: MVar String
92 | -> IO ()
93 | gitCmdCommitShortSHA out = do
94 | shortSHA <- readProcessWithIgnoreExitCode "git" ["rev-parse", "--short", "HEAD"] ""
95 | putMVar out shortSHA
96 |
97 | gitCmdCommitTag :: MVar String
98 | -> IO ()
99 | gitCmdCommitTag out = do
100 | tag <- readProcessWithIgnoreExitCode "git" ["describe", "--exact-match", "--tags"] ""
101 | putMVar out tag
102 |
103 | gitCmdFetch :: String
104 | -> IO ()
105 | gitCmdFetch path = do
106 | isDir <- doesDirectoryExist path
107 | if isDir
108 | then do
109 | let fetch_proc = (proc "git" ["fetch"]) { cwd = Just path }
110 | void $ readCreateProcessWithExitCode fetch_proc ""
111 | else
112 | putStrLn ("Folder" ++ path ++ " does not exist")
113 |
--------------------------------------------------------------------------------
/src/GitHUD/Git/Common.hs:
--------------------------------------------------------------------------------
1 | module GitHUD.Git.Common (
2 | gitRemoteTrackingConfigKey
3 | , gitRemoteBranchConfigKey
4 | , mergeBaseDiffFromTo
5 | ) where
6 |
7 |
8 | gitRemoteTrackingConfigKey :: String -> String
9 | gitRemoteTrackingConfigKey localBranchName = "branch." ++ localBranchName ++ ".remote"
10 |
11 | gitRemoteBranchConfigKey :: String -> String
12 | gitRemoteBranchConfigKey localBranchName = "branch." ++ localBranchName ++ ".merge"
13 |
14 | mergeBaseDiffFromTo :: String -> String -> String
15 | mergeBaseDiffFromTo fromCommit toCommit = fromCommit ++ "..." ++ toCommit
16 |
17 |
--------------------------------------------------------------------------------
/src/GitHUD/Git/Parse/Base.hs:
--------------------------------------------------------------------------------
1 | module GitHUD.Git.Parse.Base (
2 | getGitRepoState
3 | ) where
4 |
5 | import Control.Applicative ((<$>))
6 | import Control.Concurrent (forkIO)
7 | import Control.Concurrent.MVar (newEmptyMVar, takeMVar)
8 |
9 | import GitHUD.Git.Types
10 | import GitHUD.Git.Command
11 | import GitHUD.Git.Parse.Status
12 | import GitHUD.Git.Parse.Branch
13 | import GitHUD.Git.Parse.Count
14 |
15 | removeEndingNewline :: String -> String
16 | removeEndingNewline str = concat . lines $ str
17 |
18 | getGitRepoState :: IO GitRepoState
19 | getGitRepoState = do
20 | -- Preparing MVars
21 | mvLocalBranch <- newEmptyMVar
22 | mvGitStatus <- newEmptyMVar
23 | mvRemoteName <- newEmptyMVar
24 | mvStashCount <- newEmptyMVar
25 | mvCommitShortSHA <- newEmptyMVar
26 | mvCommitTag <- newEmptyMVar
27 |
28 | forkIO $ gitCmdLocalBranchName mvLocalBranch
29 | forkIO $ gitCmdPorcelainStatus mvGitStatus
30 | forkIO $ gitCmdStashCount mvStashCount
31 | forkIO $ gitCmdCommitShortSHA mvCommitShortSHA
32 | forkIO $ gitCmdCommitTag mvCommitTag
33 |
34 | localBranchName <- removeEndingNewline <$> (takeMVar mvLocalBranch)
35 | forkIO $ gitCmdRemoteName localBranchName mvRemoteName
36 |
37 | remoteName <- removeEndingNewline <$> takeMVar mvRemoteName
38 | repoState <- gitParseStatus <$> takeMVar mvGitStatus
39 | stashCountStr <- takeMVar mvStashCount
40 | commitShortSHA <- removeEndingNewline <$> takeMVar mvCommitShortSHA
41 | commitTag <- removeEndingNewline <$> takeMVar mvCommitTag
42 |
43 | fillGitRemoteRepoState zeroGitRepoState {
44 | gitLocalRepoChanges = repoState
45 | , gitRemote = remoteName
46 | , gitLocalBranch = localBranchName
47 | , gitCommitShortSHA = commitShortSHA
48 | , gitCommitTag = commitTag
49 | , gitStashCount = (getCount stashCountStr)
50 | }
51 |
52 | fillGitRemoteRepoState :: GitRepoState
53 | -> IO GitRepoState
54 | fillGitRemoteRepoState repoState@( GitRepoState { gitRemote = ""} ) = return repoState
55 | fillGitRemoteRepoState repoState = do
56 | mvRemoteBranchName <- newEmptyMVar
57 | mvMergeBase <- newEmptyMVar
58 | mvCommitsToPull <- newEmptyMVar
59 | mvCommitsToPush <- newEmptyMVar
60 |
61 | forkIO $ gitCmdRemoteBranchName (gitLocalBranch repoState) mvRemoteBranchName
62 | forkIO $ gitCmdMergeBase (gitLocalBranch repoState) mvMergeBase
63 | remoteBranch <- removeEndingNewline <$> (takeMVar mvRemoteBranchName)
64 | mergeBase <- removeEndingNewline <$> (takeMVar mvMergeBase)
65 |
66 | let fullRemoteBranchName = buildFullyQualifiedRemoteBranchName (gitRemote repoState) remoteBranch
67 |
68 | -- TODO: gbataille - Check for merge-base. If none, don't execute remote part
69 | forkIO $ gitCmdRevToPush fullRemoteBranchName "HEAD" mvCommitsToPush
70 | forkIO $ gitCmdRevToPull fullRemoteBranchName "HEAD" mvCommitsToPull
71 |
72 | (mergeBranchToPull, mergeBranchToPush) <- getRemoteMasterMergeState mergeBase fullRemoteBranchName
73 |
74 | commitsToPushStr <- takeMVar mvCommitsToPush
75 | let commitsToPush = getCount commitsToPushStr
76 | commitsToPullStr <- takeMVar mvCommitsToPull
77 | let commitsToPull = getCount commitsToPullStr
78 |
79 | return repoState {
80 | gitRemoteTrackingBranch = remoteBranch
81 | , gitCommitsToPull = commitsToPull
82 | , gitCommitsToPush = commitsToPush
83 | , gitMergeBranchCommitsToPull = mergeBranchToPull
84 | , gitMergeBranchCommitsToPush = mergeBranchToPush
85 | }
86 |
87 | getRemoteMasterMergeState :: String -- ^ the merge base
88 | -> String -- ^ the fully qualified remote branch name
89 | -> IO (Int, Int) -- ^ tuple containing (to pull, to push)
90 | getRemoteMasterMergeState "" _ = return (0, 0)
91 | getRemoteMasterMergeState _ fullRemoteBranchName = do
92 | mvMergeBranchCommitsToPull <- newEmptyMVar
93 | mvMergeBranchCommitsToPush <- newEmptyMVar
94 |
95 | forkIO $ gitCmdRevToPush "origin/master" fullRemoteBranchName mvMergeBranchCommitsToPush
96 | forkIO $ gitCmdRevToPull "origin/master" fullRemoteBranchName mvMergeBranchCommitsToPull
97 |
98 | mergeBranchCommitsToRMasterStr <- takeMVar mvMergeBranchCommitsToPull
99 | let mergeBranchCommitsToRMaster = getCount mergeBranchCommitsToRMasterStr
100 | mergeBranchCommitsToMergeStr <- takeMVar mvMergeBranchCommitsToPush
101 | let mergeBranchCommitsToMerge = getCount mergeBranchCommitsToMergeStr
102 |
103 | return (mergeBranchCommitsToRMaster, mergeBranchCommitsToMerge)
104 |
--------------------------------------------------------------------------------
/src/GitHUD/Git/Parse/Branch.hs:
--------------------------------------------------------------------------------
1 | module GitHUD.Git.Parse.Branch (
2 | buildFullyQualifiedRemoteBranchName
3 | ) where
4 |
5 | import Text.Parsec (parse)
6 | import Text.Parsec.String (Parser)
7 | import Text.Parsec.Char (anyChar, string)
8 | import Text.Parsec.Prim (many)
9 |
10 | buildFullyQualifiedRemoteBranchName :: String -- ^ remote
11 | -> String -- ^ remote Branch Name
12 | -> String
13 | buildFullyQualifiedRemoteBranchName remote branch =
14 | remote ++ "/" ++ (simpleRemoteBranchName branch)
15 |
16 | simpleRemoteBranchName :: String
17 | -> String
18 | simpleRemoteBranchName branch =
19 | either
20 | (const "")
21 | id
22 | (parse remoteBranchParser "" branch)
23 |
24 | remoteBranchParser :: Parser String
25 | remoteBranchParser = do
26 | string "refs/heads/"
27 | many anyChar
28 |
29 |
30 |
--------------------------------------------------------------------------------
/src/GitHUD/Git/Parse/Count.hs:
--------------------------------------------------------------------------------
1 | module GitHUD.Git.Parse.Count (
2 | getCount
3 | ) where
4 |
5 | import Text.Parsec (parse)
6 | import Text.Parsec.String (Parser)
7 | import Text.Parsec.Char (anyChar)
8 | import Text.Parsec.Prim (many)
9 |
10 | getCount :: String -> Int
11 | getCount numberString =
12 | either
13 | (const 0)
14 | id
15 | (parse countParser "" numberString)
16 |
17 | countParser :: Parser Int
18 | countParser = do
19 | number <- many anyChar
20 | if null number
21 | then return 0
22 | else return (read number)
23 |
24 |
--------------------------------------------------------------------------------
/src/GitHUD/Git/Parse/Status.hs:
--------------------------------------------------------------------------------
1 | module GitHUD.Git.Parse.Status (
2 | gitParseStatus
3 | ) where
4 |
5 | import Text.Parsec (parse)
6 | import Text.Parsec.String (Parser)
7 | import Text.Parsec.Char (anyChar, newline, noneOf, oneOf)
8 | import Text.Parsec.Prim (many, (>), try)
9 | import Text.Parsec.Combinator (choice)
10 |
11 | import GitHUD.Git.Types
12 |
13 | data GitFileState = LocalMod
14 | | LocalAdd
15 | | LocalDel
16 | | IndexMod
17 | | IndexAdd
18 | | IndexDel
19 | | Renamed
20 | | Conflict
21 | | Skip -- ^ Used to skip an output. Necessary because we are parsing twice the output, ignoring certain lines on each pass
22 | deriving (Show)
23 |
24 | -- | In case of error, return zeroRepoState, i.e. no changes
25 | gitParseStatus :: String -> GitLocalRepoChanges
26 | gitParseStatus out =
27 | mergeGitLocalRepoChanges local index
28 | where local = (parseLocal out)
29 | index = (parseIndex out)
30 |
31 | parseLocal :: String -> GitLocalRepoChanges
32 | parseLocal str =
33 | either
34 | (const zeroLocalRepoChanges)
35 | id
36 | (parse localPorcelainStatusParser "" str)
37 |
38 | parseIndex :: String -> GitLocalRepoChanges
39 | parseIndex str =
40 | either
41 | (const zeroLocalRepoChanges)
42 | id
43 | (parse indexPorcelainStatusParser "" str)
44 |
45 | localPorcelainStatusParser :: Parser GitLocalRepoChanges
46 | localPorcelainStatusParser = gitLinesToLocalRepoState . many $ gitLocalLines
47 |
48 | indexPorcelainStatusParser :: Parser GitLocalRepoChanges
49 | indexPorcelainStatusParser = gitLinesToIndexRepoState . many $ gitIndexLines
50 |
51 | gitLinesToLocalRepoState :: Parser [GitFileState] -> Parser GitLocalRepoChanges
52 | gitLinesToLocalRepoState gitFileStateP = do
53 | gitFileState <- gitFileStateP
54 | return $ foldl linesStateFolder zeroLocalRepoChanges gitFileState
55 |
56 | gitLinesToIndexRepoState :: Parser [GitFileState] -> Parser GitLocalRepoChanges
57 | gitLinesToIndexRepoState gitFileStateP = do
58 | gitFileState <- gitFileStateP
59 | return $ foldl linesStateFolder zeroLocalRepoChanges gitFileState
60 |
61 | linesStateFolder :: GitLocalRepoChanges -> GitFileState -> GitLocalRepoChanges
62 | linesStateFolder repoS (LocalMod) = repoS { localMod = (localMod repoS) + 1 }
63 | linesStateFolder repoS (LocalAdd) = repoS { localAdd = (localAdd repoS) + 1 }
64 | linesStateFolder repoS (LocalDel) = repoS { localDel = (localDel repoS) + 1 }
65 | linesStateFolder repoS (IndexMod) = repoS { indexMod = (indexMod repoS) + 1 }
66 | linesStateFolder repoS (IndexAdd) = repoS { indexAdd = (indexAdd repoS) + 1 }
67 | linesStateFolder repoS (IndexDel) = repoS { indexDel = (indexDel repoS) + 1 }
68 | linesStateFolder repoS (Conflict) = repoS { conflict = (conflict repoS) + 1 }
69 | linesStateFolder repoS (Renamed) = repoS { renamed = (renamed repoS) + 1 }
70 | linesStateFolder repoS (Skip) = repoS
71 |
72 | gitLocalLines :: Parser GitFileState
73 | gitLocalLines = do
74 | state <- localFileState
75 | newline
76 | return state
77 |
78 | gitIndexLines :: Parser GitFileState
79 | gitIndexLines = do
80 | state <- indexFileState
81 | newline
82 | return state
83 |
84 | indexFileState :: Parser GitFileState
85 | indexFileState = do
86 | state <- choice [
87 | conflictState
88 | , renamedState
89 | , indexModState
90 | , indexAddState
91 | , indexDelState
92 | -- Fallthrough to skip the lines indicating local modifications
93 | , skipLine
94 | ] > "local file state"
95 | many $ noneOf "\n"
96 | return state
97 |
98 | localFileState :: Parser GitFileState
99 | localFileState = do
100 | state <- choice [
101 | localModState
102 | , localAddState
103 | , localDelState
104 | -- Fallthrough to skip the lines indicating index modifications
105 | , skipLine
106 | ] > "local file state"
107 | many $ noneOf "\n"
108 | return state
109 |
110 | -- | Parser of 2 characters exactly that returns a specific State
111 | twoCharParser :: [Char] -- ^ List of allowed first Char to be matched
112 | -> [Char] -- ^ List of allowed second Char to be matched
113 | -> GitFileState -- ^ the GitFileState to return as output
114 | -> Parser GitFileState
115 | twoCharParser first second state = try $ do
116 | oneOf first
117 | oneOf second
118 | return state
119 |
120 | skipLine :: Parser GitFileState
121 | skipLine = anyChar >> return Skip
122 |
123 | conflictState :: Parser GitFileState
124 | conflictState = choice [
125 | (twoCharParser "D" "DU" Conflict)
126 | , (twoCharParser "A" "AU" Conflict)
127 | , (twoCharParser "U" "AUD" Conflict)
128 | ] > "conflict parser"
129 |
130 | localModState :: Parser GitFileState
131 | localModState = twoCharParser "MARC " "M" LocalMod
132 |
133 | localAddState :: Parser GitFileState
134 | localAddState = twoCharParser "?" "?" LocalAdd
135 |
136 | localDelState :: Parser GitFileState
137 | localDelState = twoCharParser "MARC " "D" LocalDel
138 |
139 | indexModState :: Parser GitFileState
140 | indexModState = twoCharParser "M" "DM " IndexMod
141 |
142 | indexAddState :: Parser GitFileState
143 | indexAddState = twoCharParser "A" "DM " IndexAdd
144 |
145 | indexDelState :: Parser GitFileState
146 | indexDelState = twoCharParser "D" "M " IndexDel
147 |
148 | renamedState :: Parser GitFileState
149 | renamedState = twoCharParser "R" "DM " Renamed
150 |
--------------------------------------------------------------------------------
/src/GitHUD/Git/Types.hs:
--------------------------------------------------------------------------------
1 | module GitHUD.Git.Types (
2 | GitLocalRepoChanges(..)
3 | , zeroLocalRepoChanges
4 | , GitRepoState(..)
5 | , zeroGitRepoState
6 | , mergeGitLocalRepoChanges
7 | ) where
8 |
9 | data GitLocalRepoChanges = GitLocalRepoChanges { localMod :: Int
10 | , localAdd :: Int
11 | , localDel :: Int
12 | , indexMod :: Int
13 | , indexAdd :: Int
14 | , indexDel :: Int
15 | , renamed :: Int
16 | , conflict :: Int
17 | } deriving (Show, Eq)
18 |
19 | zeroLocalRepoChanges :: GitLocalRepoChanges
20 | zeroLocalRepoChanges = GitLocalRepoChanges { localMod = 0
21 | , localAdd = 0
22 | , localDel = 0
23 | , indexMod = 0
24 | , indexAdd = 0
25 | , indexDel = 0
26 | , renamed = 0
27 | , conflict = 0
28 | }
29 |
30 | mergeGitLocalRepoChanges :: GitLocalRepoChanges -> GitLocalRepoChanges -> GitLocalRepoChanges
31 | mergeGitLocalRepoChanges a b =
32 | GitLocalRepoChanges {
33 | localMod = (localMod a) + (localMod b)
34 | , localAdd = (localAdd a) + (localAdd b)
35 | , localDel = (localDel a) + (localDel b)
36 | , indexMod = (indexMod a) + (indexMod b)
37 | , indexAdd = (indexAdd a) + (indexAdd b)
38 | , indexDel = (indexDel a) + (indexDel b)
39 | , renamed = (renamed a) + (renamed b)
40 | , conflict = (conflict a) + (conflict b)
41 | }
42 |
43 | data GitRepoState =
44 | GitRepoState {
45 | gitLocalRepoChanges :: GitLocalRepoChanges
46 | , gitLocalBranch :: String
47 | , gitCommitShortSHA :: String
48 | , gitCommitTag :: String
49 | , gitRemote :: String
50 | , gitRemoteTrackingBranch :: String
51 | , gitStashCount :: Int
52 | , gitCommitsToPull :: Int
53 | , gitCommitsToPush :: Int
54 | , gitMergeBranchCommitsToPull :: Int
55 | , gitMergeBranchCommitsToPush :: Int
56 | }
57 | deriving (Eq, Show)
58 |
59 | zeroGitRepoState :: GitRepoState
60 | zeroGitRepoState =
61 | GitRepoState {
62 | gitLocalRepoChanges = zeroLocalRepoChanges
63 | , gitLocalBranch = ""
64 | , gitCommitShortSHA = ""
65 | , gitCommitTag = ""
66 | , gitRemote = ""
67 | , gitRemoteTrackingBranch = ""
68 | , gitStashCount = 0
69 | , gitCommitsToPull = 0
70 | , gitCommitsToPush = 0
71 | , gitMergeBranchCommitsToPull = 0
72 | , gitMergeBranchCommitsToPush = 0
73 | }
74 |
--------------------------------------------------------------------------------
/src/GitHUD/Process.hs:
--------------------------------------------------------------------------------
1 | module GitHUD.Process (
2 | readProcessWithIgnoreExitCode
3 | ) where
4 |
5 | import System.Process (readProcessWithExitCode)
6 | import System.Exit (ExitCode(ExitSuccess))
7 |
8 | readProcessWithIgnoreExitCode :: FilePath -> [String] -> String -> IO String
9 | readProcessWithIgnoreExitCode command options stdin = do
10 | (exCode, stdout, _) <- readProcessWithExitCode command options stdin
11 | if (exCode == ExitSuccess)
12 | then return stdout
13 | else return ""
14 |
15 |
--------------------------------------------------------------------------------
/src/GitHUD/Terminal/Base.hs:
--------------------------------------------------------------------------------
1 | module GitHUD.Terminal.Base (
2 | tellStringInColor
3 | , applyShellMarkers
4 | , terminalStartCode
5 | , endColorMarker
6 | ) where
7 |
8 | import Control.Monad.Writer (tell)
9 | import Data.Monoid (mappend)
10 |
11 | import GitHUD.Types
12 | import GitHUD.Terminal.Types
13 |
14 | tellStringInColor :: Color -- ^ The terminal color to use
15 | -> ColorIntensity -- ^ The intensity to use
16 | -> String -- ^ The string to output
17 | -> ShellOutput
18 | tellStringInColor color intensity str = do
19 | shell <- askShell
20 | tell $ startColorMarker color intensity shell
21 | tell $ str
22 | tell $ endColorMarker shell
23 |
24 | startColorMarker :: Color
25 | -> ColorIntensity
26 | -> Shell
27 | -> String
28 | startColorMarker color intensity shell
29 | | shell == TMUX = tmuxStartCode color intensity
30 | | shell == NONE = ""
31 | | otherwise = applyShellMarkers shell $ terminalStartCode color intensity
32 |
33 | endColorMarker :: Shell
34 | -> String
35 | endColorMarker shell
36 | | shell == TMUX = tmuxEndCode
37 | | shell == NONE = ""
38 | | otherwise = applyShellMarkers shell $ terminalEndCode
39 |
40 | applyShellMarkers :: Shell
41 | -> String
42 | -> String
43 | applyShellMarkers ZSH = zshMarkZeroWidth
44 | applyShellMarkers BASH = bashMarkZeroWidth
45 | applyShellMarkers _ = id
46 |
47 | zshMarkZeroWidth :: String
48 | -> String
49 | zshMarkZeroWidth str = "%{" `mappend` str `mappend` "%}"
50 |
51 | bashMarkZeroWidth :: String
52 | -> String
53 | bashMarkZeroWidth str = "\001" `mappend` str `mappend` "\002"
54 |
55 | terminalStartCode :: Color
56 | -> ColorIntensity
57 | -> String
58 | terminalStartCode Black Vivid = "\x1b[1;30m"
59 | terminalStartCode Red Vivid = "\x1b[1;31m"
60 | terminalStartCode Green Vivid = "\x1b[1;32m"
61 | terminalStartCode Yellow Vivid = "\x1b[1;33m"
62 | terminalStartCode Blue Vivid = "\x1b[1;34m"
63 | terminalStartCode Magenta Vivid = "\x1b[1;35m"
64 | terminalStartCode Cyan Vivid = "\x1b[1;36m"
65 | terminalStartCode White Vivid = "\x1b[1;37m"
66 | terminalStartCode Black Dull = "\x1b[30m"
67 | terminalStartCode Red Dull = "\x1b[31m"
68 | terminalStartCode Green Dull = "\x1b[32m"
69 | terminalStartCode Yellow Dull = "\x1b[33m"
70 | terminalStartCode Blue Dull = "\x1b[34m"
71 | terminalStartCode Magenta Dull = "\x1b[35m"
72 | terminalStartCode Cyan Dull = "\x1b[36m"
73 | terminalStartCode White Dull = "\x1b[37m"
74 | terminalStartCode NoColor _ = terminalEndCode
75 |
76 | terminalEndCode :: String
77 | terminalEndCode = "\x1b[0;39m"
78 |
79 | tmuxStartCode :: Color
80 | -> ColorIntensity
81 | -> String
82 | tmuxStartCode Black Vivid = "#[fg=brightblack]"
83 | tmuxStartCode Red Vivid = "#[fg=brightred]"
84 | tmuxStartCode Green Vivid = "#[fg=brightgreen]"
85 | tmuxStartCode Yellow Vivid = "#[fg=brightyellow]"
86 | tmuxStartCode Blue Vivid = "#[fg=brightblue]"
87 | tmuxStartCode Magenta Vivid = "#[fg=brightmagenta]"
88 | tmuxStartCode Cyan Vivid = "#[fg=brightcyan]"
89 | tmuxStartCode White Vivid = "#[fg=brightwhite]"
90 | tmuxStartCode Black Dull = "#[fg=black]"
91 | tmuxStartCode Red Dull = "#[fg=red]"
92 | tmuxStartCode Green Dull = "#[fg=green]"
93 | tmuxStartCode Yellow Dull = "#[fg=yellow]"
94 | tmuxStartCode Blue Dull = "#[fg=blue]"
95 | tmuxStartCode Magenta Dull = "#[fg=magenta]"
96 | tmuxStartCode Cyan Dull = "#[fg=cyan]"
97 | tmuxStartCode White Dull = "#[fg=white]"
98 | tmuxStartCode NoColor _ = tmuxEndCode
99 |
100 | tmuxEndCode :: String
101 | tmuxEndCode = "#[fg=default]"
102 |
--------------------------------------------------------------------------------
/src/GitHUD/Terminal/Prompt.hs:
--------------------------------------------------------------------------------
1 | module GitHUD.Terminal.Prompt (
2 | buildPromptWithConfig
3 | , resetPromptAtBeginning
4 | , addGitRepoIndicator
5 | , addNoTrackedUpstreamIndicator
6 | , addMergeBranchCommits
7 | , addLocalBranchName
8 | , addLocalCommits
9 | , addRepoState
10 | , addStashes
11 | , buildPrompt
12 | ) where
13 |
14 | import Control.Applicative ((<$>))
15 | import Control.Monad (when)
16 | import Control.Monad.Writer (runWriterT, tell)
17 |
18 | import GitHUD.Config.Types
19 | import GitHUD.Git.Types
20 | import GitHUD.Terminal.Base
21 | import GitHUD.Terminal.Types
22 | import GitHUD.Types
23 |
24 | -- | From the state of the terminal (shell type + git info), builds a prompt to
25 | -- | display by accumulating data in a Writer and returning it
26 | buildPromptWithConfig :: TerminalState
27 | buildPromptWithConfig = do
28 | (_, prompt) <- runWriterT buildPrompt
29 | return prompt
30 |
31 | buildPrompt :: ShellOutput
32 | buildPrompt = do
33 | config <- askConfig
34 | repoState <- askRepoState
35 | let branch = gitLocalBranch repoState
36 | resetPromptAtBeginning
37 | when (confShowPartRepoIndicator config) addGitRepoIndicator
38 | when (showMergeBranchIndicator branch config) addNoTrackedUpstreamIndicator
39 | when (showMergeBranchIndicator branch config) addMergeBranchCommits
40 | when (confShowPartLocalBranch config) addLocalBranchName
41 | when (confShowPartCommitsToOrigin config) addLocalCommits
42 | when (confShowPartLocalChangesState config) addRepoState
43 | when (confShowPartStashes config) addStashes
44 | return ()
45 |
46 | showMergeBranchIndicator :: String -> Config -> Bool
47 | showMergeBranchIndicator branch config =
48 | (confShowPartMergeBranchCommitsDiff config) &&
49 | (not (branch `elem` (confMergeBranchIgnoreBranches config)))
50 |
51 | resetPromptAtBeginning :: ShellOutput
52 | resetPromptAtBeginning =
53 | (endColorMarker <$> askShell) >>= tell
54 |
55 | addGitRepoIndicator :: ShellOutput
56 | addGitRepoIndicator = do
57 | config <- askConfig
58 | tell $ confRepoIndicator config
59 | tell " "
60 |
61 | addNoTrackedUpstreamIndicator :: ShellOutput
62 | addNoTrackedUpstreamIndicator = do
63 | repoState <- askRepoState
64 | config <- askConfig
65 | when (gitRemoteTrackingBranch repoState == "") $ do
66 | tellStringInColor
67 | (confNoTrackedUpstreamStringColor config)
68 | (confNoTrackedUpstreamStringIntensity config)
69 | (confNoTrackedUpstreamString config)
70 | tell " "
71 | tellStringInColor
72 | (confNoTrackedUpstreamIndicatorColor config)
73 | (confNoTrackedUpstreamIndicatorIntensity config)
74 | (confNoTrackedUpstreamIndicator config)
75 | tell " "
76 | return ()
77 |
78 | addMergeBranchCommits :: ShellOutput
79 | addMergeBranchCommits = do
80 | repoState <- askRepoState
81 | config <- askConfig
82 | let push = gitMergeBranchCommitsToPush repoState
83 | let pull = gitMergeBranchCommitsToPull repoState
84 | if (push > 0) && (pull > 0)
85 | then do
86 | tell (confMergeBranchCommitsIndicator config)
87 | tell " "
88 | tell . show $ pull
89 | tellStringInColor Green Vivid (confMergeBranchCommitsBothPullPush config)
90 | tell . show $ push
91 | else (
92 | if (pull > 0)
93 | then do
94 | tell (confMergeBranchCommitsIndicator config)
95 | tell " "
96 | tellStringInColor Green Vivid (confMergeBranchCommitsOnlyPull config)
97 | tell " "
98 | tell . show $ pull
99 | else (
100 | when (push > 0) $ do
101 | tell (confMergeBranchCommitsIndicator config)
102 | tell " "
103 | tellStringInColor Green Vivid (confMergeBranchCommitsOnlyPush config)
104 | tell " "
105 | tell . show $ push
106 | )
107 | )
108 | addSpaceIfAnyBiggerThanZero [pull, push]
109 | return ()
110 |
111 | addLocalBranchName :: ShellOutput
112 | addLocalBranchName = do
113 | repoState <- askRepoState
114 | config <- askConfig
115 | let localBranchName = gitLocalBranch repoState
116 | let commitTag = gitCommitTag repoState
117 | tell (confLocalBranchNamePrefix config)
118 |
119 | if (localBranchName /= "")
120 | then do
121 | tellStringInColor (confLocalBranchColor config) (confLocalBranchIntensity config) $
122 | localBranchName
123 | else do
124 | if (commitTag /= "")
125 | then do
126 | tellStringInColor (confLocalDetachedColor config) (confLocalDetachedIntensity config) $
127 | (confLocalDetachedPrefix config) ++ commitTag
128 | else do
129 | tellStringInColor (confLocalDetachedColor config) (confLocalDetachedIntensity config) $
130 | (confLocalDetachedPrefix config) ++ (gitCommitShortSHA repoState)
131 |
132 | tell (confLocalBranchNameSuffix config)
133 | tell " "
134 | return ()
135 |
136 | addLocalCommits :: ShellOutput
137 | addLocalCommits = do
138 | repoState <- askRepoState
139 | config <- askConfig
140 | let push = gitCommitsToPush repoState
141 | let pull = gitCommitsToPull repoState
142 | if (pull > 0) && (push > 0)
143 | then do
144 | tell . show $ pull
145 | tellStringInColor
146 | (confLocalCommitsPushPullInfixColor config)
147 | (confLocalCommitsPushPullInfixIntensity config)
148 | (confLocalCommitsPushPullInfix config)
149 | tell . show $ push
150 | tell " "
151 | else
152 | if (pull > 0)
153 | then do
154 | tell . show $ pull
155 | tellStringInColor
156 | (confLocalCommitsPullSuffixColor config)
157 | (confLocalCommitsPullSuffixIntensity config)
158 | (confLocalCommitsPullSuffix config)
159 | tell " "
160 | else
161 | when (push > 0) $ do
162 | tell . show $ push
163 | tellStringInColor
164 | (confLocalCommitsPushSuffixColor config)
165 | (confLocalCommitsPushSuffixIntensity config)
166 | (confLocalCommitsPushSuffix config)
167 | tell " "
168 |
169 | return ()
170 |
171 | addRepoState :: ShellOutput
172 | addRepoState = do
173 | repoState <- askRepoState
174 | config <- askConfig
175 | let repoChanges = gitLocalRepoChanges repoState
176 |
177 | let inda = indexAdd repoChanges
178 | let indd = indexDel repoChanges
179 | let indm = indexMod repoChanges
180 | let mv = renamed repoChanges
181 | addStateElem inda
182 | (confChangeIndexAddSuffixColor config)
183 | (confChangeIndexAddSuffixIntensity config)
184 | (confChangeIndexAddSuffix config)
185 | addStateElem indd
186 | (confChangeIndexDelSuffixColor config)
187 | (confChangeIndexDelSuffixIntensity config)
188 | (confChangeIndexDelSuffix config)
189 | addStateElem indm
190 | (confChangeIndexModSuffixColor config)
191 | (confChangeIndexModSuffixIntensity config)
192 | (confChangeIndexModSuffix config)
193 | addStateElem mv
194 | (confChangeRenamedSuffixColor config)
195 | (confChangeRenamedSuffixIntensity config)
196 | (confChangeRenamedSuffix config)
197 | addSpaceIfAnyBiggerThanZero [inda, indd, indm, mv]
198 |
199 | let ld = localDel repoChanges
200 | let lm = localMod repoChanges
201 | addStateElem ld
202 | (confChangeLocalDelSuffixColor config)
203 | (confChangeLocalDelSuffixIntensity config)
204 | (confChangeLocalDelSuffix config)
205 | addStateElem lm
206 | (confChangeLocalModSuffixColor config)
207 | (confChangeLocalModSuffixIntensity config)
208 | (confChangeLocalModSuffix config)
209 | addSpaceIfAnyBiggerThanZero [ld, lm]
210 |
211 | let la = localAdd repoChanges
212 | addStateElem la
213 | (confChangeLocalAddSuffixColor config)
214 | (confChangeLocalAddSuffixIntensity config)
215 | (confChangeLocalAddSuffix config)
216 | addSpaceIfAnyBiggerThanZero [la]
217 |
218 | let co = conflict repoChanges
219 | addStateElem co
220 | (confChangeConflictedSuffixColor config)
221 | (confChangeConflictedSuffixIntensity config)
222 | (confChangeConflictedSuffix config)
223 | addSpaceIfAnyBiggerThanZero [co]
224 | return ()
225 |
226 | addSpaceIfAnyBiggerThanZero :: [Int] -> ShellOutput
227 | addSpaceIfAnyBiggerThanZero list =
228 | when (any (>0) list) $ tell " "
229 |
230 | addStateElem :: Int
231 | -> Color
232 | -> ColorIntensity
233 | -> String
234 | -> ShellOutput
235 | addStateElem stateElem color intensity letter =
236 | when (stateElem > 0) $ addNumStateElem stateElem color intensity letter
237 |
238 | addNumStateElem :: Int
239 | -> Color
240 | -> ColorIntensity
241 | -> String
242 | -> ShellOutput
243 | addNumStateElem num color intensity letter = do
244 | tell . show $ num
245 | tellStringInColor color intensity letter
246 | return ()
247 |
248 | addStashes :: ShellOutput
249 | addStashes = do
250 | repoState <- askRepoState
251 | config <- askConfig
252 | let stashCount = gitStashCount repoState
253 | when (stashCount /= 0) $ do
254 | tell . show $ stashCount
255 | tellStringInColor
256 | (confStashSuffixColor config)
257 | (confStashSuffixIntensity config)
258 | (confStashSuffix config)
259 | tell " "
260 |
261 |
--------------------------------------------------------------------------------
/src/GitHUD/Terminal/Types.hs:
--------------------------------------------------------------------------------
1 | module GitHUD.Terminal.Types (
2 | Color(..)
3 | , ColorIntensity(..)
4 | , Shell(..)
5 | ) where
6 |
7 | data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White | NoColor deriving (Eq, Show, Read)
8 | data ColorIntensity = Dull | Vivid deriving (Eq, Show, Read)
9 | data Shell = ZSH | BASH | TMUX | NONE | Other deriving (Eq, Show)
10 |
--------------------------------------------------------------------------------
/src/GitHUD/Types.hs:
--------------------------------------------------------------------------------
1 | {-# Language FlexibleContexts #-}
2 |
3 | module GitHUD.Types (
4 | OutputConfig(..)
5 | , buildOutputConfig
6 | , Prompt
7 | , TerminalState
8 | , ShellOutput
9 | , askShell
10 | , askRepoState
11 | , askConfig
12 | ) where
13 |
14 | import Control.Monad.Reader (Reader, MonadReader, asks)
15 | import Control.Monad.Writer (WriterT)
16 |
17 | import GitHUD.Config.Types
18 | import GitHUD.Git.Types
19 | import GitHUD.Terminal.Types
20 |
21 | data OutputConfig = OutputConfig {
22 | _shell :: Shell
23 | , _repoState :: GitRepoState
24 | , _config :: Config
25 | }
26 |
27 | buildOutputConfig :: Shell
28 | -> GitRepoState
29 | -> Config
30 | -> OutputConfig
31 | buildOutputConfig shell repoState config = OutputConfig {
32 | _shell = shell
33 | , _repoState = repoState
34 | , _config = config
35 | }
36 |
37 | askShell :: MonadReader OutputConfig m => m Shell
38 | askShell = asks _shell
39 |
40 | askRepoState :: MonadReader OutputConfig m => m GitRepoState
41 | askRepoState = asks _repoState
42 |
43 | askConfig :: MonadReader OutputConfig m => m Config
44 | askConfig = asks _config
45 |
46 | type Prompt = String
47 |
48 | type TerminalState = Reader OutputConfig String
49 |
50 | type ShellOutput = WriterT Prompt (Reader OutputConfig) ()
51 |
52 |
--------------------------------------------------------------------------------
/test/Spec.hs:
--------------------------------------------------------------------------------
1 | import Test.Tasty
2 |
3 | import Test.GitHUD.Config.Parse
4 | import Test.GitHUD.Git.Parse.Status
5 | import Test.GitHUD.Git.Parse.Branch
6 | import Test.GitHUD.Git.Common
7 | import Test.GitHUD.Git.Types
8 | import Test.GitHUD.Terminal.Base
9 | import Test.GitHUD.Terminal.Prompt
10 |
11 | main :: IO ()
12 | main = defaultMain tests
13 |
14 | tests :: TestTree
15 | tests = testGroup "Tests"
16 | [ statusTests
17 | , branchTests
18 | , gitTypesTests
19 | , gitCommonTests
20 | , terminalTests
21 | , terminalPromptTests
22 | , configParserTests
23 | ]
24 | --
25 | -- tests :: TestTree
26 | -- tests = testGroup "Tests" [properties, unitTests]
27 | --
28 | -- properties :: TestTree
29 | -- properties = testGroup "Properties" [scProps, qcProps]
30 | --
31 | -- scProps = testGroup "(checked by SmallCheck)"
32 | -- [ SC.testProperty "sort == sort . reverse" $
33 | -- \list -> sort (list :: [Int]) == sort (reverse list)
34 | -- , SC.testProperty "Fermat's little theorem" $
35 | -- \x -> ((x :: Integer)^7 - x) `mod` 7 == 0
36 | -- -- the following property does not hold
37 | -- , SC.testProperty "Fermat's last theorem" $
38 | -- \x y z n ->
39 | -- (n :: Integer) >= 3 SC.==> x^n + y^n /= (z^n :: Integer)
40 | -- ]
41 | --
42 | -- qcProps = testGroup "(checked by QuickCheck)"
43 | -- [ QC.testProperty "sort == sort . reverse" $
44 | -- \list -> sort (list :: [Int]) == sort (reverse list)
45 | -- , QC.testProperty "Fermat's little theorem" $
46 | -- \x -> ((x :: Integer)^7 - x) `mod` 7 == 0
47 | -- -- the following property does not hold
48 | -- , QC.testProperty "Fermat's last theorem" $
49 | -- \x y z n ->
50 | -- (n :: Integer) >= 3 QC.==> x^n + y^n /= (z^n :: Integer)
51 | -- ]
52 | --
53 | -- unitTests = testGroup "Unit tests"
54 | -- [ testCase "List comparison (different length)" $
55 | -- [1, 2, 3] `compare` [1,2] @?= GT
56 | --
57 | -- -- the following test does not hold
58 | -- , testCase "List comparison (same length)" $
59 | -- [1, 2, 3] `compare` [1,2,2] @?= LT
60 | -- ]
61 |
--------------------------------------------------------------------------------
/test/Test/GitHUD/Config/Parse.hs:
--------------------------------------------------------------------------------
1 | module Test.GitHUD.Config.Parse (
2 | configParserTests
3 | ) where
4 |
5 | import Test.Tasty
6 | import Test.Tasty.HUnit
7 |
8 | import System.Posix.Daemon (Redirection(DevNull, ToFile))
9 | import Text.Parsec (parse)
10 | import Text.Parsec.String (Parser)
11 |
12 | import GitHUD.Config.Parse
13 | import GitHUD.Config.Types
14 | import GitHUD.Terminal.Types
15 |
16 | configParserTests :: TestTree
17 | configParserTests = testGroup "Config Parser Test"
18 | [ testItemParser
19 | , testCommentParser
20 | , testConfigItemFolder
21 | , testColorConfigToColor
22 | , testIntensityConfigToIntensity
23 | , testStringConfigToStringList
24 | , testStringConfigToRedirection
25 | , testBoolConfigToBool
26 | , testIntConfigToInt
27 | ]
28 |
29 | testItemParser :: TestTree
30 | testItemParser = testGroup "#itemParser"
31 | [ testCase "properly formed config item" $
32 | utilConfigItemParser itemParser "some_test_key=some Complex ⚡ value"
33 | @?= Item "some_test_key" "some Complex ⚡ value"
34 |
35 | , testCase "dash characters are not allowed in keys" $
36 | utilConfigItemParser itemParser "some-key=dash"
37 | @?= ErrorLine
38 |
39 | , testCase "num characters are not allowed in keys" $
40 | utilConfigItemParser itemParser "some123=dash"
41 | @?= ErrorLine
42 |
43 | , testCase "empty keys are not allowed" $
44 | utilConfigItemParser itemParser "=dash"
45 | @?= ErrorLine
46 |
47 | , testCase "Comment should not work" $
48 | utilConfigItemParser itemParser "#some comment"
49 | @?= ErrorLine
50 | ]
51 |
52 | testCommentParser :: TestTree
53 | testCommentParser = testGroup "#commentParser"
54 | [ testCase "proper comment" $
55 | utilConfigItemParser commentParser "#some comment\n"
56 | @?= Comment
57 |
58 | , testCase "not a comment if start with a space" $
59 | utilConfigItemParser commentParser " #some non comment\n"
60 | @?= ErrorLine
61 | ]
62 |
63 | testConfigItemFolder :: TestTree
64 | testConfigItemFolder = testGroup "#configItemFolder"
65 | [ testCase "Key: show_part_repo_indicator" $
66 | expectValue False $
67 | toBeInField confShowPartRepoIndicator $
68 | forConfigItemKey "show_part_repo_indicator" $
69 | withValue "False"
70 |
71 | , testCase "Key: show_part_merge_branch_commits_diff" $
72 | expectValue False $
73 | toBeInField confShowPartMergeBranchCommitsDiff $
74 | forConfigItemKey "show_part_merge_branch_commits_diff" $
75 | withValue "False"
76 |
77 | , testCase "Key: show_part_local_branch" $
78 | expectValue False $
79 | toBeInField confShowPartLocalBranch $
80 | forConfigItemKey "show_part_local_branch" $
81 | withValue "False"
82 |
83 | , testCase "Key: show_part_commits_to_origin" $
84 | expectValue False $
85 | toBeInField confShowPartCommitsToOrigin $
86 | forConfigItemKey "show_part_commits_to_origin" $
87 | withValue "False"
88 |
89 | , testCase "Key: show_part_local_changes_state" $
90 | expectValue False $
91 | toBeInField confShowPartLocalChangesState $
92 | forConfigItemKey "show_part_local_changes_state" $
93 | withValue "False"
94 |
95 | , testCase "Key: show_part_stashes" $
96 | expectValue False $
97 | toBeInField confShowPartStashes $
98 | forConfigItemKey "show_part_stashes" $
99 | withValue "False"
100 |
101 | , testCase "Comment should have no impact on the config" $
102 | configItemsFolder defaultConfig (Comment)
103 | @?= defaultConfig
104 |
105 | , testCase "ErrorLines should have no impact on the config" $
106 | configItemsFolder defaultConfig (ErrorLine)
107 | @?= defaultConfig
108 |
109 | , testCase "Key: git_repo_indicator" $
110 | expectValue "foo" $
111 | toBeInField confRepoIndicator $
112 | forConfigItemKey "git_repo_indicator" $
113 | withValue "foo"
114 |
115 | , testCase "Key: no_tracked_upstream_text" $
116 | expectValue "foo" $
117 | toBeInField confNoTrackedUpstreamString $
118 | forConfigItemKey "no_tracked_upstream_text" $
119 | withValue "foo"
120 |
121 | , testCase "Key: no_tracked_upstream_text_color" $
122 | expectValue Green $
123 | toBeInField confNoTrackedUpstreamStringColor $
124 | forConfigItemKey "no_tracked_upstream_text_color" $
125 | withValue "Green"
126 |
127 | , testCase "Key: no_tracked_upstream_text_intensity" $
128 | expectValue Dull $
129 | toBeInField confNoTrackedUpstreamStringIntensity $
130 | forConfigItemKey "no_tracked_upstream_text_intensity" $
131 | withValue "Dull"
132 |
133 | , testCase "Key: no_tracked_upstream_indicator" $
134 | expectValue "foo" $
135 | toBeInField confNoTrackedUpstreamIndicator $
136 | forConfigItemKey "no_tracked_upstream_indicator" $
137 | withValue "foo"
138 |
139 | , testCase "Key: no_tracked_upstream_indicator_color" $
140 | expectValue Black $
141 | toBeInField confNoTrackedUpstreamIndicatorColor $
142 | forConfigItemKey "no_tracked_upstream_indicator_color" $
143 | withValue "Black"
144 |
145 | , testCase "Key: no_tracked_upstream_indicator_color - invalid color" $
146 | expectValue NoColor $
147 | toBeInField confNoTrackedUpstreamIndicatorColor $
148 | forConfigItemKey "no_tracked_upstream_indicator_color" $
149 | withValue "FOO"
150 |
151 | , testCase "Key: no_tracked_upstream_indicator_intensity" $
152 | expectValue Dull $
153 | toBeInField confNoTrackedUpstreamIndicatorIntensity $
154 | forConfigItemKey "no_tracked_upstream_indicator_intensity" $
155 | withValue "Dull"
156 |
157 | , testCase "Key: no_tracked_upstream_indicator_intensity - invalid intensity" $
158 | expectValue Vivid $
159 | toBeInField confNoTrackedUpstreamIndicatorIntensity $
160 | forConfigItemKey "no_tracked_upstream_indicator_intensity" $
161 | withValue "FOO"
162 |
163 | , testCase "Key: merge_branch_commits_indicator" $
164 | expectValue "FOO" $
165 | toBeInField confMergeBranchCommitsIndicator $
166 | forConfigItemKey "merge_branch_commits_indicator" $
167 | withValue "FOO"
168 |
169 | , testCase "Key: merge_branch_commits_pull_prefix" $
170 | expectValue "FOO" $
171 | toBeInField confMergeBranchCommitsOnlyPull $
172 | forConfigItemKey "merge_branch_commits_pull_prefix" $
173 | withValue "FOO"
174 |
175 | , testCase "Key: merge_branch_commits_push_prefix" $
176 | expectValue "FOO" $
177 | toBeInField confMergeBranchCommitsOnlyPush $
178 | forConfigItemKey "merge_branch_commits_push_prefix" $
179 | withValue "FOO"
180 |
181 | , testCase "Key: merge_branch_commits_push_pull_infix" $
182 | expectValue "FOO" $
183 | toBeInField confMergeBranchCommitsBothPullPush $
184 | forConfigItemKey "merge_branch_commits_push_pull_infix" $
185 | withValue "FOO"
186 |
187 | , testCase "Key: merge_branch_ignore_branches" $
188 | expectValue ["gh-pages", "FOO"] $
189 | toBeInField confMergeBranchIgnoreBranches $
190 | forConfigItemKey "merge_branch_ignore_branches" $
191 | withValue "gh-pages, FOO"
192 |
193 | , testCase "Key: local_branch_prefix" $
194 | expectValue "FOO" $
195 | toBeInField confLocalBranchNamePrefix $
196 | forConfigItemKey "local_branch_prefix" $
197 | withValue "FOO"
198 |
199 | , testCase "Key: local_branch_suffix" $
200 | expectValue "FOO" $
201 | toBeInField confLocalBranchNameSuffix $
202 | forConfigItemKey "local_branch_suffix" $
203 | withValue "FOO"
204 |
205 | , testCase "Key: local_branch_color" $
206 | expectValue Cyan $
207 | toBeInField confLocalBranchColor $
208 | forConfigItemKey "local_branch_color" $
209 | withValue "Cyan"
210 |
211 | , testCase "Key: local_branch_intensity" $
212 | expectValue Dull $
213 | toBeInField confLocalBranchIntensity $
214 | forConfigItemKey "local_branch_intensity" $
215 | withValue "Dull"
216 |
217 | , testCase "Key: local_detached_prefix" $
218 | expectValue "FOO" $
219 | toBeInField confLocalDetachedPrefix $
220 | forConfigItemKey "local_detached_prefix" $
221 | withValue "FOO"
222 |
223 | , testCase "Key: local_detached_color" $
224 | expectValue Cyan $
225 | toBeInField confLocalDetachedColor $
226 | forConfigItemKey "local_detached_color" $
227 | withValue "Cyan"
228 |
229 | , testCase "Key: local_detached_intensity" $
230 | expectValue Dull $
231 | toBeInField confLocalDetachedIntensity $
232 | forConfigItemKey "local_detached_intensity" $
233 | withValue "Dull"
234 |
235 | , testCase "Key: local_commits_push_suffix" $
236 | expectValue "FOO" $
237 | toBeInField confLocalCommitsPushSuffix $
238 | forConfigItemKey "local_commits_push_suffix" $
239 | withValue "FOO"
240 |
241 | , testCase "Key: local_commits_push_suffix_color" $
242 | expectValue Cyan $
243 | toBeInField confLocalCommitsPushSuffixColor $
244 | forConfigItemKey "local_commits_push_suffix_color" $
245 | withValue "Cyan"
246 |
247 | , testCase "Key: local_commits_push_suffix_intensity" $
248 | expectValue Dull $
249 | toBeInField confLocalCommitsPushSuffixIntensity $
250 | forConfigItemKey "local_commits_push_suffix_intensity" $
251 | withValue "Dull"
252 |
253 | , testCase "Key: local_commits_pull_suffix" $
254 | expectValue "FOO" $
255 | toBeInField confLocalCommitsPullSuffix $
256 | forConfigItemKey "local_commits_pull_suffix" $
257 | withValue "FOO"
258 |
259 | , testCase "Key: local_commits_pull_suffix_color" $
260 | expectValue Cyan $
261 | toBeInField confLocalCommitsPullSuffixColor $
262 | forConfigItemKey "local_commits_pull_suffix_color" $
263 | withValue "Cyan"
264 |
265 | , testCase "Key: local_commits_pull_suffix_intensity" $
266 | expectValue Dull $
267 | toBeInField confLocalCommitsPullSuffixIntensity $
268 | forConfigItemKey "local_commits_pull_suffix_intensity" $
269 | withValue "Dull"
270 |
271 | , testCase "Key: local_commits_push_pull_infix" $
272 | expectValue "FOO" $
273 | toBeInField confLocalCommitsPushPullInfix $
274 | forConfigItemKey "local_commits_push_pull_infix" $
275 | withValue "FOO"
276 |
277 | , testCase "Key: local_commits_push_pull_infix_color" $
278 | expectValue Cyan $
279 | toBeInField confLocalCommitsPushPullInfixColor $
280 | forConfigItemKey "local_commits_push_pull_infix_color" $
281 | withValue "Cyan"
282 |
283 | , testCase "Key: local_commits_push_pull_infix_intensity" $
284 | expectValue Dull $
285 | toBeInField confLocalCommitsPushPullInfixIntensity $
286 | forConfigItemKey "local_commits_push_pull_infix_intensity" $
287 | withValue "Dull"
288 |
289 | , testCase "Key: change_index_add_suffix" $
290 | expectValue "FOO" $
291 | toBeInField confChangeIndexAddSuffix $
292 | forConfigItemKey "change_index_add_suffix" $
293 | withValue "FOO"
294 |
295 | , testCase "Key: change_index_add_suffix_color" $
296 | expectValue Cyan $
297 | toBeInField confChangeIndexAddSuffixColor $
298 | forConfigItemKey "change_index_add_suffix_color" $
299 | withValue "Cyan"
300 |
301 | , testCase "Key: change_index_add_suffix_intensity" $
302 | expectValue Dull $
303 | toBeInField confChangeIndexAddSuffixIntensity $
304 | forConfigItemKey "change_index_add_suffix_intensity" $
305 | withValue "Dull"
306 |
307 | , testCase "Key: change_index_mod_suffix" $
308 | expectValue "FOO" $
309 | toBeInField confChangeIndexModSuffix $
310 | forConfigItemKey "change_index_mod_suffix" $
311 | withValue "FOO"
312 |
313 | , testCase "Key: change_index_mod_suffix_color" $
314 | expectValue Cyan $
315 | toBeInField confChangeIndexModSuffixColor $
316 | forConfigItemKey "change_index_mod_suffix_color" $
317 | withValue "Cyan"
318 |
319 | , testCase "Key: change_index_mod_suffix_intensity" $
320 | expectValue Dull $
321 | toBeInField confChangeIndexModSuffixIntensity $
322 | forConfigItemKey "change_index_mod_suffix_intensity" $
323 | withValue "Dull"
324 |
325 | , testCase "Key: change_index_del_suffix" $
326 | expectValue "FOO" $
327 | toBeInField confChangeIndexDelSuffix $
328 | forConfigItemKey "change_index_del_suffix" $
329 | withValue "FOO"
330 |
331 | , testCase "Key: change_index_del_suffix_color" $
332 | expectValue Cyan $
333 | toBeInField confChangeIndexDelSuffixColor $
334 | forConfigItemKey "change_index_del_suffix_color" $
335 | withValue "Cyan"
336 |
337 | , testCase "Key: change_index_del_suffix_intensity" $
338 | expectValue Dull $
339 | toBeInField confChangeIndexDelSuffixIntensity $
340 | forConfigItemKey "change_index_del_suffix_intensity" $
341 | withValue "Dull"
342 |
343 | , testCase "Key: change_local_add_suffix" $
344 | expectValue "FOO" $
345 | toBeInField confChangeLocalAddSuffix $
346 | forConfigItemKey "change_local_add_suffix" $
347 | withValue "FOO"
348 |
349 | , testCase "Key: change_local_add_suffix_color" $
350 | expectValue Cyan $
351 | toBeInField confChangeLocalAddSuffixColor $
352 | forConfigItemKey "change_local_add_suffix_color" $
353 | withValue "Cyan"
354 |
355 | , testCase "Key: change_local_add_suffix_intensity" $
356 | expectValue Dull $
357 | toBeInField confChangeLocalAddSuffixIntensity $
358 | forConfigItemKey "change_local_add_suffix_intensity" $
359 | withValue "Dull"
360 |
361 | , testCase "Key: change_local_mod_suffix" $
362 | expectValue "FOO" $
363 | toBeInField confChangeLocalModSuffix $
364 | forConfigItemKey "change_local_mod_suffix" $
365 | withValue "FOO"
366 |
367 | , testCase "Key: change_local_mod_suffix_color" $
368 | expectValue Cyan $
369 | toBeInField confChangeLocalModSuffixColor $
370 | forConfigItemKey "change_local_mod_suffix_color" $
371 | withValue "Cyan"
372 |
373 | , testCase "Key: change_local_mod_suffix_intensity" $
374 | expectValue Dull $
375 | toBeInField confChangeLocalModSuffixIntensity $
376 | forConfigItemKey "change_local_mod_suffix_intensity" $
377 | withValue "Dull"
378 |
379 | , testCase "Key: change_local_del_suffix" $
380 | expectValue "FOO" $
381 | toBeInField confChangeLocalDelSuffix $
382 | forConfigItemKey "change_local_del_suffix" $
383 | withValue "FOO"
384 |
385 | , testCase "Key: change_local_del_suffix_color" $
386 | expectValue Cyan $
387 | toBeInField confChangeLocalDelSuffixColor $
388 | forConfigItemKey "change_local_del_suffix_color" $
389 | withValue "Cyan"
390 |
391 | , testCase "Key: change_local_del_suffix_intensity" $
392 | expectValue Dull $
393 | toBeInField confChangeLocalDelSuffixIntensity $
394 | forConfigItemKey "change_local_del_suffix_intensity" $
395 | withValue "Dull"
396 |
397 | , testCase "Key: change_renamed_suffix" $
398 | expectValue "FOO" $
399 | toBeInField confChangeRenamedSuffix $
400 | forConfigItemKey "change_renamed_suffix" $
401 | withValue "FOO"
402 |
403 | , testCase "Key: change_renamed_suffix_color" $
404 | expectValue Cyan $
405 | toBeInField confChangeRenamedSuffixColor $
406 | forConfigItemKey "change_renamed_suffix_color" $
407 | withValue "Cyan"
408 |
409 | , testCase "Key: change_renamed_suffix_intensity" $
410 | expectValue Dull $
411 | toBeInField confChangeRenamedSuffixIntensity $
412 | forConfigItemKey "change_renamed_suffix_intensity" $
413 | withValue "Dull"
414 |
415 | , testCase "Key: change_conflicted_suffix" $
416 | expectValue "FOO" $
417 | toBeInField confChangeConflictedSuffix $
418 | forConfigItemKey "change_conflicted_suffix" $
419 | withValue "FOO"
420 |
421 | , testCase "Key: change_conflicted_suffix_color" $
422 | expectValue Cyan $
423 | toBeInField confChangeConflictedSuffixColor $
424 | forConfigItemKey "change_conflicted_suffix_color" $
425 | withValue "Cyan"
426 |
427 | , testCase "Key: change_conflicted_suffix_intensity" $
428 | expectValue Dull $
429 | toBeInField confChangeConflictedSuffixIntensity $
430 | forConfigItemKey "change_conflicted_suffix_intensity" $
431 | withValue "Dull"
432 |
433 | , testCase "Key: stash_suffix" $
434 | expectValue "FOO" $
435 | toBeInField confStashSuffix $
436 | forConfigItemKey "stash_suffix" $
437 | withValue "FOO"
438 |
439 | , testCase "Key: stash_suffix_color" $
440 | expectValue Cyan $
441 | toBeInField confStashSuffixColor $
442 | forConfigItemKey "stash_suffix_color" $
443 | withValue "Cyan"
444 |
445 | , testCase "Key: stash_suffix_intensity" $
446 | expectValue Dull $
447 | toBeInField confStashSuffixIntensity $
448 | forConfigItemKey "stash_suffix_intensity" $
449 | withValue "Dull"
450 |
451 | , testCase "Key: run_fetcher_daemon" $
452 | expectValue True $
453 | toBeInField confRunFetcherDaemon $
454 | forConfigItemKey "run_fetcher_daemon" $
455 | withValue "True"
456 |
457 | , testCase "Key: githudd_sleep_seconds" $
458 | expectValue 5 $
459 | toBeInField confGithuddSleepSeconds $
460 | forConfigItemKey "githudd_sleep_seconds" $
461 | withValue "5"
462 |
463 | , testCase "Key: githudd_pid_file_path" $
464 | expectValue "/tmp" $
465 | toBeInField confGithuddPidFilePath $
466 | forConfigItemKey "githudd_pid_file_path" $
467 | withValue "/tmp"
468 |
469 | , testCase "Key: githudd_lock_file_path" $
470 | expectValue "/tmp" $
471 | toBeInField confGithuddLockFilePath $
472 | forConfigItemKey "githudd_lock_file_path" $
473 | withValue "/tmp"
474 |
475 | , testCase "Key: githudd_socket_file_path" $
476 | expectValue "/tmp" $
477 | toBeInField confGithuddSocketFilePath $
478 | forConfigItemKey "githudd_socket_file_path" $
479 | withValue "/tmp"
480 |
481 | , testCase "Key: githudd_log_file_path" $
482 | expectValue DevNull $
483 | toBeInField confGithuddLogFilePath $
484 | forConfigItemKey "githudd_log_file_path" $
485 | withValue "/dev/null"
486 | ]
487 |
488 | expectValue :: (Eq a, Show a) => a -> a -> Assertion
489 | expectValue expected actual = actual @?= expected
490 |
491 | toBeInField :: (Config -> a) -> Config -> a
492 | toBeInField = id
493 |
494 | forConfigItemKey :: String -> String -> Config
495 | forConfigItemKey key value =
496 | configItemsFolder defaultConfig (Item key value)
497 |
498 | withValue :: String -> String
499 | withValue = id
500 |
501 | utilConfigItemParser :: Parser ConfigItem -> String -> ConfigItem
502 | utilConfigItemParser parser str =
503 | either
504 | (const ErrorLine)
505 | id
506 | (parse parser "" str)
507 |
508 | testIntensityConfigToIntensity :: TestTree
509 | testIntensityConfigToIntensity = testGroup "#intensityConfigToIntensity"
510 | [ testCase "valid intensity - return it" $
511 | intensityConfigToIntensity "Dull" @?= Dull
512 |
513 | , testCase "invalid intensity - default to Vivid" $
514 | intensityConfigToIntensity "Foo" @?= Vivid
515 | ]
516 |
517 | testColorConfigToColor :: TestTree
518 | testColorConfigToColor = testGroup "#colorConfigToColor"
519 | [ testCase "valid color - return it" $
520 | colorConfigToColor "Cyan" @?= Cyan
521 |
522 | , testCase "invalid color - default to Blue" $
523 | colorConfigToColor "Foo" @?= NoColor
524 | ]
525 |
526 | testStringConfigToStringList :: TestTree
527 | testStringConfigToStringList = testGroup "#stringConfigToStringList"
528 | [ testCase "valid string list, comma separated, no spaces" $
529 | stringConfigToStringList "foo,bar" @?= ["foo", "bar"]
530 |
531 | , testCase "valid string list, comma separated, spaces" $
532 | stringConfigToStringList "foo, bar , baz " @?= ["foo", "bar", "baz"]
533 |
534 | , testCase "valid string list, comma separated, finish with comma" $
535 | stringConfigToStringList "foo,bar, " @?= ["foo", "bar"]
536 | ]
537 |
538 | testStringConfigToRedirection :: TestTree
539 | testStringConfigToRedirection = testGroup "#strConfigToRedirection"
540 | [ testCase "dev null" $
541 | strConfigToRedirection "/dev/null" @?= DevNull
542 |
543 | , testCase "other path" $
544 | strConfigToRedirection "/foo/bar" @?= ToFile "/foo/bar"
545 | ]
546 |
547 | testBoolConfigToBool :: TestTree
548 | testBoolConfigToBool = testGroup "#boolConfigToBool"
549 | [ testCase "True" $
550 | boolConfigToBool "True" @?= True
551 |
552 | , testCase "true" $
553 | boolConfigToBool "true" @?= True
554 |
555 | , testCase "yes" $
556 | boolConfigToBool "yes" @?= True
557 |
558 | , testCase "False" $
559 | boolConfigToBool "False" @?= False
560 |
561 | , testCase "Defaults to False on failed parsing" $
562 | boolConfigToBool "foo" @?= False
563 | ]
564 |
565 | testIntConfigToInt :: TestTree
566 | testIntConfigToInt = testGroup "#intConfigToInt"
567 | [ testCase "standard valid int" $
568 | intConfigToInt "12" @?= 12
569 |
570 | , testCase "Cuts to the integer part found" $
571 | intConfigToInt "12.5" @?= 12
572 |
573 | , testCase "any bad value defaults to 30" $
574 | intConfigToInt "foo" @?= 30
575 | ]
576 |
--------------------------------------------------------------------------------
/test/Test/GitHUD/Git/Common.hs:
--------------------------------------------------------------------------------
1 | module Test.GitHUD.Git.Common (
2 | gitCommonTests
3 | ) where
4 |
5 | import Test.Tasty
6 | import Test.Tasty.HUnit
7 |
8 | import GitHUD.Git.Common
9 |
10 | gitCommonTests :: TestTree
11 | gitCommonTests = testGroup "Git Common Test"
12 | [ testCase "Getting the config key for the remote of a given local branch" $
13 | gitRemoteTrackingConfigKey "master" @?= "branch.master.remote"
14 |
15 | , testCase "Getting the config key for the remote tracking branch of a local branch" $
16 | gitRemoteBranchConfigKey "master" @?= "branch.master.merge"
17 |
18 | , testCase "Getting a commit span between 2 commits" $
19 | mergeBaseDiffFromTo "b2d35" "ef25d" @?= "b2d35...ef25d"
20 | ]
21 |
--------------------------------------------------------------------------------
/test/Test/GitHUD/Git/Parse/Branch.hs:
--------------------------------------------------------------------------------
1 | module Test.GitHUD.Git.Parse.Branch (
2 | branchTests
3 | ) where
4 |
5 | import Test.Tasty
6 | import Test.Tasty.HUnit
7 |
8 | import GitHUD.Git.Parse.Branch
9 |
10 | branchTests :: TestTree
11 | branchTests = testGroup "Branch Parser Test"
12 | [ testCase "remote branch name" $
13 | buildFullyQualifiedRemoteBranchName "bar" "refs/heads/foo"
14 | @?= "bar/foo"
15 | ]
16 |
--------------------------------------------------------------------------------
/test/Test/GitHUD/Git/Parse/Status.hs:
--------------------------------------------------------------------------------
1 | module Test.GitHUD.Git.Parse.Status (
2 | statusTests
3 | ) where
4 |
5 | import Test.Tasty
6 | import Test.Tasty.HUnit
7 |
8 | import GitHUD.Git.Parse.Status
9 | import GitHUD.Git.Types
10 |
11 | statusTests :: TestTree
12 | statusTests = testGroup "Status Parser Test"
13 | [ testCase "with an empty input, should return 0 for all categories" $
14 | gitParseStatus "" @?= zeroLocalRepoChanges
15 |
16 | , testCase "with one locally modified file" $
17 | gitParseStatus " M some random foo bar stuff\n" @?= (zeroLocalRepoChanges { localMod = 1 })
18 |
19 | , testCase "with one locally deleted file" $
20 | gitParseStatus " D some random foo bar stuff\n" @?= (zeroLocalRepoChanges { localDel = 1 })
21 |
22 | , testCase "with one locally added file" $
23 | gitParseStatus "?? some random foo bar stuff\n" @?= (zeroLocalRepoChanges { localAdd = 1 })
24 |
25 | , testCase "with one added file to the index" $
26 | gitParseStatus "A some random foo bar stuff\n" @?= (zeroLocalRepoChanges { indexAdd = 1 })
27 |
28 | , testCase "with one modified file to the index" $
29 | gitParseStatus "M some random foo bar stuff\n" @?= (zeroLocalRepoChanges { indexMod = 1 })
30 |
31 | , testCase "with one added file to the index" $
32 | gitParseStatus "D some random foo bar stuff\n" @?= (zeroLocalRepoChanges { indexDel = 1 })
33 |
34 | , testCase "with a conflict with both sides changed" $
35 | gitParseStatus "UU test\n" @?= (zeroLocalRepoChanges { conflict = 1 })
36 |
37 | , testCase "with a conflict with us side changed" $
38 | gitParseStatus "DU test\n" @?= (zeroLocalRepoChanges { conflict = 1 })
39 |
40 | , testCase "with a conflict with them side changed" $
41 | gitParseStatus "UD test\n" @?= (zeroLocalRepoChanges { conflict = 1 })
42 |
43 | , testCase "with a complex mix" $
44 | gitParseStatus
45 | complexStatusString
46 | @?= (zeroLocalRepoChanges { localAdd = 1, localDel = 1, localMod = 1,
47 | indexAdd = 1, indexMod = 1, indexDel = 1, conflict = 3 })
48 |
49 | , testCase "with a renamed file in the index" $
50 | gitParseStatus "R test\n" @?= (zeroLocalRepoChanges { renamed = 1 })
51 |
52 | , testCase "with a file renamed in the index and modified locally" $
53 | gitParseStatus "RM test\n" @?= (zeroLocalRepoChanges { localMod = 1, renamed = 1 })
54 |
55 | , testCase "with a file renamed in the index and deleted locally" $
56 | gitParseStatus "RD test\n" @?= (zeroLocalRepoChanges { localDel = 1, renamed = 1 })
57 |
58 | , testCase "with a file modified in the index and deleted locally" $
59 | gitParseStatus "MD test\n" @?= (zeroLocalRepoChanges { localDel = 1, indexMod = 1 })
60 |
61 | , testCase "with a file changed in the index AND locally" $
62 | gitParseStatus "MM test\n" @?= (zeroLocalRepoChanges { localMod = 1, indexMod = 1 })
63 |
64 | , testCase "with a file added in the index AND modified locally" $
65 | gitParseStatus "AM test\n" @?= (zeroLocalRepoChanges { localMod = 1, indexAdd = 1 })
66 |
67 | , testCase "with a file added in the index AND deleted locally" $
68 | gitParseStatus "AD test\n" @?= (zeroLocalRepoChanges { localDel = 1, indexAdd = 1 })
69 |
70 | ]
71 |
72 | complexStatusString :: String
73 | complexStatusString =
74 | " M foo\n\
75 | \ D bar\n\
76 | \?? add\n\
77 | \A add\n\
78 | \M mod\n\
79 | \D del\n\
80 | \UU conflict\n\
81 | \DU conflict\n\
82 | \UD conflict\n"
83 |
--------------------------------------------------------------------------------
/test/Test/GitHUD/Git/Types.hs:
--------------------------------------------------------------------------------
1 | module Test.GitHUD.Git.Types (
2 | gitTypesTests
3 | ) where
4 |
5 | import Test.Tasty
6 | import Test.Tasty.HUnit
7 |
8 | import GitHUD.Git.Types
9 |
10 | gitTypesTests :: TestTree
11 | gitTypesTests = testGroup "Git Types Test"
12 | [ testCase "Merging 2 repoChanges object should lead to the sum of its parts" $
13 | testMergeGitLocalRepoChanges
14 | ]
15 |
16 | testMergeGitLocalRepoChanges :: Assertion
17 | testMergeGitLocalRepoChanges =
18 | mergeGitLocalRepoChanges glrc1 glrc2 @?= glrcMerged
19 |
20 | glrc1 :: GitLocalRepoChanges
21 | glrc1 = GitLocalRepoChanges {
22 | localMod = 3
23 | , localAdd = 2
24 | , localDel = 4
25 | , indexMod = 6
26 | , indexAdd = 10
27 | , indexDel = 7
28 | , renamed = 12
29 | , conflict = 50
30 | }
31 |
32 | glrc2 :: GitLocalRepoChanges
33 | glrc2 = GitLocalRepoChanges {
34 | localMod = 6
35 | , localAdd = 20
36 | , localDel = 48
37 | , indexMod = 3
38 | , indexAdd = 56
39 | , indexDel = 10
40 | , renamed = 44
41 | , conflict = 2
42 | }
43 |
44 | glrcMerged :: GitLocalRepoChanges
45 | glrcMerged = GitLocalRepoChanges {
46 | localMod = 9
47 | , localAdd = 22
48 | , localDel = 52
49 | , indexMod = 9
50 | , indexAdd = 66
51 | , indexDel = 17
52 | , renamed = 56
53 | , conflict = 52
54 | }
55 |
--------------------------------------------------------------------------------
/test/Test/GitHUD/Terminal/Base.hs:
--------------------------------------------------------------------------------
1 | module Test.GitHUD.Terminal.Base (
2 | terminalTests
3 | ) where
4 |
5 | import Test.Tasty
6 | import Test.Tasty.HUnit
7 |
8 | import GitHUD.Terminal.Base
9 | import GitHUD.Terminal.Types
10 |
11 | terminalTests :: TestTree
12 | terminalTests = testGroup "Terminal Base Tests"
13 | [ testCase "#applyShellMarkers should not do anything for non ZSH shell" $
14 | applyShellMarkers Other "foo" @?= "foo"
15 |
16 | , testCase "#applyShellMarkers should add 0-width markers for ZSH shell" $
17 | applyShellMarkers ZSH "foo" @?= "%{foo%}"
18 |
19 | ]
20 |
--------------------------------------------------------------------------------
/test/Test/GitHUD/Terminal/Prompt.hs:
--------------------------------------------------------------------------------
1 | module Test.GitHUD.Terminal.Prompt (
2 | terminalPromptTests
3 | ) where
4 |
5 | import Test.Tasty
6 | import Test.Tasty.HUnit
7 |
8 | import Control.Monad.Reader (runReader)
9 | import Control.Monad.Writer (runWriterT)
10 |
11 | import GitHUD.Config.Types
12 | import GitHUD.Git.Types
13 | import GitHUD.Terminal.Prompt
14 | import GitHUD.Terminal.Types
15 | import GitHUD.Types
16 |
17 | allPrompts :: [Shell]
18 | allPrompts = [ZSH, BASH, TMUX, NONE, Other]
19 |
20 | terminalPromptTests :: TestTree
21 | terminalPromptTests = testGroup "Terminal Prompt Test"
22 | [ testResetPromptAtBeginning
23 | , testAddGitRepoIndicator
24 | , testAddNoTrackedUpstreamIndicator
25 | , testAddMergeBranchCommits
26 | , testAddLocalBranchName
27 | , testAddLocalCommits
28 | , testAddRepoState
29 | , testAddStashes
30 | , testPartialPrompt
31 | ]
32 |
33 | testResetPromptAtBeginning :: TestTree
34 | testResetPromptAtBeginning = testGroup "#resetPromptAtBeginning"
35 | [ testCase "ZSH: Should start the prompt with a reset color control sequence" $
36 | testWriterWithConfig (zeroOutputConfig ZSH) resetPromptAtBeginning @?= "%{\x1b[0;39m%}"
37 | , testCase "Other: Should start the prompt with a reset color control sequence" $
38 | testWriterWithConfig (zeroOutputConfig Other) resetPromptAtBeginning @?= "\x1b[0;39m"
39 | , testCase "TMUX: Should start the prompt with a reset color control sequence" $
40 | testWriterWithConfig (zeroOutputConfig TMUX) resetPromptAtBeginning @?= "#[fg=default]"
41 | , testCase "NONE: Should start the prompt with a reset color control sequence" $
42 | testWriterWithConfig (zeroOutputConfig NONE) resetPromptAtBeginning @?= ""
43 | ]
44 |
45 | _testAddGitDefaultRepoIndicator :: Shell -> TestTree
46 | _testAddGitDefaultRepoIndicator shell =
47 | testCase ((show shell) ++ ": default config: hardcoded character") $
48 | testWriterWithConfig (zeroOutputConfig shell) addGitRepoIndicator @?= "ᚴ "
49 |
50 | _testAddGitCustomRepoIndicator :: Shell -> TestTree
51 | _testAddGitCustomRepoIndicator shell =
52 | testCase ((show shell) ++ ": custom config: hardcoded character") $
53 | testWriterWithConfig
54 | (buildOutputConfig shell zeroGitRepoState $ defaultConfig { confRepoIndicator = "indic" })
55 | addGitRepoIndicator
56 | @?= "indic "
57 |
58 | testAddGitRepoIndicator :: TestTree
59 | testAddGitRepoIndicator = testGroup "#addGitRepoIndicator"
60 | [ testGroup "Default Config" $ fmap _testAddGitDefaultRepoIndicator allPrompts
61 | , testGroup "Custom Config" $ fmap _testAddGitCustomRepoIndicator allPrompts
62 | ]
63 |
64 | customConfigNoTrackedUpstreamIndicator :: Config
65 | customConfigNoTrackedUpstreamIndicator = defaultConfig {
66 | confNoTrackedUpstreamString = "foo"
67 | , confNoTrackedUpstreamStringColor = Cyan
68 | , confNoTrackedUpstreamStringIntensity = Dull
69 | , confNoTrackedUpstreamIndicator = "bar"
70 | , confNoTrackedUpstreamIndicatorColor = Green
71 | , confNoTrackedUpstreamIndicatorIntensity = Dull
72 | }
73 |
74 | _testUpstreamIndicatorWithUpstreamDefaultConfig :: Shell -> TestTree
75 | _testUpstreamIndicatorWithUpstreamDefaultConfig shell =
76 | testCase ((show shell) ++ ": with an upstream") $
77 | testWriterWithConfig
78 | (buildOutputConfig shell (zeroGitRepoState { gitRemoteTrackingBranch = "foo" }) defaultConfig)
79 | addNoTrackedUpstreamIndicator
80 | @?= ""
81 |
82 | _testUpstreamIndicatorWithUpstreamCustomConfig :: Shell -> TestTree
83 | _testUpstreamIndicatorWithUpstreamCustomConfig shell =
84 | testCase ((show shell) ++ ": with an upstream") $
85 | testWriterWithConfig
86 | (buildOutputConfig shell (zeroGitRepoState { gitRemoteTrackingBranch = "foo" }) customConfigNoTrackedUpstreamIndicator)
87 | addNoTrackedUpstreamIndicator
88 | @?= ""
89 |
90 | testAddNoTrackedUpstreamIndicator :: TestTree
91 | testAddNoTrackedUpstreamIndicator = testGroup "#addTrackedUpstreamIndicator"
92 | [ testGroup "Default Config - upstream" $ fmap _testUpstreamIndicatorWithUpstreamDefaultConfig allPrompts
93 | , testGroup "Custom Config - upstream" $ fmap _testUpstreamIndicatorWithUpstreamCustomConfig allPrompts
94 | , testGroup "Default Config - no upstream"
95 | [ testCase "ZSH: with no upstream" $
96 | testWriterWithConfig
97 | (zeroOutputConfig ZSH) addNoTrackedUpstreamIndicator
98 | @?= "%{\x1b[1;31m%}upstream%{\x1b[0;39m%} %{\x1b[1;31m%}\9889%{\x1b[0;39m%} "
99 |
100 | , testCase "Other: with no upstream" $
101 | testWriterWithConfig
102 | (zeroOutputConfig Other) addNoTrackedUpstreamIndicator
103 | @?= "\x1b[1;31mupstream\x1b[0;39m \x1b[1;31m\9889\x1b[0;39m "
104 |
105 | , testCase "TMUX: with no upstream" $
106 | testWriterWithConfig
107 | (zeroOutputConfig TMUX) addNoTrackedUpstreamIndicator
108 | @?= "#[fg=brightred]upstream#[fg=default] #[fg=brightred]\9889#[fg=default] "
109 |
110 | , testCase "NONE: with no upstream" $
111 | testWriterWithConfig
112 | (zeroOutputConfig NONE) addNoTrackedUpstreamIndicator
113 | @?= "upstream \9889 "
114 | ]
115 | , testGroup "Custom Config - no upstream"
116 | [ testCase "ZSH: with no upstream" $
117 | testWriterWithConfig
118 | (buildOutputConfig ZSH (zeroGitRepoState) customConfigNoTrackedUpstreamIndicator)
119 | addNoTrackedUpstreamIndicator
120 | @?= "%{\x1b[36m%}foo%{\x1b[0;39m%} %{\x1b[32m%}bar%{\x1b[0;39m%} "
121 |
122 | , testCase "Other: with no upstream" $
123 | testWriterWithConfig
124 | (buildOutputConfig Other (zeroGitRepoState) customConfigNoTrackedUpstreamIndicator)
125 | addNoTrackedUpstreamIndicator
126 | @?= "\x1b[36mfoo\x1b[0;39m \x1b[32mbar\x1b[0;39m "
127 |
128 | , testCase "TMUX: with no upstream" $
129 | testWriterWithConfig
130 | (buildOutputConfig TMUX (zeroGitRepoState) customConfigNoTrackedUpstreamIndicator)
131 | addNoTrackedUpstreamIndicator
132 | @?= "#[fg=cyan]foo#[fg=default] #[fg=green]bar#[fg=default] "
133 |
134 | , testCase "NONE: with no upstream" $
135 | testWriterWithConfig
136 | (buildOutputConfig NONE (zeroGitRepoState) customConfigNoTrackedUpstreamIndicator)
137 | addNoTrackedUpstreamIndicator
138 | @?= "foo bar "
139 | ]
140 | ]
141 |
142 | customConfigMergeBranchCommits :: Config
143 | customConfigMergeBranchCommits = defaultConfig {
144 | confMergeBranchCommitsIndicator = "foo"
145 | , confMergeBranchCommitsOnlyPull = "pull"
146 | , confMergeBranchCommitsOnlyPush = "push"
147 | , confMergeBranchCommitsBothPullPush = "pull-push"
148 | }
149 |
150 | testAddMergeBranchCommits :: TestTree
151 | testAddMergeBranchCommits = testGroup "#addMergeBranchCommits"
152 | [ testGroup "Default Config"
153 | [ testCase "ZSH: commits to pull" $
154 | testMergeBranchCommitsToPull ZSH defaultConfig @?=
155 | "\120366 %{\x1b[1;32m%}\8594%{\x1b[0;39m%} 2 "
156 |
157 | , testCase "ZSH: commits to push" $
158 | testMergeBranchCommitsToPush ZSH defaultConfig @?=
159 | "\120366 %{\x1b[1;32m%}\8592%{\x1b[0;39m%} 2 "
160 |
161 | , testCase "ZSH: commits to pull and to push" $
162 | testMergeBranchCommitsToPushAndPull ZSH defaultConfig @?=
163 | "\120366 4%{\x1b[1;32m%}\8644%{\x1b[0;39m%}4 "
164 |
165 | , testCase "Other: commits to pull" $
166 | testMergeBranchCommitsToPull Other defaultConfig @?=
167 | "\120366 \x1b[1;32m\8594\x1b[0;39m 2 "
168 |
169 | , testCase "Other: commits to push" $
170 | testMergeBranchCommitsToPush Other defaultConfig @?=
171 | "\120366 \x1b[1;32m\8592\x1b[0;39m 2 "
172 |
173 | , testCase "Other: commits to pull and to push" $
174 | testMergeBranchCommitsToPushAndPull Other defaultConfig @?=
175 | "\120366 4\x1b[1;32m\8644\x1b[0;39m4 "
176 |
177 | , testCase "TMUX: commits to pull" $
178 | testMergeBranchCommitsToPull TMUX defaultConfig @?=
179 | "\120366 #[fg=brightgreen]\8594#[fg=default] 2 "
180 |
181 | , testCase "TMUX: commits to push" $
182 | testMergeBranchCommitsToPush TMUX defaultConfig @?=
183 | "\120366 #[fg=brightgreen]\8592#[fg=default] 2 "
184 |
185 | , testCase "TMUX: commits to pull and to push" $
186 | testMergeBranchCommitsToPushAndPull TMUX defaultConfig @?=
187 | "\120366 4#[fg=brightgreen]\8644#[fg=default]4 "
188 |
189 | , testCase "NONE: commits to pull" $
190 | testMergeBranchCommitsToPull NONE defaultConfig @?=
191 | "\120366 \8594 2 "
192 |
193 | , testCase "NONE: commits to push" $
194 | testMergeBranchCommitsToPush NONE defaultConfig @?=
195 | "\120366 \8592 2 "
196 |
197 | , testCase "NONE: commits to pull and to push" $
198 | testMergeBranchCommitsToPushAndPull NONE defaultConfig @?=
199 | "\120366 4\8644\&4 "
200 | ]
201 |
202 | , testGroup "Custom Config"
203 | [ testCase "ZSH: commits to pull" $
204 | testMergeBranchCommitsToPull ZSH customConfigMergeBranchCommits @?=
205 | "foo %{\x1b[1;32m%}pull%{\x1b[0;39m%} 2 "
206 |
207 | , testCase "ZSH: commits to push" $
208 | testMergeBranchCommitsToPush ZSH customConfigMergeBranchCommits @?=
209 | "foo %{\x1b[1;32m%}push%{\x1b[0;39m%} 2 "
210 |
211 | , testCase "ZSH: commits to pull and to push" $
212 | testMergeBranchCommitsToPushAndPull ZSH customConfigMergeBranchCommits @?=
213 | "foo 4%{\x1b[1;32m%}pull-push%{\x1b[0;39m%}4 "
214 |
215 | , testCase "Other: commits to pull" $
216 | testMergeBranchCommitsToPull Other customConfigMergeBranchCommits @?=
217 | "foo \x1b[1;32mpull\x1b[0;39m 2 "
218 |
219 | , testCase "Other: commits to push" $
220 | testMergeBranchCommitsToPush Other customConfigMergeBranchCommits @?=
221 | "foo \x1b[1;32mpush\x1b[0;39m 2 "
222 |
223 | , testCase "Other: commits to pull and to push" $
224 | testMergeBranchCommitsToPushAndPull Other customConfigMergeBranchCommits @?=
225 | "foo 4\x1b[1;32mpull-push\x1b[0;39m4 "
226 |
227 | , testCase "TMUX: commits to pull" $
228 | testMergeBranchCommitsToPull TMUX customConfigMergeBranchCommits @?=
229 | "foo #[fg=brightgreen]pull#[fg=default] 2 "
230 |
231 | , testCase "TMUX: commits to push" $
232 | testMergeBranchCommitsToPush TMUX customConfigMergeBranchCommits @?=
233 | "foo #[fg=brightgreen]push#[fg=default] 2 "
234 |
235 | , testCase "TMUX: commits to pull and to push" $
236 | testMergeBranchCommitsToPushAndPull TMUX customConfigMergeBranchCommits @?=
237 | "foo 4#[fg=brightgreen]pull-push#[fg=default]4 "
238 |
239 | , testCase "NONE: commits to pull" $
240 | testMergeBranchCommitsToPull NONE customConfigMergeBranchCommits @?=
241 | "foo pull 2 "
242 |
243 | , testCase "NONE: commits to push" $
244 | testMergeBranchCommitsToPush NONE customConfigMergeBranchCommits @?=
245 | "foo push 2 "
246 |
247 | , testCase "NONE: commits to pull and to push" $
248 | testMergeBranchCommitsToPushAndPull NONE customConfigMergeBranchCommits @?=
249 | "foo 4pull-push4 "
250 | ]
251 | ]
252 |
253 | customConfigLocalBranchName :: Config
254 | customConfigLocalBranchName = defaultConfig {
255 | confLocalBranchColor = Cyan
256 | , confLocalDetachedColor = Magenta
257 | , confLocalBranchIntensity = Dull
258 | , confLocalDetachedIntensity = Dull
259 | , confLocalBranchNamePrefix = "{"
260 | , confLocalBranchNameSuffix = "}"
261 | , confLocalDetachedPrefix = "det#!"
262 | }
263 |
264 | testAddLocalBranchName :: TestTree
265 | testAddLocalBranchName = testGroup "#addLocalBranchName"
266 | [ testGroup "Default Config"
267 | [ testCase "ZSH: should display the name of the current branch if we are at the HEAD of any" $
268 | testWriterWithConfig
269 | (buildOutputConfig ZSH (zeroGitRepoState { gitLocalBranch = "foo" }) defaultConfig)
270 | addLocalBranchName
271 | @?= "[%{\x1b[0;39m%}foo%{\x1b[0;39m%}] "
272 |
273 | , testCase "ZSH: should display the current commit tag if we are not on one" $
274 | testWriterWithConfig
275 | (buildOutputConfig ZSH (zeroGitRepoState { gitCommitTag = "v1.1.1" }) defaultConfig)
276 | addLocalBranchName
277 | @?= "[%{\x1b[1;33m%}detached@v1.1.1%{\x1b[0;39m%}] "
278 |
279 | , testCase "ZSH: should display the current commit SHA if we are not on a branch's HEAD" $
280 | testWriterWithConfig
281 | (buildOutputConfig ZSH (zeroGitRepoState { gitCommitShortSHA = "3d25ef" }) defaultConfig)
282 | addLocalBranchName
283 | @?= "[%{\x1b[1;33m%}detached@3d25ef%{\x1b[0;39m%}] "
284 |
285 | , testCase "ZSH: should prefer the current tag over the commit SHA if we are not on a branch's HEAD" $
286 | testWriterWithConfig
287 | (buildOutputConfig ZSH (zeroGitRepoState { gitCommitShortSHA = "3d25ef", gitCommitTag = "v1.2.3" }) defaultConfig)
288 | addLocalBranchName
289 | @?= "[%{\x1b[1;33m%}detached@v1.2.3%{\x1b[0;39m%}] "
290 |
291 | , testCase "Other: should display the name of the current branch if we are at the HEAD of any" $
292 | testWriterWithConfig
293 | (buildOutputConfig Other (zeroGitRepoState { gitLocalBranch = "foo" }) defaultConfig)
294 | addLocalBranchName
295 | @?= "[\x1b[0;39mfoo\x1b[0;39m] "
296 |
297 | , testCase "Other: should display the current commit tog if we are on one" $
298 | testWriterWithConfig
299 | (buildOutputConfig Other (zeroGitRepoState { gitCommitTag = "v1.1.1" }) defaultConfig)
300 | addLocalBranchName
301 | @?= "[\x1b[1;33mdetached@v1.1.1\x1b[0;39m] "
302 |
303 | , testCase "Other: should display the current commit SHA if we are not on a branch's HEAD" $
304 | testWriterWithConfig
305 | (buildOutputConfig Other (zeroGitRepoState { gitCommitShortSHA = "3d25ef" }) defaultConfig)
306 | addLocalBranchName
307 | @?= "[\x1b[1;33mdetached@3d25ef\x1b[0;39m] "
308 |
309 | , testCase "Other: should prefer the current tag over the commit SHA if we are not on a branch's HEAD" $
310 | testWriterWithConfig
311 | (buildOutputConfig Other (zeroGitRepoState { gitCommitShortSHA = "3d25ef", gitCommitTag = "v1.2.3" }) defaultConfig)
312 | addLocalBranchName
313 | @?= "[\x1b[1;33mdetached@v1.2.3\x1b[0;39m] "
314 |
315 | , testCase "TMUX: should display the name of the current branch if we are at the HEAD of any" $
316 | testWriterWithConfig
317 | (buildOutputConfig TMUX (zeroGitRepoState { gitLocalBranch = "foo" }) defaultConfig)
318 | addLocalBranchName
319 | @?= "[#[fg=default]foo#[fg=default]] "
320 |
321 | , testCase "TMUX: should display the current commit tog if we are on one" $
322 | testWriterWithConfig
323 | (buildOutputConfig TMUX (zeroGitRepoState { gitCommitTag = "v1.1.1" }) defaultConfig)
324 | addLocalBranchName
325 | @?= "[#[fg=brightyellow]detached@v1.1.1#[fg=default]] "
326 |
327 | , testCase "TMUX: should display the current commit SHA if we are not on a branch's HEAD" $
328 | testWriterWithConfig
329 | (buildOutputConfig TMUX (zeroGitRepoState { gitCommitShortSHA = "3d25ef" }) defaultConfig)
330 | addLocalBranchName
331 | @?= "[#[fg=brightyellow]detached@3d25ef#[fg=default]] "
332 |
333 | , testCase "TMUX: should prefer the current tag over the commit SHA if we are not on a branch's HEAD" $
334 | testWriterWithConfig
335 | (buildOutputConfig TMUX (zeroGitRepoState { gitCommitShortSHA = "3d25ef", gitCommitTag = "v1.2.3" }) defaultConfig)
336 | addLocalBranchName
337 | @?= "[#[fg=brightyellow]detached@v1.2.3#[fg=default]] "
338 |
339 | , testCase "NONE: should display the name of the current branch if we are at the HEAD of any" $
340 | testWriterWithConfig
341 | (buildOutputConfig NONE (zeroGitRepoState { gitLocalBranch = "foo" }) defaultConfig)
342 | addLocalBranchName
343 | @?= "[foo] "
344 |
345 | , testCase "NONE: should display the current commit tog if we are on one" $
346 | testWriterWithConfig
347 | (buildOutputConfig NONE (zeroGitRepoState { gitCommitTag = "v1.1.1" }) defaultConfig)
348 | addLocalBranchName
349 | @?= "[detached@v1.1.1] "
350 |
351 | , testCase "NONE: should display the current commit SHA if we are not on a branch's HEAD" $
352 | testWriterWithConfig
353 | (buildOutputConfig NONE (zeroGitRepoState { gitCommitShortSHA = "3d25ef" }) defaultConfig)
354 | addLocalBranchName
355 | @?= "[detached@3d25ef] "
356 |
357 | , testCase "NONE: should prefer the current tag over the commit SHA if we are not on a branch's HEAD" $
358 | testWriterWithConfig
359 | (buildOutputConfig NONE (zeroGitRepoState { gitCommitShortSHA = "3d25ef", gitCommitTag = "v1.2.3" }) defaultConfig)
360 | addLocalBranchName
361 | @?= "[detached@v1.2.3] "
362 | ]
363 | , testGroup "Custom Config"
364 | [ testCase "ZSH: should display the name of the current branch if we are at the HEAD of any" $
365 | testWriterWithConfig
366 | (buildOutputConfig ZSH (zeroGitRepoState { gitLocalBranch = "foo" }) customConfigLocalBranchName)
367 | addLocalBranchName
368 | @?= "{%{\x1b[36m%}foo%{\x1b[0;39m%}} "
369 |
370 | , testCase "ZSH: should display the current commit tag if we are not on one" $
371 | testWriterWithConfig
372 | (buildOutputConfig ZSH (zeroGitRepoState { gitCommitTag = "v1.1.1" }) customConfigLocalBranchName)
373 | addLocalBranchName
374 | @?= "{%{\x1b[35m%}det#!v1.1.1%{\x1b[0;39m%}} "
375 |
376 | , testCase "ZSH: should display the current commit SHA if we are not on a branch's HEAD" $
377 | testWriterWithConfig
378 | (buildOutputConfig ZSH (zeroGitRepoState { gitCommitShortSHA = "3d25ef" }) customConfigLocalBranchName)
379 | addLocalBranchName
380 | @?= "{%{\x1b[35m%}det#!3d25ef%{\x1b[0;39m%}} "
381 |
382 | , testCase "Other: should display the name of the current branch if we are at the HEAD of any" $
383 | testWriterWithConfig
384 | (buildOutputConfig Other (zeroGitRepoState { gitLocalBranch = "foo" }) customConfigLocalBranchName)
385 | addLocalBranchName
386 | @?= "{\x1b[36mfoo\x1b[0;39m} "
387 |
388 | , testCase "Other: should display the current commit tog if we are on one" $
389 | testWriterWithConfig
390 | (buildOutputConfig Other (zeroGitRepoState { gitCommitTag = "v1.1.1" }) customConfigLocalBranchName)
391 | addLocalBranchName
392 | @?= "{\x1b[35mdet#!v1.1.1\x1b[0;39m} "
393 |
394 | , testCase "Other: should display the current commit SHA if we are not on a branch's HEAD" $
395 | testWriterWithConfig
396 | (buildOutputConfig Other (zeroGitRepoState { gitCommitShortSHA = "3d25ef" }) customConfigLocalBranchName)
397 | addLocalBranchName
398 | @?= "{\x1b[35mdet#!3d25ef\x1b[0;39m} "
399 |
400 | , testCase "TMUX: should display the name of the current branch if we are at the HEAD of any" $
401 | testWriterWithConfig
402 | (buildOutputConfig TMUX (zeroGitRepoState { gitLocalBranch = "foo" }) customConfigLocalBranchName)
403 | addLocalBranchName
404 | @?= "{#[fg=cyan]foo#[fg=default]} "
405 |
406 | , testCase "TMUX: should display the current commit tog if we are on one" $
407 | testWriterWithConfig
408 | (buildOutputConfig TMUX (zeroGitRepoState { gitCommitTag = "v1.1.1" }) customConfigLocalBranchName)
409 | addLocalBranchName
410 | @?= "{#[fg=magenta]det#!v1.1.1#[fg=default]} "
411 |
412 | , testCase "TMUX: should display the current commit SHA if we are not on a branch's HEAD" $
413 | testWriterWithConfig
414 | (buildOutputConfig TMUX (zeroGitRepoState { gitCommitShortSHA = "3d25ef" }) customConfigLocalBranchName)
415 | addLocalBranchName
416 | @?= "{#[fg=magenta]det#!3d25ef#[fg=default]} "
417 |
418 | , testCase "NONE: should display the name of the current branch if we are at the HEAD of any" $
419 | testWriterWithConfig
420 | (buildOutputConfig NONE (zeroGitRepoState { gitLocalBranch = "foo" }) customConfigLocalBranchName)
421 | addLocalBranchName
422 | @?= "{foo} "
423 |
424 | , testCase "NONE: should display the current commit tog if we are on one" $
425 | testWriterWithConfig
426 | (buildOutputConfig NONE (zeroGitRepoState { gitCommitTag = "v1.1.1" }) customConfigLocalBranchName)
427 | addLocalBranchName
428 | @?= "{det#!v1.1.1} "
429 |
430 | , testCase "NONE: should display the current commit SHA if we are not on a branch's HEAD" $
431 | testWriterWithConfig
432 | (buildOutputConfig NONE (zeroGitRepoState { gitCommitShortSHA = "3d25ef" }) customConfigLocalBranchName)
433 | addLocalBranchName
434 | @?= "{det#!3d25ef} "
435 | ]
436 | ]
437 |
438 | customConfigLocalCommits :: Config
439 | customConfigLocalCommits = defaultConfig {
440 | confLocalCommitsPushSuffix = "push"
441 | , confLocalCommitsPushSuffixColor = Cyan
442 | , confLocalCommitsPushSuffixIntensity = Dull
443 | , confLocalCommitsPullSuffix = "pull"
444 | , confLocalCommitsPullSuffixColor = Magenta
445 | , confLocalCommitsPullSuffixIntensity = Dull
446 | , confLocalCommitsPushPullInfix = "push-pull"
447 | , confLocalCommitsPushPullInfixColor = White
448 | , confLocalCommitsPushPullInfixIntensity = Dull
449 | }
450 |
451 | testAddLocalCommits :: TestTree
452 | testAddLocalCommits = testGroup "#addLocalCommits"
453 | [ testGroup "Default Config"
454 | [ testCase "ZSH: commits to pull" $
455 | testCommitsToPull ZSH defaultConfig @?=
456 | "2%{\x1b[1;31m%}\8595%{\x1b[0;39m%} "
457 |
458 | , testCase "ZSH: commits to push" $
459 | testCommitsToPush ZSH defaultConfig @?=
460 | "2%{\x1b[1;32m%}\8593%{\x1b[0;39m%} "
461 |
462 | , testCase "ZSH: commits to pull and to push" $
463 | testCommitsToPushAndPull ZSH defaultConfig @?=
464 | "4%{\x1b[1;32m%}⥯%{\x1b[0;39m%}4 "
465 |
466 | , testCase "Other: commits to pull" $
467 | testCommitsToPull Other defaultConfig @?=
468 | "2\x1b[1;31m\8595\x1b[0;39m "
469 |
470 | , testCase "Other: commits to push" $
471 | testCommitsToPush Other defaultConfig @?=
472 | "2\x1b[1;32m\8593\x1b[0;39m "
473 |
474 | , testCase "Other: commits to pull and to push" $
475 | testCommitsToPushAndPull Other defaultConfig @?=
476 | "4\x1b[1;32m⥯\x1b[0;39m4 "
477 |
478 | , testCase "TMUX: commits to pull" $
479 | testCommitsToPull TMUX defaultConfig @?=
480 | "2#[fg=brightred]\8595#[fg=default] "
481 |
482 | , testCase "TMUX: commits to push" $
483 | testCommitsToPush TMUX defaultConfig @?=
484 | "2#[fg=brightgreen]\8593#[fg=default] "
485 |
486 | , testCase "TMUX: commits to pull and to push" $
487 | testCommitsToPushAndPull TMUX defaultConfig @?=
488 | "4#[fg=brightgreen]⥯#[fg=default]4 "
489 |
490 | , testCase "NONE: commits to pull" $
491 | testCommitsToPull NONE defaultConfig @?=
492 | "2\8595 "
493 |
494 | , testCase "NONE: commits to push" $
495 | testCommitsToPush NONE defaultConfig @?=
496 | "2\8593 "
497 |
498 | , testCase "NONE: commits to pull and to push" $
499 | testCommitsToPushAndPull NONE defaultConfig @?=
500 | "4⥯4 "
501 | ]
502 | , testGroup "Custom Config"
503 | [ testCase "ZSH: commits to pull" $
504 | testCommitsToPull ZSH customConfigLocalCommits @?=
505 | "2%{\x1b[35m%}pull%{\x1b[0;39m%} "
506 |
507 | , testCase "ZSH: commits to push" $
508 | testCommitsToPush ZSH customConfigLocalCommits @?=
509 | "2%{\x1b[36m%}push%{\x1b[0;39m%} "
510 |
511 | , testCase "ZSH: commits to pull and to push" $
512 | testCommitsToPushAndPull ZSH customConfigLocalCommits @?=
513 | "4%{\x1b[37m%}push-pull%{\x1b[0;39m%}4 "
514 |
515 | , testCase "Other: commits to pull" $
516 | testCommitsToPull Other customConfigLocalCommits @?=
517 | "2\x1b[35mpull\x1b[0;39m "
518 |
519 | , testCase "Other: commits to push" $
520 | testCommitsToPush Other customConfigLocalCommits @?=
521 | "2\x1b[36mpush\x1b[0;39m "
522 |
523 | , testCase "Other: commits to pull and to push" $
524 | testCommitsToPushAndPull Other customConfigLocalCommits @?=
525 | "4\x1b[37mpush-pull\x1b[0;39m4 "
526 |
527 | , testCase "TMUX: commits to pull" $
528 | testCommitsToPull TMUX customConfigLocalCommits @?=
529 | "2#[fg=magenta]pull#[fg=default] "
530 |
531 | , testCase "TMUX: commits to push" $
532 | testCommitsToPush TMUX customConfigLocalCommits @?=
533 | "2#[fg=cyan]push#[fg=default] "
534 |
535 | , testCase "TMUX: commits to pull and to push" $
536 | testCommitsToPushAndPull TMUX customConfigLocalCommits @?=
537 | "4#[fg=white]push-pull#[fg=default]4 "
538 |
539 | , testCase "NONE: commits to pull" $
540 | testCommitsToPull NONE customConfigLocalCommits @?=
541 | "2pull "
542 |
543 | , testCase "NONE: commits to push" $
544 | testCommitsToPush NONE customConfigLocalCommits @?=
545 | "2push "
546 |
547 | , testCase "NONE: commits to pull and to push" $
548 | testCommitsToPushAndPull NONE customConfigLocalCommits @?=
549 | "4push-pull4 "
550 | ]
551 | ]
552 |
553 | customChangeConfig :: Config
554 | customChangeConfig = defaultConfig {
555 | confChangeIndexAddSuffix = "B"
556 | , confChangeIndexAddSuffixColor = Cyan
557 | , confChangeIndexAddSuffixIntensity = Dull
558 | , confChangeIndexModSuffix = "N"
559 | , confChangeIndexModSuffixColor = Cyan
560 | , confChangeIndexModSuffixIntensity = Dull
561 | , confChangeIndexDelSuffix = "E"
562 | , confChangeIndexDelSuffixColor = Cyan
563 | , confChangeIndexDelSuffixIntensity = Dull
564 | , confChangeLocalAddSuffix = "B"
565 | , confChangeLocalAddSuffixColor = Magenta
566 | , confChangeLocalAddSuffixIntensity = Dull
567 | , confChangeLocalModSuffix = "N"
568 | , confChangeLocalModSuffixColor = Blue
569 | , confChangeLocalModSuffixIntensity = Dull
570 | , confChangeLocalDelSuffix = "E"
571 | , confChangeLocalDelSuffixColor = Blue
572 | , confChangeLocalDelSuffixIntensity = Dull
573 | , confChangeRenamedSuffix = "S"
574 | , confChangeRenamedSuffixColor = Cyan
575 | , confChangeRenamedSuffixIntensity = Dull
576 | , confChangeConflictedSuffix = "D"
577 | , confChangeConflictedSuffixColor = Cyan
578 | , confChangeConflictedSuffixIntensity = Dull
579 | }
580 |
581 | testAddRepoState :: TestTree
582 | testAddRepoState = testGroup "#addRepoState"
583 | [ testGroup "Default Config"
584 | [ testCase "ZSH: with Local Add Changes" $
585 | testLocalAddChange ZSH defaultConfig @?= "2%{\x1b[1;37m%}A%{\x1b[0;39m%} "
586 |
587 | , testCase "ZSH: with Local Mod Changes" $
588 | testLocalModChange ZSH defaultConfig @?= "2%{\x1b[1;31m%}M%{\x1b[0;39m%} "
589 |
590 | , testCase "ZSH: with Local Del Changes" $
591 | testLocalDelChange ZSH defaultConfig @?= "2%{\x1b[1;31m%}D%{\x1b[0;39m%} "
592 |
593 | , testCase "ZSH: with Index Add Changes" $
594 | testIndexAddChange ZSH defaultConfig @?= "2%{\x1b[1;32m%}A%{\x1b[0;39m%} "
595 |
596 | , testCase "ZSH: with Index Mod Changes" $
597 | testIndexModChange ZSH defaultConfig @?= "2%{\x1b[1;32m%}M%{\x1b[0;39m%} "
598 |
599 | , testCase "ZSH: with Index Del Changes" $
600 | testIndexDelChange ZSH defaultConfig @?= "2%{\x1b[1;32m%}D%{\x1b[0;39m%} "
601 |
602 | , testCase "ZSH: with Conflicted Changes" $
603 | testConflictedChange ZSH defaultConfig @?= "2%{\x1b[1;32m%}C%{\x1b[0;39m%} "
604 |
605 | , testCase "ZSH: with Renamed Changes" $
606 | testRenamedChange ZSH defaultConfig @?= "2%{\x1b[1;32m%}R%{\x1b[0;39m%} "
607 |
608 | , testCase "ZSH: with every kind of Changes" $
609 | testEveryRepoChange ZSH defaultConfig @?= "6%{\x1b[1;32m%}A%{\x1b[0;39m%}8%{\x1b[1;32m%}D%{\x1b[0;39m%}7%{\x1b[1;32m%}M%{\x1b[0;39m%}1%{\x1b[1;32m%}R%{\x1b[0;39m%} 5%{\x1b[1;31m%}D%{\x1b[0;39m%}4%{\x1b[1;31m%}M%{\x1b[0;39m%} 3%{\x1b[1;37m%}A%{\x1b[0;39m%} 2%{\x1b[1;32m%}C%{\x1b[0;39m%} "
610 |
611 | , testCase "Other: with Local Add Changes" $
612 | testLocalAddChange Other defaultConfig @?= "2\x1b[1;37mA\x1b[0;39m "
613 |
614 | , testCase "Other: with Local Mod Changes" $
615 | testLocalModChange Other defaultConfig @?= "2\x1b[1;31mM\x1b[0;39m "
616 |
617 | , testCase "Other: with Local Del Changes" $
618 | testLocalDelChange Other defaultConfig @?= "2\x1b[1;31mD\x1b[0;39m "
619 |
620 | , testCase "Other: with Index Add Changes" $
621 | testIndexAddChange Other defaultConfig @?= "2\x1b[1;32mA\x1b[0;39m "
622 |
623 | , testCase "Other: with Index Mod Changes" $
624 | testIndexModChange Other defaultConfig @?= "2\x1b[1;32mM\x1b[0;39m "
625 |
626 | , testCase "Other: with Index Del Changes" $
627 | testIndexDelChange Other defaultConfig @?= "2\x1b[1;32mD\x1b[0;39m "
628 |
629 | , testCase "Other: with Conflicted Changes" $
630 | testConflictedChange Other defaultConfig @?= "2\x1b[1;32mC\x1b[0;39m "
631 |
632 | , testCase "Other: with Renamed Changes" $
633 | testRenamedChange Other defaultConfig @?= "2\x1b[1;32mR\x1b[0;39m "
634 |
635 | , testCase "Other: with every kind of Changes" $
636 | testEveryRepoChange Other defaultConfig @?= "6\x1b[1;32mA\x1b[0;39m8\x1b[1;32mD\x1b[0;39m7\x1b[1;32mM\x1b[0;39m1\x1b[1;32mR\x1b[0;39m 5\x1b[1;31mD\x1b[0;39m4\x1b[1;31mM\x1b[0;39m 3\x1b[1;37mA\x1b[0;39m 2\x1b[1;32mC\x1b[0;39m "
637 |
638 | , testCase "TMUX: with Local Add Changes" $
639 | testLocalAddChange TMUX defaultConfig @?= "2#[fg=brightwhite]A#[fg=default] "
640 |
641 | , testCase "TMUX: with Local Mod Changes" $
642 | testLocalModChange TMUX defaultConfig @?= "2#[fg=brightred]M#[fg=default] "
643 |
644 | , testCase "TMUX: with Local Del Changes" $
645 | testLocalDelChange TMUX defaultConfig @?= "2#[fg=brightred]D#[fg=default] "
646 |
647 | , testCase "TMUX: with Index Add Changes" $
648 | testIndexAddChange TMUX defaultConfig @?= "2#[fg=brightgreen]A#[fg=default] "
649 |
650 | , testCase "TMUX: with Index Mod Changes" $
651 | testIndexModChange TMUX defaultConfig @?= "2#[fg=brightgreen]M#[fg=default] "
652 |
653 | , testCase "TMUX: with Index Del Changes" $
654 | testIndexDelChange TMUX defaultConfig @?= "2#[fg=brightgreen]D#[fg=default] "
655 |
656 | , testCase "TMUX: with Conflicted Changes" $
657 | testConflictedChange TMUX defaultConfig @?= "2#[fg=brightgreen]C#[fg=default] "
658 |
659 | , testCase "TMUX: with Renamed Changes" $
660 | testRenamedChange TMUX defaultConfig @?= "2#[fg=brightgreen]R#[fg=default] "
661 |
662 | , testCase "TMUX: with every kind of Changes" $
663 | testEveryRepoChange TMUX defaultConfig @?= "6#[fg=brightgreen]A#[fg=default]8#[fg=brightgreen]D#[fg=default]7#[fg=brightgreen]M#[fg=default]1#[fg=brightgreen]R#[fg=default] 5#[fg=brightred]D#[fg=default]4#[fg=brightred]M#[fg=default] 3#[fg=brightwhite]A#[fg=default] 2#[fg=brightgreen]C#[fg=default] "
664 |
665 | , testCase "NONE: with Local Add Changes" $
666 | testLocalAddChange NONE defaultConfig @?= "2A "
667 |
668 | , testCase "NONE: with Local Mod Changes" $
669 | testLocalModChange NONE defaultConfig @?= "2M "
670 |
671 | , testCase "NONE: with Local Del Changes" $
672 | testLocalDelChange NONE defaultConfig @?= "2D "
673 |
674 | , testCase "NONE: with Index Add Changes" $
675 | testIndexAddChange NONE defaultConfig @?= "2A "
676 |
677 | , testCase "NONE: with Index Mod Changes" $
678 | testIndexModChange NONE defaultConfig @?= "2M "
679 |
680 | , testCase "NONE: with Index Del Changes" $
681 | testIndexDelChange NONE defaultConfig @?= "2D "
682 |
683 | , testCase "NONE: with Conflicted Changes" $
684 | testConflictedChange NONE defaultConfig @?= "2C "
685 |
686 | , testCase "NONE: with Renamed Changes" $
687 | testRenamedChange NONE defaultConfig @?= "2R "
688 |
689 | , testCase "NONE: with every kind of Changes" $
690 | testEveryRepoChange NONE defaultConfig @?= "6A8D7M1R 5D4M 3A 2C "
691 | ]
692 | , testGroup "Custom Config"
693 | [ testCase "ZSH: with Local Add Changes" $
694 | testLocalAddChange ZSH customChangeConfig @?= "2%{\x1b[35m%}B%{\x1b[0;39m%} "
695 |
696 | , testCase "ZSH: with Local Mod Changes" $
697 | testLocalModChange ZSH customChangeConfig @?= "2%{\x1b[34m%}N%{\x1b[0;39m%} "
698 |
699 | , testCase "ZSH: with Local Del Changes" $
700 | testLocalDelChange ZSH customChangeConfig @?= "2%{\x1b[34m%}E%{\x1b[0;39m%} "
701 |
702 | , testCase "ZSH: with Index Add Changes" $
703 | testIndexAddChange ZSH customChangeConfig @?= "2%{\x1b[36m%}B%{\x1b[0;39m%} "
704 |
705 | , testCase "ZSH: with Index Mod Changes" $
706 | testIndexModChange ZSH customChangeConfig @?= "2%{\x1b[36m%}N%{\x1b[0;39m%} "
707 |
708 | , testCase "ZSH: with Index Del Changes" $
709 | testIndexDelChange ZSH customChangeConfig @?= "2%{\x1b[36m%}E%{\x1b[0;39m%} "
710 |
711 | , testCase "ZSH: with Conflicted Changes" $
712 | testConflictedChange ZSH customChangeConfig @?= "2%{\x1b[36m%}D%{\x1b[0;39m%} "
713 |
714 | , testCase "ZSH: with Renamed Changes" $
715 | testRenamedChange ZSH customChangeConfig @?= "2%{\x1b[36m%}S%{\x1b[0;39m%} "
716 |
717 | , testCase "ZSH: with every kind of Changes" $
718 | testEveryRepoChange ZSH customChangeConfig @?= "6%{\x1b[36m%}B%{\x1b[0;39m%}8%{\x1b[36m%}E%{\x1b[0;39m%}7%{\x1b[36m%}N%{\x1b[0;39m%}1%{\x1b[36m%}S%{\x1b[0;39m%} 5%{\x1b[34m%}E%{\x1b[0;39m%}4%{\x1b[34m%}N%{\x1b[0;39m%} 3%{\x1b[35m%}B%{\x1b[0;39m%} 2%{\x1b[36m%}D%{\x1b[0;39m%} "
719 |
720 | , testCase "Other: with Local Add Changes" $
721 | testLocalAddChange Other customChangeConfig @?= "2\x1b[35mB\x1b[0;39m "
722 |
723 | , testCase "Other: with Local Mod Changes" $
724 | testLocalModChange Other customChangeConfig @?= "2\x1b[34mN\x1b[0;39m "
725 |
726 | , testCase "Other: with Local Del Changes" $
727 | testLocalDelChange Other customChangeConfig @?= "2\x1b[34mE\x1b[0;39m "
728 |
729 | , testCase "Other: with Index Add Changes" $
730 | testIndexAddChange Other customChangeConfig @?= "2\x1b[36mB\x1b[0;39m "
731 |
732 | , testCase "Other: with Index Mod Changes" $
733 | testIndexModChange Other customChangeConfig @?= "2\x1b[36mN\x1b[0;39m "
734 |
735 | , testCase "Other: with Index Del Changes" $
736 | testIndexDelChange Other customChangeConfig @?= "2\x1b[36mE\x1b[0;39m "
737 |
738 | , testCase "Other: with Conflicted Changes" $
739 | testConflictedChange Other customChangeConfig @?= "2\x1b[36mD\x1b[0;39m "
740 |
741 | , testCase "Other: with Renamed Changes" $
742 | testRenamedChange Other customChangeConfig @?= "2\x1b[36mS\x1b[0;39m "
743 |
744 | , testCase "Other: with every kind of Changes" $
745 | testEveryRepoChange Other customChangeConfig @?= "6\x1b[36mB\x1b[0;39m8\x1b[36mE\x1b[0;39m7\x1b[36mN\x1b[0;39m1\x1b[36mS\x1b[0;39m 5\x1b[34mE\x1b[0;39m4\x1b[34mN\x1b[0;39m 3\x1b[35mB\x1b[0;39m 2\x1b[36mD\x1b[0;39m "
746 |
747 | , testCase "TMUX: with Local Add Changes" $
748 | testLocalAddChange TMUX customChangeConfig @?= "2#[fg=magenta]B#[fg=default] "
749 |
750 | , testCase "TMUX: with Local Mod Changes" $
751 | testLocalModChange TMUX customChangeConfig @?= "2#[fg=blue]N#[fg=default] "
752 |
753 | , testCase "TMUX: with Local Del Changes" $
754 | testLocalDelChange TMUX customChangeConfig @?= "2#[fg=blue]E#[fg=default] "
755 |
756 | , testCase "TMUX: with Index Add Changes" $
757 | testIndexAddChange TMUX customChangeConfig @?= "2#[fg=cyan]B#[fg=default] "
758 |
759 | , testCase "TMUX: with Index Mod Changes" $
760 | testIndexModChange TMUX customChangeConfig @?= "2#[fg=cyan]N#[fg=default] "
761 |
762 | , testCase "TMUX: with Index Del Changes" $
763 | testIndexDelChange TMUX customChangeConfig @?= "2#[fg=cyan]E#[fg=default] "
764 |
765 | , testCase "TMUX: with Conflicted Changes" $
766 | testConflictedChange TMUX customChangeConfig @?= "2#[fg=cyan]D#[fg=default] "
767 |
768 | , testCase "TMUX: with Renamed Changes" $
769 | testRenamedChange TMUX customChangeConfig @?= "2#[fg=cyan]S#[fg=default] "
770 |
771 | , testCase "TMUX: with every kind of Changes" $
772 | testEveryRepoChange TMUX customChangeConfig @?= "6#[fg=cyan]B#[fg=default]8#[fg=cyan]E#[fg=default]7#[fg=cyan]N#[fg=default]1#[fg=cyan]S#[fg=default] 5#[fg=blue]E#[fg=default]4#[fg=blue]N#[fg=default] 3#[fg=magenta]B#[fg=default] 2#[fg=cyan]D#[fg=default] "
773 |
774 | , testCase "NONE: with Local Add Changes" $
775 | testLocalAddChange NONE customChangeConfig @?= "2B "
776 |
777 | , testCase "NONE: with Local Mod Changes" $
778 | testLocalModChange NONE customChangeConfig @?= "2N "
779 |
780 | , testCase "NONE: with Local Del Changes" $
781 | testLocalDelChange NONE customChangeConfig @?= "2E "
782 |
783 | , testCase "NONE: with Index Add Changes" $
784 | testIndexAddChange NONE customChangeConfig @?= "2B "
785 |
786 | , testCase "NONE: with Index Mod Changes" $
787 | testIndexModChange NONE customChangeConfig @?= "2N "
788 |
789 | , testCase "NONE: with Index Del Changes" $
790 | testIndexDelChange NONE customChangeConfig @?= "2E "
791 |
792 | , testCase "NONE: with Conflicted Changes" $
793 | testConflictedChange NONE customChangeConfig @?= "2D "
794 |
795 | , testCase "NONE: with Renamed Changes" $
796 | testRenamedChange NONE customChangeConfig @?= "2S "
797 |
798 | , testCase "NONE: with every kind of Changes" $
799 | testEveryRepoChange NONE customChangeConfig @?= "6B8E7N1S 5E4N 3B 2D "
800 | ]
801 | ]
802 |
803 | customStashConfig :: Config
804 | customStashConfig = defaultConfig {
805 | confStashSuffix = "stash"
806 | , confStashSuffixColor = Cyan
807 | , confStashSuffixIntensity = Dull
808 | }
809 |
810 | testAddStashes :: TestTree
811 | testAddStashes = testGroup "#addStashes"
812 | [ testGroup "Default Config"
813 | [ testCase "ZSH: hardcoded character" $
814 | testWriterWithConfig
815 | (buildOutputConfig ZSH (zeroGitRepoState { gitStashCount = 2 }) defaultConfig) addStashes
816 | @?= "2%{\x1b[1;32m%}\8801%{\x1b[0;39m%} "
817 |
818 | , testCase "Other: hardcoded character" $
819 | testWriterWithConfig
820 | (buildOutputConfig Other (zeroGitRepoState { gitStashCount = 2 }) defaultConfig) addStashes
821 | @?= "2\x1b[1;32m\8801\x1b[0;39m "
822 |
823 | , testCase "TMUX: hardcoded character" $
824 | testWriterWithConfig
825 | (buildOutputConfig TMUX (zeroGitRepoState { gitStashCount = 2 }) defaultConfig) addStashes
826 | @?= "2#[fg=brightgreen]\8801#[fg=default] "
827 |
828 | , testCase "NONE: hardcoded character" $
829 | testWriterWithConfig
830 | (buildOutputConfig NONE (zeroGitRepoState { gitStashCount = 2 }) defaultConfig) addStashes
831 | @?= "2\8801 "
832 | ]
833 | , testGroup "Custom Config"
834 | [ testCase "ZSH: hardcoded character" $
835 | testWriterWithConfig
836 | (buildOutputConfig ZSH (zeroGitRepoState { gitStashCount = 2 }) customStashConfig) addStashes
837 | @?= "2%{\x1b[36m%}stash%{\x1b[0;39m%} "
838 |
839 | , testCase "Other: hardcoded character" $
840 | testWriterWithConfig
841 | (buildOutputConfig Other (zeroGitRepoState { gitStashCount = 2 }) customStashConfig) addStashes
842 | @?= "2\x1b[36mstash\x1b[0;39m "
843 |
844 | , testCase "TMUX: hardcoded character" $
845 | testWriterWithConfig
846 | (buildOutputConfig TMUX (zeroGitRepoState { gitStashCount = 2 }) customStashConfig) addStashes
847 | @?= "2#[fg=cyan]stash#[fg=default] "
848 |
849 | , testCase "NONE: hardcoded character" $
850 | testWriterWithConfig
851 | (buildOutputConfig NONE (zeroGitRepoState { gitStashCount = 2 }) customStashConfig) addStashes
852 | @?= "2stash "
853 | ]
854 | ]
855 |
856 | localChangesForPartialPrompt :: GitLocalRepoChanges
857 | localChangesForPartialPrompt = GitLocalRepoChanges {
858 | localMod = 1
859 | , localAdd = 2
860 | , localDel = 3
861 | , indexMod = 4
862 | , indexAdd = 5
863 | , indexDel = 6
864 | , renamed = 7
865 | , conflict = 8
866 | }
867 |
868 | repoStateForPartialPrompt :: GitRepoState
869 | repoStateForPartialPrompt = GitRepoState {
870 | gitLocalRepoChanges = localChangesForPartialPrompt
871 | , gitLocalBranch = "branch"
872 | {- The branch supercedes both the commit SHA and the tag -}
873 | , gitCommitShortSHA = "3de6ef"
874 | , gitCommitTag = "v1.3"
875 | , gitRemote = "origin"
876 | , gitRemoteTrackingBranch = "origin/branch"
877 | , gitStashCount = 3
878 | , gitCommitsToPull = 5
879 | , gitCommitsToPush = 6
880 | , gitMergeBranchCommitsToPull = 2
881 | , gitMergeBranchCommitsToPush = 1
882 | }
883 |
884 | {- For reference here, the full prompt would be
885 |
886 | "%{\ESC[0;39m%}\5812 \120366 2%{\ESC[1;32m%}\8644%{\ESC[0;39m%}1 [%{\ESC[0;39m%}branch%{\ESC[0;39m%}] 5%{\ESC[1;32m%}⥯%{\ESC[0;39m%}6 5%{\ESC[1;32m%}A%{\ESC[0;39m%}6%{\ESC[1;32m%}D%{\ESC[0;39m%}4%{\ESC[1;32m%}M%{\ESC[0;39m%}7%{\ESC[1;32m%}R%{\ESC[0;39m%} 3%{\ESC[1;31m%}D%{\ESC[0;39m%}1%{\ESC[1;31m%}M%{\ESC[0;39m%} 2%{\ESC[1;37m%}A%{\ESC[0;39m%} 8%{\ESC[1;32m%}C%{\ESC[0;39m%} 3%{\ESC[1;32m%}\8801%{\ESC[0;39m%} "
887 |
888 | -}
889 | testPartialPrompt :: TestTree
890 | testPartialPrompt = testGroup "Partial prompt display"
891 | [ testCase "w/out repo indicator" $
892 | testWriterWithConfig
893 | (buildOutputConfig ZSH repoStateForPartialPrompt defaultConfig { confShowPartRepoIndicator = False })
894 | buildPrompt
895 | @?= "%{\ESC[0;39m%}\120366 2%{\ESC[1;32m%}\8644%{\ESC[0;39m%}1 [%{\ESC[0;39m%}branch%{\ESC[0;39m%}] 5%{\ESC[1;32m%}⥯%{\ESC[0;39m%}6 5%{\ESC[1;32m%}A%{\ESC[0;39m%}6%{\ESC[1;32m%}D%{\ESC[0;39m%}4%{\ESC[1;32m%}M%{\ESC[0;39m%}7%{\ESC[1;32m%}R%{\ESC[0;39m%} 3%{\ESC[1;31m%}D%{\ESC[0;39m%}1%{\ESC[1;31m%}M%{\ESC[0;39m%} 2%{\ESC[1;37m%}A%{\ESC[0;39m%} 8%{\ESC[1;32m%}C%{\ESC[0;39m%} 3%{\ESC[1;32m%}\8801%{\ESC[0;39m%} "
896 |
897 | , testCase "w/out merge branch commits info" $
898 | testWriterWithConfig
899 | (buildOutputConfig ZSH repoStateForPartialPrompt defaultConfig { confShowPartMergeBranchCommitsDiff = False })
900 | buildPrompt
901 | @?= "%{\ESC[0;39m%}\5812 [%{\ESC[0;39m%}branch%{\ESC[0;39m%}] 5%{\ESC[1;32m%}⥯%{\ESC[0;39m%}6 5%{\ESC[1;32m%}A%{\ESC[0;39m%}6%{\ESC[1;32m%}D%{\ESC[0;39m%}4%{\ESC[1;32m%}M%{\ESC[0;39m%}7%{\ESC[1;32m%}R%{\ESC[0;39m%} 3%{\ESC[1;31m%}D%{\ESC[0;39m%}1%{\ESC[1;31m%}M%{\ESC[0;39m%} 2%{\ESC[1;37m%}A%{\ESC[0;39m%} 8%{\ESC[1;32m%}C%{\ESC[0;39m%} 3%{\ESC[1;32m%}\8801%{\ESC[0;39m%} "
902 |
903 | , testCase "w/out local branch info" $
904 | testWriterWithConfig
905 | (buildOutputConfig ZSH repoStateForPartialPrompt defaultConfig { confShowPartLocalBranch = False })
906 | buildPrompt
907 | @?= "%{\ESC[0;39m%}\5812 \120366 2%{\ESC[1;32m%}\8644%{\ESC[0;39m%}1 5%{\ESC[1;32m%}⥯%{\ESC[0;39m%}6 5%{\ESC[1;32m%}A%{\ESC[0;39m%}6%{\ESC[1;32m%}D%{\ESC[0;39m%}4%{\ESC[1;32m%}M%{\ESC[0;39m%}7%{\ESC[1;32m%}R%{\ESC[0;39m%} 3%{\ESC[1;31m%}D%{\ESC[0;39m%}1%{\ESC[1;31m%}M%{\ESC[0;39m%} 2%{\ESC[1;37m%}A%{\ESC[0;39m%} 8%{\ESC[1;32m%}C%{\ESC[0;39m%} 3%{\ESC[1;32m%}\8801%{\ESC[0;39m%} "
908 |
909 | , testCase "with a branch set to ignore its merge branch" $
910 | testWriterWithConfig
911 | (buildOutputConfig ZSH repoStateForPartialPrompt defaultConfig { confMergeBranchIgnoreBranches = ["branch"] })
912 | buildPrompt
913 | @?= "%{\ESC[0;39m%}\5812 [%{\ESC[0;39m%}branch%{\ESC[0;39m%}] 5%{\ESC[1;32m%}⥯%{\ESC[0;39m%}6 5%{\ESC[1;32m%}A%{\ESC[0;39m%}6%{\ESC[1;32m%}D%{\ESC[0;39m%}4%{\ESC[1;32m%}M%{\ESC[0;39m%}7%{\ESC[1;32m%}R%{\ESC[0;39m%} 3%{\ESC[1;31m%}D%{\ESC[0;39m%}1%{\ESC[1;31m%}M%{\ESC[0;39m%} 2%{\ESC[1;37m%}A%{\ESC[0;39m%} 8%{\ESC[1;32m%}C%{\ESC[0;39m%} 3%{\ESC[1;32m%}\8801%{\ESC[0;39m%} "
914 |
915 | , testCase "w/out commits push/pull info" $
916 | testWriterWithConfig
917 | (buildOutputConfig ZSH repoStateForPartialPrompt defaultConfig { confShowPartCommitsToOrigin = False })
918 | buildPrompt
919 | @?= "%{\ESC[0;39m%}\5812 \120366 2%{\ESC[1;32m%}\8644%{\ESC[0;39m%}1 [%{\ESC[0;39m%}branch%{\ESC[0;39m%}] 5%{\ESC[1;32m%}A%{\ESC[0;39m%}6%{\ESC[1;32m%}D%{\ESC[0;39m%}4%{\ESC[1;32m%}M%{\ESC[0;39m%}7%{\ESC[1;32m%}R%{\ESC[0;39m%} 3%{\ESC[1;31m%}D%{\ESC[0;39m%}1%{\ESC[1;31m%}M%{\ESC[0;39m%} 2%{\ESC[1;37m%}A%{\ESC[0;39m%} 8%{\ESC[1;32m%}C%{\ESC[0;39m%} 3%{\ESC[1;32m%}\8801%{\ESC[0;39m%} "
920 |
921 | , testCase "w/out local repo changes" $
922 | testWriterWithConfig
923 | (buildOutputConfig ZSH repoStateForPartialPrompt defaultConfig { confShowPartLocalChangesState = False })
924 | buildPrompt
925 | @?= "%{\ESC[0;39m%}\5812 \120366 2%{\ESC[1;32m%}\8644%{\ESC[0;39m%}1 [%{\ESC[0;39m%}branch%{\ESC[0;39m%}] 5%{\ESC[1;32m%}⥯%{\ESC[0;39m%}6 3%{\ESC[1;32m%}\8801%{\ESC[0;39m%} "
926 |
927 | , testCase "w/out stashes" $
928 | testWriterWithConfig
929 | (buildOutputConfig ZSH repoStateForPartialPrompt defaultConfig { confShowPartStashes = False })
930 | buildPrompt
931 | @?= "%{\ESC[0;39m%}\5812 \120366 2%{\ESC[1;32m%}\8644%{\ESC[0;39m%}1 [%{\ESC[0;39m%}branch%{\ESC[0;39m%}] 5%{\ESC[1;32m%}⥯%{\ESC[0;39m%}6 5%{\ESC[1;32m%}A%{\ESC[0;39m%}6%{\ESC[1;32m%}D%{\ESC[0;39m%}4%{\ESC[1;32m%}M%{\ESC[0;39m%}7%{\ESC[1;32m%}R%{\ESC[0;39m%} 3%{\ESC[1;31m%}D%{\ESC[0;39m%}1%{\ESC[1;31m%}M%{\ESC[0;39m%} 2%{\ESC[1;37m%}A%{\ESC[0;39m%} 8%{\ESC[1;32m%}C%{\ESC[0;39m%} "
932 | ]
933 |
934 | -- | Utility function to test a ShellOutput function and gets the prompt built
935 | testWriterWithConfig :: OutputConfig -- ^ Starting reader state
936 | -> ShellOutput -- ^ Function under test
937 | -> String -- ^ Output of the function for the given config
938 | testWriterWithConfig config functionUnderTest =
939 | runReader (runWriterT functionUnderTest >>= (\(_, out) -> return out)) config
940 |
941 | zeroOutputConfig :: Shell
942 | -> OutputConfig
943 | zeroOutputConfig shell = buildOutputConfig shell zeroGitRepoState defaultConfig
944 |
945 | testMergeBranchCommitsToPull :: Shell -> Config -> String
946 | testMergeBranchCommitsToPull shell config = testWriterWithConfig
947 | (buildOutputConfig shell (zeroGitRepoState { gitMergeBranchCommitsToPull = 2 }) config)
948 | addMergeBranchCommits
949 |
950 | testMergeBranchCommitsToPush :: Shell -> Config -> String
951 | testMergeBranchCommitsToPush shell config = testWriterWithConfig
952 | (buildOutputConfig shell (zeroGitRepoState { gitMergeBranchCommitsToPush = 2 }) config)
953 | addMergeBranchCommits
954 |
955 | testMergeBranchCommitsToPushAndPull :: Shell -> Config -> String
956 | testMergeBranchCommitsToPushAndPull shell config = testWriterWithConfig
957 | (buildOutputConfig shell
958 | (zeroGitRepoState { gitMergeBranchCommitsToPull = 4, gitMergeBranchCommitsToPush = 4 })
959 | config
960 | )
961 | addMergeBranchCommits
962 |
963 | testCommitsToPull :: Shell -> Config -> String
964 | testCommitsToPull shell config = testWriterWithConfig
965 | (buildOutputConfig shell (zeroGitRepoState { gitCommitsToPull = 2 }) config)
966 | addLocalCommits
967 |
968 | testCommitsToPush :: Shell -> Config -> String
969 | testCommitsToPush shell config = testWriterWithConfig
970 | (buildOutputConfig shell (zeroGitRepoState { gitCommitsToPush = 2 }) config)
971 | addLocalCommits
972 |
973 | testCommitsToPushAndPull :: Shell -> Config -> String
974 | testCommitsToPushAndPull shell config = testWriterWithConfig
975 | (buildOutputConfig shell
976 | (zeroGitRepoState { gitCommitsToPull = 4, gitCommitsToPush = 4 })
977 | config
978 | )
979 | addLocalCommits
980 |
981 | testLocalAddChange :: Shell -> Config -> String
982 | testLocalAddChange shell config = testWriterWithConfig
983 | (buildOutputConfig shell
984 | (zeroGitRepoState { gitLocalRepoChanges =
985 | (zeroLocalRepoChanges { localAdd = 2 })
986 | })
987 | config
988 | )
989 | addRepoState
990 |
991 | testLocalModChange :: Shell -> Config -> String
992 | testLocalModChange shell config = testWriterWithConfig
993 | (buildOutputConfig shell
994 | (zeroGitRepoState { gitLocalRepoChanges =
995 | (zeroLocalRepoChanges { localMod = 2 })
996 | })
997 | config
998 | )
999 | addRepoState
1000 |
1001 | testLocalDelChange :: Shell -> Config -> String
1002 | testLocalDelChange shell config = testWriterWithConfig
1003 | (buildOutputConfig shell
1004 | (zeroGitRepoState { gitLocalRepoChanges =
1005 | (zeroLocalRepoChanges { localDel = 2 })
1006 | })
1007 | config
1008 | )
1009 | addRepoState
1010 |
1011 | testIndexAddChange :: Shell -> Config -> String
1012 | testIndexAddChange shell config = testWriterWithConfig
1013 | (buildOutputConfig shell
1014 | (zeroGitRepoState { gitLocalRepoChanges =
1015 | (zeroLocalRepoChanges { indexAdd = 2 })
1016 | })
1017 | config
1018 | )
1019 | addRepoState
1020 |
1021 | testIndexModChange :: Shell -> Config -> String
1022 | testIndexModChange shell config = testWriterWithConfig
1023 | (buildOutputConfig shell
1024 | (zeroGitRepoState { gitLocalRepoChanges =
1025 | (zeroLocalRepoChanges { indexMod = 2 })
1026 | })
1027 | config
1028 | )
1029 | addRepoState
1030 |
1031 | testIndexDelChange :: Shell -> Config -> String
1032 | testIndexDelChange shell config = testWriterWithConfig
1033 | (buildOutputConfig shell
1034 | (zeroGitRepoState { gitLocalRepoChanges =
1035 | (zeroLocalRepoChanges { indexDel = 2 })
1036 | })
1037 | config
1038 | )
1039 | addRepoState
1040 |
1041 | testConflictedChange :: Shell -> Config -> String
1042 | testConflictedChange shell config = testWriterWithConfig
1043 | (buildOutputConfig shell
1044 | (zeroGitRepoState { gitLocalRepoChanges =
1045 | (zeroLocalRepoChanges { conflict = 2 })
1046 | })
1047 | config
1048 | )
1049 | addRepoState
1050 |
1051 | testRenamedChange :: Shell -> Config -> String
1052 | testRenamedChange shell config = testWriterWithConfig
1053 | (buildOutputConfig shell
1054 | (zeroGitRepoState { gitLocalRepoChanges =
1055 | (zeroLocalRepoChanges { renamed = 2 })
1056 | })
1057 | config
1058 | )
1059 | addRepoState
1060 |
1061 | testEveryRepoChange :: Shell -> Config -> String
1062 | testEveryRepoChange shell config = testWriterWithConfig
1063 | (buildOutputConfig shell
1064 | (zeroGitRepoState { gitLocalRepoChanges =
1065 | (zeroLocalRepoChanges { renamed = 1
1066 | , conflict = 2
1067 | , localAdd = 3
1068 | , localMod = 4
1069 | , localDel = 5
1070 | , indexAdd = 6
1071 | , indexMod = 7
1072 | , indexDel = 8
1073 | })
1074 | })
1075 | config
1076 | )
1077 | addRepoState
1078 |
--------------------------------------------------------------------------------