├── stack.yaml
├── screenshot.png
├── .editorconfig
├── hie.yaml
├── .gitignore
├── stack.yaml.lock
├── app
    ├── Main.hs
    ├── Theme.hs
    ├── Git.hs
    └── GitBrunch.hs
├── default.nix
├── LICENSE
├── package.yaml
├── .github
    └── workflows
    │   ├── ci.yml
    │   ├── matrix-build.yml
    │   └── release.yml
├── test
    └── Spec.hs
├── git-brunch.cabal
└── README.md


/stack.yaml:
--------------------------------------------------------------------------------
1 | resolver: lts-21.11
2 | packages:
3 |   - .
4 | 


--------------------------------------------------------------------------------
/screenshot.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/andys8/git-brunch/HEAD/screenshot.png


--------------------------------------------------------------------------------
/.editorconfig:
--------------------------------------------------------------------------------
1 | root = true
2 | 
3 | [*.hs]
4 | indent_style = space
5 | indent_size = 2
6 | 


--------------------------------------------------------------------------------
/hie.yaml:
--------------------------------------------------------------------------------
1 | cradle:
2 |   stack:
3 |     - path: "./app"
4 |       component: "git-brunch:exe:git-brunch"
5 |     - path: "./test"
6 |       component: "git-brunch:test:git-brunch-test"
7 | 


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
 1 | .stack-work/
 2 | *~
 3 | dist
 4 | dist-*
 5 | cabal-dev
 6 | *.o
 7 | *.hi
 8 | *.chi
 9 | *.chs.h
10 | *.dyn_o
11 | *.dyn_hi
12 | .hpc
13 | .hsenv
14 | .cabal-sandbox/
15 | cabal.sandbox.config
16 | *.prof
17 | *.aux
18 | *.hp
19 | *.eventlog
20 | .stack-work/
21 | cabal.project.local
22 | cabal.project.local~
23 | .HTF/
24 | .ghc.environment.*
25 | result
26 | cabal.project
27 | 


--------------------------------------------------------------------------------
/stack.yaml.lock:
--------------------------------------------------------------------------------
 1 | # This file was autogenerated by Stack.
 2 | # You should not edit this file by hand.
 3 | # For more information, please see the documentation at:
 4 | #   https://docs.haskellstack.org/en/stable/lock_files
 5 | 
 6 | packages: []
 7 | snapshots:
 8 | - completed:
 9 |     sha256: 64d66303f927e87ffe6b8ccf736229bf608731e80d7afdf62bdd63c59f857740
10 |     size: 640037
11 |     url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/11.yaml
12 |   original: lts-21.11
13 | 


--------------------------------------------------------------------------------
/app/Main.hs:
--------------------------------------------------------------------------------
 1 | module Main (main) where
 2 | 
 3 | import Data.Version (showVersion)
 4 | import Options.Applicative
 5 | import Paths_git_brunch (version)
 6 | 
 7 | import GitBrunch qualified
 8 | 
 9 | data Mode
10 |   = RunGitBrunch
11 |   | ShowVersion
12 | 
13 | main :: IO ()
14 | main = run =<< execParser opts
15 |  where
16 |   opts =
17 |     info
18 |       (versionParser <|> pure RunGitBrunch <**> helper)
19 |       (header "git-brunch - A git command-line tool to work with branches")
20 | 
21 | run :: Mode -> IO ()
22 | run ShowVersion = putStrLn $ showVersion version
23 | run RunGitBrunch = GitBrunch.main
24 | 
25 | versionParser :: Parser Mode
26 | versionParser =
27 |   flag' ShowVersion (long "version" <> short 'v' <> help "Show version")
28 | 


--------------------------------------------------------------------------------
/default.nix:
--------------------------------------------------------------------------------
 1 | { nixpkgs ? import <nixpkgs> {}, compiler ? "default", doBenchmark ? false }:
 2 | 
 3 | let
 4 | 
 5 |   inherit (nixpkgs) pkgs;
 6 | 
 7 |   f = { mkDerivation, base, brick, extra, hpack, hspec, lib
 8 |       , microlens, microlens-mtl, mtl, optparse-applicative, process
 9 |       , text, vector, vty
10 |       }:
11 |       mkDerivation {
12 |         pname = "git-brunch";
13 |         version = "1.7.2.0";
14 |         src = ./.;
15 |         isLibrary = false;
16 |         isExecutable = true;
17 |         libraryToolDepends = [ hpack ];
18 |         executableHaskellDepends = [
19 |           base brick extra hspec microlens microlens-mtl mtl
20 |           optparse-applicative process text vector vty
21 |         ];
22 |         testHaskellDepends = [
23 |           base brick extra hspec microlens microlens-mtl mtl
24 |           optparse-applicative process text vector vty
25 |         ];
26 |         prePatch = "hpack";
27 |         homepage = "https://github.com/andys8/git-brunch#readme";
28 |         description = "git checkout command-line tool";
29 |         license = lib.licenses.bsd3;
30 |       };
31 | 
32 |   haskellPackages = if compiler == "default"
33 |                        then pkgs.haskellPackages
34 |                        else pkgs.haskell.packages.${compiler};
35 | 
36 |   variant = if doBenchmark then pkgs.haskell.lib.doBenchmark else pkgs.lib.id;
37 | 
38 |   drv = variant (haskellPackages.callPackage f {});
39 | 
40 | in
41 | 
42 |   if pkgs.lib.inNixShell then drv.env else drv
43 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
 1 | Copyright andys8 (c) 2023
 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 Author name here 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.
31 | 


--------------------------------------------------------------------------------
/app/Theme.hs:
--------------------------------------------------------------------------------
 1 | module Theme where
 2 | 
 3 | import Brick.AttrMap (AttrName, attrName)
 4 | import Brick.Themes
 5 | import Brick.Util
 6 | import Brick.Widgets.Border as Border
 7 | import Brick.Widgets.Dialog qualified as Dialog
 8 | import Brick.Widgets.Edit qualified as Edit
 9 | import Brick.Widgets.List qualified as List
10 | import Graphics.Vty
11 | 
12 | theme :: Theme
13 | theme =
14 |   newTheme
15 |     (white `on` brightBlack)
16 |     [ (List.listAttr, fg brightWhite)
17 |     , (List.listSelectedAttr, fg brightWhite)
18 |     , (List.listSelectedFocusedAttr, black `on` brightYellow)
19 |     , (Dialog.dialogAttr, fg brightWhite)
20 |     , (Dialog.buttonAttr, brightBlack `on` white)
21 |     , (Dialog.buttonSelectedAttr, black `on` brightMagenta)
22 |     , (Border.borderAttr, fg white)
23 |     , (Edit.editFocusedAttr, fg brightWhite)
24 |     , (attrKey, withStyle (fg brightMagenta) bold)
25 |     , (attrBold, withStyle (fg white) bold)
26 |     , (attrUnder, withStyle (fg brightWhite) underline)
27 |     , (attrTitle, withStyle (fg brightWhite) bold)
28 |     , (attrTitleFocus, withStyle (fg yellow) bold)
29 |     , (attrBranchCurrent, fg brightRed)
30 |     , (attrBranchCommon, fg brightBlue)
31 |     ]
32 | 
33 | attrKey :: AttrName
34 | attrKey = attrName "key"
35 | 
36 | attrBold :: AttrName
37 | attrBold = attrName "bold"
38 | 
39 | attrUnder :: AttrName
40 | attrUnder = attrName "under"
41 | 
42 | attrTitle :: AttrName
43 | attrTitle = attrName "title"
44 | 
45 | attrTitleFocus :: AttrName
46 | attrTitleFocus = attrName "title-focus"
47 | 
48 | attrBranchCurrent :: AttrName
49 | attrBranchCurrent = attrName "current-branch"
50 | 
51 | attrBranchCommon :: AttrName
52 | attrBranchCommon = attrName "common-branch"
53 | 


--------------------------------------------------------------------------------
/package.yaml:
--------------------------------------------------------------------------------
 1 | name: git-brunch
 2 | version: 1.7.2.0
 3 | github: "andys8/git-brunch"
 4 | license: BSD3
 5 | author: "andys8"
 6 | maintainer: "andys8@users.noreply.github.com"
 7 | copyright: "2023 andys8"
 8 | 
 9 | extra-source-files:
10 |   - README.md
11 | 
12 | synopsis: git checkout command-line tool
13 | category: Git
14 | 
15 | description: Please see the README on GitHub at <https://github.com/andys8/git-brunch>
16 | 
17 | dependencies:
18 |   - base >= 4.7 && < 5
19 |   - brick
20 |   - extra
21 |   - microlens
22 |   - microlens-mtl
23 |   - mtl
24 |   - optparse-applicative
25 |   - process
26 |   - text
27 |   - vector
28 |   - vty
29 |   - hspec # workaround for language servers
30 | 
31 | default-extensions:
32 |   - ImportQualifiedPost
33 |   - LambdaCase
34 |   - OverloadedStrings
35 |   - StrictData
36 | 
37 | flags:
38 |   static:
39 |     manual: true
40 |     default: false
41 | 
42 | executables:
43 |   git-brunch:
44 |     main: Main.hs
45 |     source-dirs: app
46 |     when:
47 |       - condition: flag(static)
48 |         then:
49 |           cc-options: -static
50 |           ld-options: -static -pthread
51 |           ghc-options:
52 |             - -static
53 |             - -threaded
54 |             - -rtsopts
55 |             - -with-rtsopts=-N
56 |             - -Wall
57 |             - -O2
58 |             - -optl-fuse-ld=bfd
59 |         else:
60 |           ghc-options:
61 |             - -threaded
62 |             - -rtsopts
63 |             - -with-rtsopts=-N
64 |             - -Wall
65 |             - -O2
66 | 
67 | tests:
68 |   git-brunch-test:
69 |     main: Spec.hs
70 |     source-dirs:
71 |       - test
72 |       - app
73 |     other-modules:
74 |       - Git
75 |     ghc-options:
76 |       - -threaded
77 |       - -rtsopts
78 |       - -with-rtsopts=-N
79 |     dependencies:
80 |       - hspec
81 | 


--------------------------------------------------------------------------------
/.github/workflows/ci.yml:
--------------------------------------------------------------------------------
 1 | name: CI
 2 | 
 3 | on: [push]
 4 | 
 5 | jobs:
 6 |   build:
 7 |     strategy:
 8 |       matrix:
 9 |         os: [ubuntu-20.04]
10 |     runs-on: ${{ matrix.os }}
11 |     steps:
12 |       - uses: actions/checkout@v3
13 |       - if: matrix.os  == 'ubuntu-20.04'
14 |         uses: actions/cache@v3
15 |         name: Cache ~/.stack
16 |         with:
17 |           path: ~/.stack
18 |           key: ${{ runner.os }}-stack-${{ hashFiles('**/stack.yaml.lock') }}-${{ hashFiles('**/package.yaml') }}
19 |           restore-keys: |
20 |             ${{ runner.os }}-stack-${{ hashFiles('**/stack.yaml.lock') }}-
21 |             ${{ runner.os }}-stack-
22 |       - uses: haskell/actions/setup@v2
23 |         with:
24 |           ghc-version: "9.4.6"
25 |           enable-stack: true
26 |           stack-version: "latest"
27 |       - name: Build
28 |         run: stack build
29 |       - name: Run tests
30 |         run: stack test
31 |       - name: Run with --version
32 |         run: stack run -- --version
33 |       - name: Build statically linked
34 |         run: stack build --flag git-brunch:static
35 | 
36 |   cabal:
37 |     strategy:
38 |       matrix:
39 |         os: [ubuntu-20.04]
40 |     runs-on: ${{ matrix.os }}
41 |     steps:
42 |       - uses: actions/checkout@v3
43 |       - uses: actions/cache@v3
44 |         name: Cache cabal
45 |         with:
46 |           path: |
47 |             ~/.cabal/packages
48 |             ~/.cabal/store
49 |             dist-newstyle
50 |           key: ${{ runner.os }}-cabal-${{ hashFiles('**/*.cabal', '**/cabal.project', '**/cabal.project.freeze') }}
51 |           restore-keys: ${{ runner.os }}-cabal-
52 |       - uses: haskell/actions/setup@v2
53 |         with:
54 |           ghc-version: "9.4.6"
55 |           enable-stack: false
56 |           cabal-version: "latest"
57 |       - run: cabal update
58 |       - name: Build
59 |         run: cabal build
60 |       - name: Run tests
61 |         run: cabal test
62 | 


--------------------------------------------------------------------------------
/test/Spec.hs:
--------------------------------------------------------------------------------
 1 | import Data.Text (Text)
 2 | import Git
 3 | import Test.Hspec
 4 | 
 5 | main :: IO ()
 6 | main = hspec $
 7 |   describe "Git.toBranch" $ do
 8 |     it "returns a remote branch is starts with remote" $ do
 9 |       toBranches "remotes/origin/master" `shouldBe` [BranchRemote "origin" "master"]
10 | 
11 |     it "ignores leading spaces" $ do
12 |       toBranches "  master" `shouldBe` [BranchLocal "master"]
13 | 
14 |     it "detects current branch by asterik" $ do
15 |       toBranches "* master" `shouldBe` [BranchCurrent "master"]
16 | 
17 |     it "returns a local branch" $ do
18 |       toBranches "master" `shouldBe` [BranchLocal "master"]
19 | 
20 |     it "returns a branch with head in name" $ do
21 |       toBranches "updateHead" `shouldBe` [BranchLocal "updateHead"]
22 | 
23 |     it "ignores HEAD" $ do
24 |       toBranches "HEAD" `shouldBe` []
25 | 
26 |     it "ignores empty" $ do
27 |       toBranches "" `shouldBe` []
28 | 
29 |     it "ignores origin/HEAD" $ do
30 |       toBranches "origin/HEAD" `shouldBe` []
31 | 
32 |     it "ignores detatched HEAD" $ do
33 |       toBranches "* (HEAD detached at f01a202)" `shouldBe` []
34 | 
35 |     it "ignores 'no branch' during rebase" $ do
36 |       toBranches "* (no branch, rebasing branch-name)" `shouldBe` []
37 | 
38 |     it "parses sample output" $ do
39 |       toBranches sampleOutput
40 |         `shouldBe` [ BranchLocal "experimental/failing-debug-log-demo"
41 |                    , BranchLocal "gh-pages"
42 |                    , BranchLocal "master"
43 |                    , BranchLocal "wip/delete-as-action"
44 |                    , BranchRemote "origin" "experimental/failing-debug-log-demo"
45 |                    , BranchRemote "origin" "gh-pages"
46 |                    , BranchRemote "origin" "master"
47 |                    ]
48 | 
49 | sampleOutput :: Text
50 | sampleOutput =
51 |   "* (HEAD detached at f01a202)\n"
52 |     <> "  experimental/failing-debug-log-demo\n"
53 |     <> "  gh-pages\n"
54 |     <> "  master\n"
55 |     <> "  wip/delete-as-action\n"
56 |     <> "  remotes/origin/HEAD -> origin/master\n"
57 |     <> "  remotes/origin/experimental/failing-debug-log-demo\n"
58 |     <> "  remotes/origin/gh-pages\n"
59 |     <> "  remotes/origin/master"
60 | 


--------------------------------------------------------------------------------
/git-brunch.cabal:
--------------------------------------------------------------------------------
 1 | cabal-version: 1.12
 2 | 
 3 | -- This file has been generated from package.yaml by hpack version 0.35.1.
 4 | --
 5 | -- see: https://github.com/sol/hpack
 6 | 
 7 | name:           git-brunch
 8 | version:        1.7.2.0
 9 | synopsis:       git checkout command-line tool
10 | description:    Please see the README on GitHub at <https://github.com/andys8/git-brunch>
11 | category:       Git
12 | homepage:       https://github.com/andys8/git-brunch#readme
13 | bug-reports:    https://github.com/andys8/git-brunch/issues
14 | author:         andys8
15 | maintainer:     andys8@users.noreply.github.com
16 | copyright:      2023 andys8
17 | license:        BSD3
18 | license-file:   LICENSE
19 | build-type:     Simple
20 | extra-source-files:
21 |     README.md
22 | 
23 | source-repository head
24 |   type: git
25 |   location: https://github.com/andys8/git-brunch
26 | 
27 | flag static
28 |   manual: True
29 |   default: False
30 | 
31 | executable git-brunch
32 |   main-is: Main.hs
33 |   other-modules:
34 |       Git
35 |       GitBrunch
36 |       Theme
37 |       Paths_git_brunch
38 |   hs-source-dirs:
39 |       app
40 |   default-extensions:
41 |       ImportQualifiedPost
42 |       LambdaCase
43 |       OverloadedStrings
44 |       StrictData
45 |   build-depends:
46 |       base >=4.7 && <5
47 |     , brick
48 |     , extra
49 |     , hspec
50 |     , microlens
51 |     , microlens-mtl
52 |     , mtl
53 |     , optparse-applicative
54 |     , process
55 |     , text
56 |     , vector
57 |     , vty
58 |   default-language: Haskell2010
59 |   if flag(static)
60 |     ghc-options: -static -threaded -rtsopts -with-rtsopts=-N -Wall -O2 -optl-fuse-ld=bfd
61 |     cc-options: -static
62 |     ld-options: -static -pthread
63 |   else
64 |     ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -O2
65 | 
66 | test-suite git-brunch-test
67 |   type: exitcode-stdio-1.0
68 |   main-is: Spec.hs
69 |   other-modules:
70 |       Git
71 |   hs-source-dirs:
72 |       test
73 |       app
74 |   default-extensions:
75 |       ImportQualifiedPost
76 |       LambdaCase
77 |       OverloadedStrings
78 |       StrictData
79 |   ghc-options: -threaded -rtsopts -with-rtsopts=-N
80 |   build-depends:
81 |       base >=4.7 && <5
82 |     , brick
83 |     , extra
84 |     , hspec
85 |     , microlens
86 |     , microlens-mtl
87 |     , mtl
88 |     , optparse-applicative
89 |     , process
90 |     , text
91 |     , vector
92 |     , vty
93 |   default-language: Haskell2010
94 | 


--------------------------------------------------------------------------------
/.github/workflows/matrix-build.yml:
--------------------------------------------------------------------------------
 1 | name: build
 2 | on:
 3 |   push:
 4 |     branches: [master]
 5 |   pull_request:
 6 |     branches: [master]
 7 | 
 8 | permissions:
 9 |   contents: read
10 | 
11 | jobs:
12 |   build:
13 |     name: GHC ${{ matrix.ghc-version }} on ${{ matrix.os }}
14 |     runs-on: ${{ matrix.os }}
15 |     strategy:
16 |       fail-fast: false
17 |       matrix:
18 |         os: [ubuntu-latest]
19 |         ghc-version: ["9.6", "9.4", "9.2", "9.0", "8.10"]
20 | 
21 |         include:
22 |           - os: macos-latest
23 |             ghc-version: "9.6"
24 | 
25 |     steps:
26 |       - uses: actions/checkout@v3
27 | 
28 |       - name: Set up GHC ${{ matrix.ghc-version }}
29 |         uses: haskell/actions/setup@v2
30 |         id: setup
31 |         with:
32 |           ghc-version: ${{ matrix.ghc-version }}
33 |           # Defaults, added for clarity:
34 |           cabal-version: "latest"
35 |           cabal-update: true
36 | 
37 |       - name: Configure the build
38 |         run: |
39 |           cabal configure --enable-tests --disable-documentation
40 |           cabal build --dry-run
41 |         # The last step generates dist-newstyle/cache/plan.json for the cache key.
42 | 
43 |       - name: Restore cached dependencies
44 |         uses: actions/cache/restore@v3
45 |         id: cache
46 |         env:
47 |           key: ${{ runner.os }}-ghc-${{ steps.setup.outputs.ghc-version }}-cabal-${{ steps.setup.outputs.cabal-version }}
48 |         with:
49 |           path: ${{ steps.setup.outputs.cabal-store }}
50 |           key: ${{ env.key }}-plan-${{ hashFiles('**/plan.json') }}
51 |           restore-keys: ${{ env.key }}-
52 | 
53 |       - name: Install dependencies
54 |         run: cabal build all --only-dependencies
55 | 
56 |       # Cache dependencies already here, so that we do not have to rebuild them should the subsequent steps fail.
57 |       - name: Save cached dependencies
58 |         uses: actions/cache/save@v3
59 |         # Caches are immutable, trying to save with the same key would error.
60 |         if: ${{ steps.cache.outputs.cache-primary-key != steps.cache.outputs.cache-matched-key }}
61 |         with:
62 |           path: ${{ steps.setup.outputs.cabal-store }}
63 |           key: ${{ steps.cache.outputs.cache-primary-key }}
64 | 
65 |       - name: Build
66 |         run: cabal build all
67 | 
68 |       - name: Run tests
69 |         run: cabal test all
70 | 
71 |       - name: Check cabal file
72 |         run: cabal check
73 | 


--------------------------------------------------------------------------------
/.github/workflows/release.yml:
--------------------------------------------------------------------------------
 1 | name: Release
 2 | 
 3 | on:
 4 |   push:
 5 |     tags:
 6 |       - "v*"
 7 | 
 8 | jobs:
 9 |   create_release:
10 |     name: Create Github Release
11 |     runs-on: ubuntu-20.04
12 |     steps:
13 |       - name: Check out code
14 |         uses: actions/checkout@v3
15 |       - name: Create Release
16 |         id: create_release
17 |         uses: actions/create-release@v1.1.4
18 |         env:
19 |           GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
20 |         with:
21 |           tag_name: ${{ github.ref }}
22 |           release_name: Release ${{ github.ref }}
23 |           draft: false
24 |           prerelease: false
25 |       - name: Output Release URL File
26 |         run: echo "${{ steps.create_release.outputs.upload_url }}" > release_url.txt
27 |       - name: Save Release URL File for publish
28 |         uses: actions/upload-artifact@v1
29 |         with:
30 |           name: release_url
31 |           path: release_url.txt
32 | 
33 |   build_artifact:
34 |     needs: [create_release]
35 |     name: Build Artifact
36 |     strategy:
37 |       matrix:
38 |         os: [ubuntu-20.04, macos-latest]
39 |     runs-on: ${{ matrix.os }}
40 |     steps:
41 |       - uses: actions/checkout@v3
42 |       - if: matrix.os  == 'ubuntu-20.04'
43 |         uses: actions/cache@v3
44 |         name: Cache ~/.stack
45 |         with:
46 |           path: ~/.stack
47 |           key: ${{ runner.os }}-stack-${{ hashFiles('**/stack.yaml.lock') }}-${{ hashFiles('**/package.yaml') }}
48 |           restore-keys: |
49 |             ${{ runner.os }}-stack-${{ hashFiles('**/stack.yaml.lock') }}-
50 |             ${{ runner.os }}-stack-
51 |       - uses: haskell/actions/setup@v2
52 |         with:
53 |           ghc-version: "9.4.6"
54 |           enable-stack: true
55 |           stack-version: "latest"
56 |       - if: matrix.os  == 'ubuntu-20.04'
57 |         name: Build binary (linux/static)
58 |         run: stack install --local-bin-path dist  --flag git-brunch:static
59 |       - if: matrix.os  == 'macos-latest'
60 |         name: Build binary (macos/dynamic)
61 |         run: stack install --local-bin-path dist
62 |       - name: Load Release URL File from release job
63 |         uses: actions/download-artifact@v1
64 |         with:
65 |           name: release_url
66 |       - name: Get Release File Name & Upload URL
67 |         id: get_release_info
68 |         run: |
69 |           value=`cat release_url/release_url.txt`
70 |           echo ::set-output name=upload_url::$value
71 |       - name: Upload Release Asset
72 |         id: upload-release-asset
73 |         uses: actions/upload-release-asset@v1.0.1
74 |         env:
75 |           GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
76 |         with:
77 |           upload_url: ${{ steps.get_release_info.outputs.upload_url }}
78 |           asset_path: ./dist/git-brunch
79 |           asset_name: git-brunch-${{ runner.os }}
80 |           asset_content_type: application/octet-stream
81 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
  1 | # git-brunch ![Actions](https://github.com/andys8/git-brunch/workflows/CI/badge.svg)
  2 | 
  3 | A git command-line tool to work with branches
  4 | 
  5 | ![screenshot](https://raw.githubusercontent.com/andys8/git-brunch/master/screenshot.png)
  6 | 
  7 | ## Features
  8 | 
  9 | - Quickly checkout local or remote branch
 10 | - Merge or rebase a branch
 11 | - Search for a branch
 12 | - Delete a branch
 13 | - Fetch / Update
 14 | 
 15 | ## Usage
 16 | 
 17 | Run `git-brunch` or `git brunch`.
 18 | 
 19 | ### Git alias (optional)
 20 | 
 21 | An alias like `git b` (or `gb`) is a good idea to quickly access the tool.
 22 | 
 23 | ```sh
 24 | git config --global alias.b brunch
 25 | ```
 26 | 
 27 | ## Installation
 28 | 
 29 | The installation is possible in multiple ways, and there are binaries available to download.
 30 | 
 31 | ### Download binary
 32 | 
 33 | 1. Download from **[releases](https://github.com/andys8/git-brunch/releases)**
 34 | 1. Rename the file to `git-brunch`
 35 | 1. Make it executable with `chmod +x git-brunch`
 36 | 1. Add to your `PATH`
 37 | 
 38 | ### Arch Linux
 39 | 
 40 | `git-brunch` is in the [AUR](https://aur.archlinux.org/packages/git-brunch)
 41 | 
 42 | ```sh
 43 | yay -S git-brunch
 44 | pamac install git-brunch
 45 | ```
 46 | 
 47 | ### FreeBSD
 48 | 
 49 | `git-brunch` can be installed from the official FreeBSD package repository
 50 | 
 51 | ```sh
 52 | pkg install hs-git-brunch
 53 | ```
 54 | 
 55 | ### [Nix](https://nixos.org/nix)
 56 | 
 57 | `git-brunch` is part of the nix package manager
 58 | 
 59 | ```sh
 60 | nix-env -i git-brunch
 61 | ```
 62 | 
 63 | ### [Stack](https://haskellstack.org)
 64 | 
 65 | `git-brunch` can installed with the Haskell build tool stack
 66 | 
 67 | ```sh
 68 | stack install git-brunch # --resolver=lts-lts-20.4
 69 | ```
 70 | 
 71 | ### Install from source
 72 | 
 73 | `git-brunch` can be installed from source. It can be forked and modified, if you like to.
 74 | 
 75 | ```sh
 76 | git clone https://github.com/andys8/git-brunch
 77 | cd git-brunch
 78 | stack install
 79 | # or nix-env -if .
 80 | ```
 81 | 
 82 | ## Development
 83 | 
 84 | ### Run application
 85 | 
 86 | ```shell
 87 | stack run
 88 | ```
 89 | 
 90 | ### Run tests
 91 | 
 92 | ```shell
 93 | stack test --file-watch
 94 | ```
 95 | 
 96 | ### Build statically linked
 97 | 
 98 | ```shell
 99 | stack install --flag git-brunch:static
100 | ```
101 | 
102 | ### Generate nix
103 | 
104 | ```sh
105 | cabal2nix --shell . > default.nix
106 | ```
107 | 
108 | ## Release
109 | 
110 | - Bump version in `package.yaml` and `default.nix`
111 | - `stack build`
112 | - Create a commit `v0.0.0`
113 | - Create a tag `v0.0.0`
114 | - Push commit and push tag
115 | - Release on github will be created by CI
116 | - Update release description
117 | - `stack upload .`
118 | - Update [AUR](https://aur.archlinux.org/cgit/aur.git/tree/PKGBUILD?h=git-brunch#n3)
119 | 
120 | ## Related projects
121 | 
122 | - [`git-gone`](https://github.com/lunaryorn/git-gone): Lists or removes "gone" branches, that is, local branches which used to have an upstream branch on a remote which is now removed.
123 | - [`lazygit`](https://github.com/jesseduffield/lazygit): Terminal UI for git commands
124 | - [`gitui`](https://github.com/extrawurst/gitui): Terminal UI focused on speed in giant repositories
125 | 


--------------------------------------------------------------------------------
/app/Git.hs:
--------------------------------------------------------------------------------
  1 | module Git (
  2 |   Branch (..),
  3 |   checkout,
  4 |   deleteBranch,
  5 |   fetch,
  6 |   fullBranchName,
  7 |   isCommonBranch,
  8 |   isRemoteBranch,
  9 |   listBranches,
 10 |   rebaseInteractive,
 11 |   merge,
 12 |   toBranches,
 13 | ) where
 14 | 
 15 | import Data.Char (isSpace)
 16 | import Data.Text (Text)
 17 | import Data.Text qualified as T
 18 | import Data.Text.IO qualified as T
 19 | import System.Exit
 20 | import System.Process
 21 | 
 22 | data Branch
 23 |   = BranchLocal Text
 24 |   | BranchCurrent Text
 25 |   | BranchRemote Text Text
 26 |   deriving (Eq)
 27 | 
 28 | instance Show Branch where
 29 |   show (BranchLocal n) = T.unpack n
 30 |   show (BranchCurrent n) = T.unpack $ n <> "*"
 31 |   show (BranchRemote o n) = T.unpack $ o <> "/" <> n
 32 | 
 33 | fetch :: IO Text
 34 | fetch = readGit ["fetch", "--all", "--prune"]
 35 | 
 36 | listBranches :: IO [Branch]
 37 | listBranches =
 38 |   toBranches
 39 |     <$> readGit
 40 |       [ "branch"
 41 |       , "--list"
 42 |       , "--all"
 43 |       , "--sort=-committerdate"
 44 |       , "--no-column"
 45 |       , "--no-color"
 46 |       ]
 47 | 
 48 | toBranches :: Text -> [Branch]
 49 | toBranches input = toBranch <$> filter validBranch (T.lines input)
 50 |  where
 51 |   validBranch b = not $ isHead b || isDetachedHead b || isNoBranch b
 52 | 
 53 | toBranch :: Text -> Branch
 54 | toBranch line = mkBranch $ T.words $ T.dropWhile isSpace line
 55 |  where
 56 |   mkBranch ("*" : name : _) = BranchCurrent name
 57 |   mkBranch (name : _) = case T.stripPrefix "remotes/" name of
 58 |     Just rest -> parseRemoteBranch rest
 59 |     Nothing -> BranchLocal name
 60 |   mkBranch [] = error "empty branch name"
 61 |   parseRemoteBranch str = BranchRemote remote name
 62 |    where
 63 |     (remote, rest) = T.span ('/' /=) str
 64 |     name = T.drop 1 rest
 65 | 
 66 | checkout :: Branch -> IO ExitCode
 67 | checkout branch = spawnGit ["checkout", branchName branch]
 68 | 
 69 | rebaseInteractive :: Branch -> IO ExitCode
 70 | rebaseInteractive branch = do
 71 |   T.putStrLn $ "Rebase onto " <> fullBranchName branch
 72 |   spawnGit ["rebase", "--interactive", "--autostash", fullBranchName branch]
 73 | 
 74 | merge :: Branch -> IO ExitCode
 75 | merge branch = do
 76 |   T.putStrLn $ "Merge branch " <> fullBranchName branch
 77 |   spawnGit ["merge", fullBranchName branch]
 78 | 
 79 | deleteBranch :: Branch -> IO ExitCode
 80 | deleteBranch (BranchCurrent _) = error "Cannot delete current branch"
 81 | deleteBranch (BranchLocal n) = spawnGit ["branch", "-D", n]
 82 | deleteBranch (BranchRemote o n) = spawnGit ["push", o, "--delete", n]
 83 | 
 84 | spawnGit :: [Text] -> IO ExitCode
 85 | spawnGit args = waitForProcess =<< spawnProcess "git" (T.unpack <$> args)
 86 | 
 87 | readGit :: [Text] -> IO Text
 88 | readGit args = T.pack <$> readProcess "git" (T.unpack <$> args) []
 89 | 
 90 | isCommonBranch :: Branch -> Bool
 91 | isCommonBranch b = branchName b `elem` commonBranchNames
 92 |  where
 93 |   commonBranchNames =
 94 |     [ "master"
 95 |     , "main"
 96 |     , "dev"
 97 |     , "devel"
 98 |     , "develop"
 99 |     , "development"
100 |     , "staging"
101 |     , "trunk"
102 |     ]
103 | 
104 | isRemoteBranch :: Branch -> Bool
105 | isRemoteBranch (BranchRemote _ _) = True
106 | isRemoteBranch _ = False
107 | 
108 | --- Helper
109 | 
110 | branchName :: Branch -> Text
111 | branchName (BranchCurrent n) = n
112 | branchName (BranchLocal n) = n
113 | branchName (BranchRemote _ n) = n
114 | 
115 | fullBranchName :: Branch -> Text
116 | fullBranchName (BranchCurrent n) = n
117 | fullBranchName (BranchLocal n) = n
118 | fullBranchName (BranchRemote r n) = r <> "/" <> n
119 | 
120 | isHead :: Text -> Bool
121 | isHead = T.isInfixOf "HEAD"
122 | 
123 | isDetachedHead :: Text -> Bool
124 | isDetachedHead = T.isInfixOf "HEAD detached"
125 | 
126 | -- While rebasing git will show "no branch"
127 | -- e.g. "* (no branch, rebasing branch-name)"
128 | isNoBranch :: Text -> Bool
129 | isNoBranch = T.isInfixOf "(no branch,"
130 | 


--------------------------------------------------------------------------------
/app/GitBrunch.hs:
--------------------------------------------------------------------------------
  1 | module GitBrunch (main) where
  2 | 
  3 | import Brick.Main (halt)
  4 | import Brick.Main qualified as M
  5 | import Brick.Themes (themeToAttrMap)
  6 | import Brick.Types
  7 | import Brick.Widgets.Border qualified as B
  8 | import Brick.Widgets.Border.Style qualified as BS
  9 | import Brick.Widgets.Center qualified as C
 10 | import Brick.Widgets.Core
 11 | import Brick.Widgets.Dialog qualified as D
 12 | import Brick.Widgets.Edit qualified as E
 13 | import Brick.Widgets.List qualified as L
 14 | import Control.Exception (SomeException, catch)
 15 | import Control.Monad
 16 | import Control.Monad.Extra (ifM, unlessM)
 17 | import Data.Char
 18 | import Data.List
 19 | import Data.Maybe (fromMaybe, isJust)
 20 | import Data.Text (Text)
 21 | import Data.Text qualified as T
 22 | import Data.Text.IO qualified as T
 23 | import Data.Vector qualified as Vec
 24 | import Graphics.Vty hiding (update)
 25 | import Lens.Micro (Lens', lens, (%~), (&), (.~), (^.), _Just)
 26 | import Lens.Micro.Mtl ((%=), (.=), (?=))
 27 | import System.Exit
 28 | 
 29 | import Git (Branch (..))
 30 | import Git qualified
 31 | import Theme
 32 | 
 33 | data Name
 34 |   = Local
 35 |   | Remote
 36 |   | Filter
 37 |   | DialogConfirm
 38 |   | DialogCancel
 39 |   deriving (Ord, Eq, Show)
 40 | 
 41 | data RemoteName
 42 |   = RLocal
 43 |   | RRemote
 44 |   deriving (Eq)
 45 | 
 46 | data GitCommand
 47 |   = GitRebase
 48 |   | GitMerge
 49 |   | GitCheckout
 50 |   | GitDeleteBranch
 51 |   deriving (Ord, Eq)
 52 | 
 53 | data DialogOption
 54 |   = Cancel
 55 |   | Confirm GitCommand
 56 | 
 57 | data State = State
 58 |   { _focus :: RemoteName
 59 |   , _gitCommand :: GitCommand
 60 |   , _branches :: [Branch]
 61 |   , _localBranches :: L.List Name Branch
 62 |   , _remoteBranches :: L.List Name Branch
 63 |   , _dialog :: Maybe (D.Dialog DialogOption Name)
 64 |   , _filter :: E.Editor Text Name
 65 |   , _isEditingFilter :: Bool
 66 |   }
 67 | 
 68 | instance Show GitCommand where
 69 |   show GitCheckout = "checkout"
 70 |   show GitRebase = "rebase"
 71 |   show GitMerge = "merge"
 72 |   show GitDeleteBranch = "delete"
 73 | 
 74 | main :: IO ()
 75 | main = do
 76 |   branches <- Git.listBranches `catch` gitFailed
 77 |   state <- M.defaultMain app $ syncBranchLists emptyState{_branches = branches}
 78 |   let execGit = gitFunction (_gitCommand state)
 79 |   exitCode <- maybe noBranchErr execGit (selectedBranch state)
 80 |   when (exitCode /= ExitSuccess)
 81 |     $ die ("Failed to " ++ show (_gitCommand state) ++ ".")
 82 |  where
 83 |   gitFailed :: SomeException -> IO a
 84 |   gitFailed _ = exitFailure
 85 |   noBranchErr = die "No branch selected."
 86 |   gitFunction = \case
 87 |     GitCheckout -> Git.checkout
 88 |     GitRebase -> Git.rebaseInteractive
 89 |     GitMerge -> Git.merge
 90 |     GitDeleteBranch -> Git.deleteBranch
 91 | 
 92 | emptyState :: State
 93 | emptyState =
 94 |   State
 95 |     { _focus = RLocal
 96 |     , _gitCommand = GitCheckout
 97 |     , _branches = []
 98 |     , _localBranches = mkList Local
 99 |     , _remoteBranches = mkList Remote
100 |     , _dialog = Nothing
101 |     , _filter = emptyFilter
102 |     , _isEditingFilter = False
103 |     }
104 |  where
105 |   mkList focus = L.list focus Vec.empty rowHeight
106 | 
107 | emptyFilter :: E.Editor Text Name
108 | emptyFilter = E.editor Filter Nothing ""
109 | 
110 | app :: M.App State e Name
111 | app =
112 |   M.App
113 |     { M.appDraw = drawApp
114 |     , M.appChooseCursor = M.showFirstCursor
115 |     , M.appHandleEvent = appHandleEvent
116 |     , M.appStartEvent = pure ()
117 |     , M.appAttrMap = const $ themeToAttrMap theme
118 |     }
119 | 
120 | drawApp :: State -> [Widget Name]
121 | drawApp state =
122 |   drawDialog state : [C.vCenter $ padAll 1 $ maxWidth 200 $ vBox content]
123 |  where
124 |   content = [branchLists, filterEdit, padding, instructions]
125 |   padding = str " "
126 |   maxWidth w = C.hCenter . hLimit w
127 |   toBranchList r lens' =
128 |     let isActive = state ^. focusL == r && not (_isEditingFilter state)
129 |      in state ^. lens' & drawBranchList isActive
130 |   filterEdit = if _isEditingFilter state then drawFilter state else emptyWidget
131 |   branchLists =
132 |     hBox
133 |       [ C.hCenter $ toBranchList RLocal localBranchesL
134 |       , str " "
135 |       , C.hCenter $ toBranchList RRemote remoteBranchesL
136 |       ]
137 |   instructions =
138 |     maxWidth 100
139 |       $ hBox
140 |         [ drawInstruction "Enter" "checkout"
141 |         , drawInstruction "/" "filter"
142 |         , drawInstruction "F" "fetch"
143 |         , drawInstruction "R" "rebase"
144 |         , drawInstruction "M" "merge"
145 |         , drawInstruction "D" "delete"
146 |         ]
147 | 
148 | drawFilter :: State -> Widget Name
149 | drawFilter state =
150 |   withBorderStyle BS.unicodeBold $ B.border $ vLimit 1 $ label <+> editor
151 |  where
152 |   editor = E.renderEditor (txt . T.unlines) True (state ^. filterL)
153 |   label = str " Filter: "
154 | 
155 | drawDialog :: State -> Widget Name
156 | drawDialog state = case _dialog state of
157 |   Nothing -> emptyWidget
158 |   Just dialog -> D.renderDialog dialog $ C.hCenter $ padAll 1 content
159 |    where
160 |     branch = maybe "" show $ selectedBranch state
161 |     action = show (_gitCommand state)
162 |     content =
163 |       str "Really "
164 |         <+> withAttr attrUnder (str action)
165 |         <+> str " branch "
166 |         <+> withAttr attrBold (str branch)
167 |         <+> str "?"
168 | 
169 | drawBranchList :: Bool -> L.List Name Branch -> Widget Name
170 | drawBranchList hasFocus list =
171 |   withBorderStyle BS.unicodeBold
172 |     $ B.borderWithLabel (drawTitle list)
173 |     $ L.renderList drawListElement hasFocus list
174 |  where
175 |   attr = withAttr $ if hasFocus then attrTitleFocus else attrTitle
176 |   drawTitle = attr . str . map toUpper . show . L.listName
177 | 
178 | drawListElement :: Bool -> Branch -> Widget Name
179 | drawListElement isListFocussed branch =
180 |   maxPadding $ highlight branch $ str $ " " <> show branch
181 |  where
182 |   maxPadding = if isListFocussed then padRight Max else id
183 |   highlight (BranchCurrent _) = withAttr attrBranchCurrent
184 |   highlight b | Git.isCommonBranch b = withAttr attrBranchCommon
185 |   highlight _ = id
186 | 
187 | drawInstruction :: Text -> Text -> Widget n
188 | drawInstruction keys action =
189 |   withAttr attrKey (txt keys)
190 |     <+> txt " to "
191 |     <+> withAttr attrBold (txt action)
192 |     & C.hCenter
193 | 
194 | appHandleEvent :: BrickEvent Name e -> EventM Name State ()
195 | appHandleEvent (VtyEvent e)
196 |   | isQuitEvent e = quit
197 |   | otherwise = do
198 |       dialog <- gets _dialog
199 |       if isJust dialog
200 |         then appHandleEventDialog e
201 |         else appHandleEventMain e
202 |  where
203 |   isQuitEvent (EvKey (KChar 'c') [MCtrl]) = True
204 |   isQuitEvent (EvKey (KChar 'd') [MCtrl]) = True
205 |   isQuitEvent _ = False
206 | appHandleEvent _ = pure ()
207 | 
208 | appHandleEventMain :: Event -> EventM Name State ()
209 | appHandleEventMain e =
210 |   let
211 |     event = lowerKey e
212 |     endWithCheckout = gitCommandL .= GitCheckout >> halt
213 |     endWithRebase = gitCommandL .= GitRebase >> halt
214 |     endWithMerge = gitCommandL .= GitMerge >> halt
215 |     resetFilter = filterL .~ emptyFilter
216 |     showFilter = isEditingFilterL .~ True
217 |     hideFilter = isEditingFilterL .~ False
218 |     startEditingFilter = modify (showFilter . resetFilter)
219 |     cancelEditingFilter = modify (hideFilter . resetFilter)
220 |     stopEditingFilter = modify hideFilter
221 | 
222 |     confirmDelete :: Maybe Branch -> EventM Name State ()
223 |     confirmDelete (Just (BranchCurrent _)) = pure ()
224 |     confirmDelete (Just _) = dialogL ?= createDialog GitDeleteBranch
225 |     confirmDelete Nothing = pure ()
226 | 
227 |     fetch = do
228 |       state <- get
229 |       M.suspendAndResume $ do
230 |         branches <- fetchBranches
231 |         pure $ updateBranches branches state
232 | 
233 |     handleDefault :: EventM Name State ()
234 |     handleDefault = case event of
235 |       EvKey KEsc [] -> quit
236 |       EvKey (KChar 'q') [] -> quit
237 |       EvKey (KChar '/') [] -> startEditingFilter
238 |       EvKey (KChar 'f') [MCtrl] -> startEditingFilter
239 |       EvKey (KChar 'd') [] -> confirmDelete =<< gets selectedBranch
240 |       EvKey KEnter [] -> endWithCheckout
241 |       EvKey (KChar 'c') [] -> endWithCheckout
242 |       EvKey (KChar 'r') [] -> endWithRebase
243 |       EvKey (KChar 'm') [] -> endWithMerge
244 |       EvKey KLeft [] -> focusBranches RLocal
245 |       EvKey (KChar 'h') [] -> focusBranches RLocal
246 |       EvKey KRight [] -> focusBranches RRemote
247 |       EvKey (KChar 'l') [] -> focusBranches RRemote
248 |       EvKey (KChar 'f') [] -> fetch
249 |       _ -> zoom focussedBranchesL $ L.handleListEventVi L.handleListEvent e
250 | 
251 |     handleEditingFilter :: EventM Name State ()
252 |     handleEditingFilter = do
253 |       case event of
254 |         EvKey KEsc [] -> cancelEditingFilter
255 |         EvKey KEnter [] -> stopEditingFilter
256 |         EvKey KUp [] -> stopEditingFilter
257 |         EvKey KDown [] -> stopEditingFilter
258 |         _ -> zoom filterL $ E.handleEditorEvent (VtyEvent e)
259 |       modify syncBranchLists
260 |    in
261 |     ifM
262 |       (gets _isEditingFilter)
263 |       handleEditingFilter
264 |       handleDefault
265 | 
266 | appHandleEventDialog :: Event -> EventM Name State ()
267 | appHandleEventDialog e =
268 |   let
269 |     cancelDialog = do
270 |       dialogL .= Nothing
271 |       gitCommandL .= GitCheckout
272 | 
273 |     confirmDialog cmd = do
274 |       dialogL .= Nothing
275 |       gitCommandL .= cmd
276 |       halt
277 |    in
278 |     case vimifiedKey e of
279 |       EvKey KEnter [] -> do
280 |         dialog <- gets _dialog
281 |         case D.dialogSelection =<< dialog of
282 |           Just (DialogConfirm, Confirm cmd) -> confirmDialog cmd
283 |           Just (DialogCancel, Cancel) -> cancelDialog
284 |           _ -> pure ()
285 |       EvKey KEsc [] -> cancelDialog
286 |       EvKey (KChar 'q') [] -> cancelDialog
287 |       ev -> zoom (dialogL . _Just) $ D.handleDialogEvent ev
288 | 
289 | quit :: EventM n State ()
290 | quit = focussedBranchesL %= L.listClear >> halt
291 | 
292 | focusBranches :: RemoteName -> EventM Name State ()
293 | focusBranches target = do
294 |   let isAlreadyFocussed = (target ==) <$> gets _focus
295 |   unlessM isAlreadyFocussed $ do
296 |     offsetDiff <- listOffsetDiff target
297 |     modify (changeList . syncPosition offsetDiff)
298 |  where
299 |   changeList = focusL .~ target
300 |   listIndex state = fromMaybe 0 $ state ^. currentListL . L.listSelectedL
301 |   syncPosition diff state = (targetListL %~ L.listMoveTo (listIndex state - diff)) state
302 |   (currentListL, targetListL) = case target of
303 |     RLocal -> (remoteBranchesL, localBranchesL)
304 |     RRemote -> (localBranchesL, remoteBranchesL)
305 | 
306 | listOffsetDiff :: RemoteName -> EventM Name State Int
307 | listOffsetDiff target = do
308 |   offLocal <- getOffset Local
309 |   offRemote <- getOffset Remote
310 |   pure
311 |     $ if target == RLocal
312 |       then offRemote - offLocal
313 |       else offLocal - offRemote
314 |  where
315 |   getOffset name = maybe 0 (^. vpTop) <$> M.lookupViewport name
316 | 
317 | fetchBranches :: IO [Branch]
318 | fetchBranches = do
319 |   T.putStrLn "Fetching branches"
320 |   output <- Git.fetch
321 |   T.putStr output
322 |   Git.listBranches
323 | 
324 | updateBranches :: [Branch] -> State -> State
325 | updateBranches branches =
326 |   syncBranchLists
327 |     . (branchesL .~ branches)
328 |     . (filterL .~ emptyFilter)
329 | 
330 | syncBranchLists :: State -> State
331 | syncBranchLists state =
332 |   state
333 |     & localBranchesL
334 |     .~ mkList Local local
335 |     & remoteBranchesL
336 |     .~ mkList Remote remote
337 |     & focusL
338 |     %~ toggleFocus (local, remote)
339 |  where
340 |   mkList name xs = L.list name (Vec.fromList xs) rowHeight
341 |   filterText = T.toLower $ T.unwords $ E.getEditContents $ _filter state
342 |   isBranchInFilter = T.isInfixOf filterText . Git.fullBranchName
343 |   filteredBranches = filter isBranchInFilter (_branches state)
344 |   (remote, local) = partition Git.isRemoteBranch filteredBranches
345 | 
346 | toggleFocus :: ([Branch], [Branch]) -> RemoteName -> RemoteName
347 | toggleFocus ([], _ : _) RLocal = RRemote
348 | toggleFocus (_ : _, []) RRemote = RLocal
349 | toggleFocus _ x = x
350 | 
351 | selectedBranch :: State -> Maybe Branch
352 | selectedBranch state =
353 |   snd <$> L.listSelectedElement (state ^. focussedBranchesL)
354 | 
355 | createDialog :: GitCommand -> D.Dialog DialogOption Name
356 | createDialog cmd = D.dialog (Just $ str title) (Just (DialogConfirm, choices)) 80
357 |  where
358 |   title = map toUpper $ show cmd
359 |   btnText (x : xs) = toUpper x : xs
360 |   btnText x = x
361 |   choices =
362 |     [ (btnText $ show cmd, DialogConfirm, Confirm cmd)
363 |     , ("Cancel", DialogCancel, Cancel)
364 |     ]
365 | 
366 | mapKey :: (Char -> Key) -> Event -> Event
367 | mapKey f (EvKey (KChar k) []) = EvKey (f k) []
368 | mapKey _ e = e
369 | 
370 | lowerKey :: Event -> Event
371 | lowerKey = mapKey (KChar . toLower)
372 | 
373 | vimifiedKey :: Event -> Event
374 | vimifiedKey = mapKey vimify . lowerKey
375 |  where
376 |   vimify 'h' = KLeft
377 |   vimify 'j' = KRight
378 |   vimify 'k' = KLeft
379 |   vimify 'l' = KRight
380 |   vimify k = KChar k
381 | 
382 | rowHeight :: Int
383 | rowHeight = 1
384 | 
385 | -- Lens
386 | 
387 | focussedBranchesL :: Lens' State (L.List Name Branch)
388 | focussedBranchesL =
389 |   lens (\s -> s ^. branchLens s) (\s bs -> (branchLens s .~ bs) s)
390 |  where
391 |   branchLens s = case s ^. focusL of
392 |     RLocal -> localBranchesL
393 |     RRemote -> remoteBranchesL
394 | 
395 | localBranchesL :: Lens' State (L.List Name Branch)
396 | localBranchesL = lens _localBranches (\s bs -> s{_localBranches = bs})
397 | 
398 | remoteBranchesL :: Lens' State (L.List Name Branch)
399 | remoteBranchesL = lens _remoteBranches (\s bs -> s{_remoteBranches = bs})
400 | 
401 | focusL :: Lens' State RemoteName
402 | focusL = lens _focus (\s f -> s{_focus = f})
403 | 
404 | filterL :: Lens' State (E.Editor Text Name)
405 | filterL = lens _filter (\s f -> s{_filter = f})
406 | 
407 | branchesL :: Lens' State [Branch]
408 | branchesL = lens _branches (\s f -> s{_branches = f})
409 | 
410 | isEditingFilterL :: Lens' State Bool
411 | isEditingFilterL = lens _isEditingFilter (\s f -> s{_isEditingFilter = f})
412 | 
413 | dialogL :: Lens' State (Maybe (D.Dialog DialogOption Name))
414 | dialogL = lens _dialog (\s v -> s{_dialog = v})
415 | 
416 | gitCommandL :: Lens' State GitCommand
417 | gitCommandL = lens _gitCommand (\s v -> s{_gitCommand = v})
418 | 


--------------------------------------------------------------------------------