diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -# git-brunch [![Build Status](https://travis-ci.org/andys8/git-brunch.svg?branch=master)](https://travis-ci.org/andys8/git-brunch) +# git-brunch [![Travis](https://travis-ci.org/andys8/git-brunch.svg?branch=master)](https://travis-ci.org/andys8/git-brunch) ![Actions](https://github.com/andys8/git-brunch/workflows/CI/badge.svg) A git checkout and rebase command-line tool @@ -33,7 +33,7 @@ #### Install ```sh -stack install git-brunch # --resolver=lts-14.16 +stack install git-brunch # --resolver=lts-16.8 ``` #### Clone and install from source @@ -65,7 +65,7 @@ ### Run application ```shell -stack build --exec git-brunch +stack run ``` ### Run tests diff --git a/app/Git.hs b/app/Git.hs --- a/app/Git.hs +++ b/app/Git.hs @@ -1,15 +1,18 @@ module Git - ( listBranches + ( Branch(..) , checkout + , deleteBranch , fetch + , fullBranchName + , isCommonBranch + , isRemoteBranch + , listBranches , rebaseInteractive , toBranches - , deleteBranch - , Branch(..) ) where -import Data.Char ( isSpace ) +import Data.Char ( isSpace ) import Data.List import System.Exit import System.Process @@ -25,35 +28,32 @@ show (BranchCurrent n ) = n <> "*" show (BranchRemote o n) = o <> "/" <> n +fetch :: IO String +fetch = readGit ["fetch", "--all", "--prune"] listBranches :: IO [Branch] -listBranches = toBranches <$> execGitBranch - where - execGitBranch = readProcess - "git" - [ "branch" - , "--list" - , "--all" - , "--sort=-committerdate" - , "--no-column" - , "--no-color" - ] - [] - -fetch :: IO String -fetch = readProcess "git" ["fetch", "--all", "--prune"] [] +listBranches = toBranches <$> readGit + [ "branch" + , "--list" + , "--all" + , "--sort=-committerdate" + , "--no-column" + , "--no-color" + ] toBranches :: String -> [Branch] toBranches input = toBranch <$> filter (not . isHead) (lines input) toBranch :: String -> Branch -toBranch line = toBranch' $ words $ dropWhile isSpace line +toBranch line = mkBranch $ words $ dropWhile isSpace line where - toBranch' ("*" : name : _) = BranchCurrent name - toBranch' (name : _) = case stripPrefix "remotes/" name of + mkBranch ("*" : name : _) = BranchCurrent name + mkBranch (name : _) = case stripPrefix "remotes/" name of Just rest -> parseRemoteBranch rest Nothing -> BranchLocal name - toBranch' [] = error "empty branch name" + mkBranch [] = error "empty branch name" + parseRemoteBranch str = BranchRemote remote name + where (remote, _ : name) = span ('/' /=) str checkout :: Branch -> IO ExitCode checkout branch = spawnGit ["checkout", branchName branch] @@ -71,10 +71,26 @@ spawnGit :: [String] -> IO ExitCode spawnGit args = waitForProcess =<< spawnProcess "git" args -parseRemoteBranch :: String -> Branch -parseRemoteBranch str = BranchRemote remote name - where (remote, _ : name) = span ('/' /=) str +readGit :: [String] -> IO String +readGit args = readProcess "git" args [] +isCommonBranch :: Branch -> Bool +isCommonBranch b = + branchName b + `elem` [ "master" + , "main" + , "dev" + , "devel" + , "develop" + , "development" + , "staging" + , "trunk" + ] + + +isRemoteBranch :: Branch -> Bool +isRemoteBranch (BranchRemote _ _) = True +isRemoteBranch _ = False --- Helper diff --git a/app/GitBrunch.hs b/app/GitBrunch.hs --- a/app/GitBrunch.hs +++ b/app/GitBrunch.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} module GitBrunch ( main ) @@ -13,6 +12,9 @@ import Brick.Themes ( themeToAttrMap ) import Brick.Types import Brick.Widgets.Core +import Control.Exception ( SomeException + , catch + ) import Control.Monad import Data.Char import Data.List @@ -20,10 +22,10 @@ import Graphics.Vty hiding ( update ) import Lens.Micro ( (^.) , (.~) + , (%~) , (&) , Lens' , lens - , over ) import System.Exit import qualified Brick.Main as M @@ -31,55 +33,77 @@ import qualified Brick.Widgets.Border.Style as BS import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Dialog as D +import qualified Brick.Widgets.Edit as E import qualified Brick.Widgets.List as L import qualified Data.Vector as Vec -import Git +import Git ( Branch(..) ) import Theme +import qualified Git -data Name = Local | Remote deriving (Ord, Eq, Show) -data GitCommand = GitRebase | GitCheckout | GitDeleteBranch deriving (Ord, Eq) - +data Name = Local | Remote | Filter deriving (Ord, Eq, Show) +data RemoteName = RLocal | RRemote deriving (Eq) +data GitCommand = GitRebase | GitCheckout | GitDeleteBranch deriving (Ord, Eq) +data DialogResult = SetDialog Dialog | EndDialog DialogOption data DialogOption = Cancel | Confirm -data DialogResult = SetDialog (D.Dialog DialogOption) - | EndDialog DialogOption +type Dialog = D.Dialog DialogOption data State = State - { _focus :: Name + { _focus :: RemoteName , _gitCommand :: GitCommand + , _branches :: [Branch] , _localBranches :: L.List Name Branch , _remoteBranches :: L.List Name Branch - , _dialog :: Maybe (D.Dialog DialogOption) + , _dialog :: Maybe Dialog + , _filter :: E.Editor String Name + , _isEditingFilter :: Bool } + instance (Show GitCommand) where show GitCheckout = "checkout" show GitRebase = "rebase" show GitDeleteBranch = "delete" -main :: IO a + +main :: IO () main = do - branches <- Git.listBranches - state <- M.defaultMain app $ setBranches branches initialState - let gitCommand = _gitCommand state - let branch = selectedBranch state - let runGit = \case - GitCheckout -> Git.checkout - GitRebase -> Git.rebaseInteractive - GitDeleteBranch -> Git.deleteBranch - exitCode <- maybe (die "No branch selected.") (runGit gitCommand) branch - when (exitCode /= ExitSuccess) $ die ("Failed to " ++ show gitCommand ++ ".") - exitWith exitCode + branches <- Git.listBranches `catch` gitFailed + state <- M.defaultMain app $ updateLists emptyState { _branches = branches } + let execGit = gitFunction (_gitCommand state) + exitCode <- maybe noBranchErr execGit (selectedBranch state) + when (exitCode /= ExitSuccess) + $ die ("Failed to " ++ show (_gitCommand state) ++ ".") + where + gitFailed :: SomeException -> IO a + gitFailed _ = exitFailure + noBranchErr = die "No branch selected." + gitFunction = \case + GitCheckout -> Git.checkout + GitRebase -> Git.rebaseInteractive + GitDeleteBranch -> Git.deleteBranch -initialState :: State -initialState = State Local GitCheckout (toList Local) (toList Remote) Nothing - where toList n = L.list n Vec.empty 1 +emptyState :: State +emptyState = + let mkList focus = L.list focus Vec.empty rowHeight + in State { _focus = RLocal + , _gitCommand = GitCheckout + , _branches = [] + , _localBranches = mkList Local + , _remoteBranches = mkList Remote + , _dialog = Nothing + , _filter = emptyFilter + , _isEditingFilter = False + } +emptyFilter :: E.Editor String Name +emptyFilter = E.editor Filter Nothing "" + app :: M.App State e Name app = M.App { M.appDraw = appDraw , M.appChooseCursor = M.showFirstCursor - , M.appHandleEvent = appHandleEvent + , M.appHandleEvent = appHandleWithQuit , M.appStartEvent = return , M.appAttrMap = const $ themeToAttrMap theme } @@ -88,25 +112,39 @@ appDraw state = drawDialog state : [ C.vCenter $ padAll 1 $ vBox - [ hBox - [ C.hCenter $ toBranchList localBranchesL - , C.hCenter $ toBranchList remoteBranchesL - ] - , str " " - , instructions - ] + (maxWidth 200 <$> [branchLists, filterEdit, padding, instructions]) ] where - toBranchList lens' = state ^. lens' & (\l -> drawBranchList (hasFocus l) l) - hasFocus = (_focus state ==) . L.listName - instructions = C.hCenter $ hLimit 100 $ hBox - [ drawInstruction "HJKL" "navigate" + padding = str " " + maxWidth w = C.hCenter . hLimit w + toBranchList r lens' = state ^. lens' & drawBranchList (state ^. focusL == r) + filterEdit = if _isEditingFilter state then drawFilter state else emptyWidget + branchLists = hBox + [ C.hCenter $ toBranchList RLocal localBranchesL + , str " " + , C.hCenter $ toBranchList RRemote remoteBranchesL + ] + instructions = maxWidth 100 $ hBox + [ drawInstruction "HJKL" "move" , drawInstruction "Enter" "checkout" - , drawInstruction "R" "rebase" + , drawInstruction "/" "filter" , drawInstruction "F" "fetch" + , drawInstruction "R" "rebase" , drawInstruction "D" "delete" ] +drawFilter :: State -> Widget Name +drawFilter state = + withBorderStyle BS.unicodeBold + $ B.border + $ padLeft (Pad 1) + $ vLimit 1 + $ label + <+> editor + where + editor = E.renderEditor (str . unlines) True (state ^. filterL) + label = str "Filter: " + drawDialog :: State -> Widget n drawDialog state = case _dialog state of Nothing -> emptyWidget @@ -116,36 +154,47 @@ action = show (_gitCommand state) content = str "Really " - <+> withAttr "under" (str action) + <+> withAttr attrUnder (str action) <+> str " branch " - <+> withAttr "bold" (str branch) + <+> withAttr attrBold (str branch) <+> str "?" drawBranchList :: Bool -> L.List Name Branch -> Widget Name drawBranchList hasFocus list = withBorderStyle BS.unicodeBold $ B.borderWithLabel (drawTitle list) - $ hLimit 80 $ L.renderList drawListElement hasFocus list where - title Local = map toUpper "local" - title Remote = map toUpper "remote" - drawTitle = withAttr "title" . str . title . L.listName + attr = withAttr $ if hasFocus then attrTitleFocus else attrTitle + drawTitle = attr . str . map toUpper . show . L.listName drawListElement :: Bool -> Branch -> Widget Name drawListElement _ branch = padLeft (Pad 1) $ padRight Max $ highlight branch $ str $ show branch where - highlight (BranchCurrent _) = withAttr "current" - highlight _ = id + highlight (BranchCurrent _) = withAttr attrBranchCurrent + highlight b | Git.isCommonBranch b = withAttr attrBranchCommon + highlight _ = id drawInstruction :: String -> String -> Widget n drawInstruction keys action = - withAttr "key" (str keys) + withAttr attrKey (str keys) <+> str " to " - <+> withAttr "bold" (str action) + <+> withAttr attrBold (str action) & C.hCenter +appHandleWithQuit :: State -> BrickEvent Name e -> EventM Name (Next State) +appHandleWithQuit state e = if isQuitEvent e + then quit state + else appHandleEvent state e + where + isQuitEvent (VtyEvent (EvKey (KChar 'c') [MCtrl])) = True + isQuitEvent (VtyEvent (EvKey (KChar 'd') [MCtrl])) = True + isQuitEvent _ = False + +quit :: State -> EventM Name (Next State) +quit state = halt $ focussedBranchesL %~ L.listClear $ state + appHandleEvent :: State -> BrickEvent Name e -> EventM Name (Next State) appHandleEvent state e = case _dialog state of Nothing -> appHandleEventMain state e @@ -156,92 +205,135 @@ toState (EndDialog Cancel) = continue $ state { _dialog = Nothing, _gitCommand = GitCheckout } -appHandleEventMain :: State -> BrickEvent Name e -> EventM Name (Next State) -appHandleEventMain state (VtyEvent e) = - let confirm c = state { _gitCommand = c, _dialog = Just $ createDialog c } - confirmDelete (Just (BranchCurrent _)) = continue state - confirmDelete _ = continue $ confirm GitDeleteBranch - deleteSelection = focussedBranchesL `over` L.listClear - endWithCheckout = halt $ state { _gitCommand = GitCheckout } - endWithRebase = halt $ state { _gitCommand = GitRebase } - focusLocal = continue $ focusBranches Local state - focusRemote = continue $ focusBranches Remote state - quit = halt $ deleteSelection state - updateBranches = suspendAndResume (updateBranchList state) - in case lowerKey e of - EvKey (KChar 'c') [MCtrl] -> quit - EvKey (KChar 'd') [MCtrl] -> quit - EvKey KEsc [] -> quit - EvKey (KChar 'q') [] -> quit - EvKey (KChar 'd') [] -> confirmDelete (selectedBranch state) - EvKey KEnter [] -> endWithCheckout - EvKey (KChar 'r') [] -> endWithRebase - EvKey KLeft [] -> focusLocal - EvKey (KChar 'h') [] -> focusLocal - EvKey KRight [] -> focusRemote - EvKey (KChar 'l') [] -> focusRemote - EvKey (KChar 'f') [] -> updateBranches - event -> navigate state event -appHandleEventMain state _ = continue state - -appHandleEventDialog - :: D.Dialog DialogOption -> BrickEvent Name e -> EventM Name DialogResult +appHandleEventDialog :: Dialog -> BrickEvent Name e -> EventM Name DialogResult appHandleEventDialog dialog (VtyEvent e) = - let quit = pure $ EndDialog Cancel - closeDialog = pure $ EndDialog Cancel + let closeDialog = pure $ EndDialog Cancel dialogAction = pure $ case D.dialogSelection dialog of Just Cancel -> EndDialog Cancel Just confirm -> EndDialog confirm Nothing -> SetDialog dialog in case vimKey $ lowerKey e of - EvKey KEnter [] -> dialogAction - EvKey (KChar 'c') [MCtrl] -> quit - EvKey (KChar 'd') [MCtrl] -> quit - EvKey KEsc [] -> closeDialog - EvKey (KChar 'q') [] -> closeDialog - ev -> SetDialog <$> D.handleDialogEvent ev dialog + EvKey KEnter [] -> dialogAction + EvKey KEsc [] -> closeDialog + EvKey (KChar 'q') [] -> closeDialog + ev -> SetDialog <$> D.handleDialogEvent ev dialog appHandleEventDialog dialog _ = pure $ SetDialog dialog +appHandleEventMain :: State -> BrickEvent Name e -> EventM Name (Next State) +appHandleEventMain state (VtyEvent e) = + let + confirm c = state { _gitCommand = c, _dialog = Just $ createDialog c } + confirmDelete (Just (BranchCurrent _)) = continue state + confirmDelete (Just _ ) = continue $ confirm GitDeleteBranch + confirmDelete Nothing = continue state + endWithCheckout = halt $ state { _gitCommand = GitCheckout } + endWithRebase = halt $ state { _gitCommand = GitRebase } + focusLocal = focusBranches RLocal state + focusRemote = focusBranches RRemote state + doFetch = suspendAndResume (fetchBranches state) + resetFilter = filterL .~ emptyFilter + showFilter = isEditingFilterL .~ True + hideFilter = isEditingFilterL .~ False + startEditingFilter = + continue $ updateLists $ resetFilter $ showFilter state + cancelEditingFilter = continue $ hideFilter $ resetFilter state + stopEditingFilter = continue $ hideFilter state + handle = if _isEditingFilter state + then fmap (updateLists <$>) . handleEditingFilter + else handleDefault + handleDefault = \case + EvKey KEsc [] -> quit state + EvKey (KChar 'q') [] -> quit state + EvKey (KChar '/') [] -> startEditingFilter + EvKey (KChar 'f') [MCtrl] -> startEditingFilter + EvKey (KChar 'd') [] -> confirmDelete (selectedBranch state) + EvKey KEnter [] -> endWithCheckout + EvKey (KChar 'r') [] -> endWithRebase + EvKey KLeft [] -> focusLocal + EvKey (KChar 'h') [] -> focusLocal + EvKey KRight [] -> focusRemote + EvKey (KChar 'l') [] -> focusRemote + EvKey (KChar 'f') [] -> doFetch + _ -> navigate state e + handleEditingFilter = \case + EvKey KEsc [] -> cancelEditingFilter + EvKey KEnter [] -> stopEditingFilter + EvKey KUp [] -> stopEditingFilter + EvKey KDown [] -> stopEditingFilter + _ -> handleFilter state e + in + handle $ lowerKey e + +appHandleEventMain state _ = continue state + + navigate :: State -> Event -> EventM Name (Next State) -navigate state event = do - let update = L.handleListEventVi L.handleListEvent - newState <- handleEventLensed state focussedBranchesL update event - continue newState +navigate state event = + continue =<< handleEventLensed state focussedBranchesL update event + where update = L.handleListEventVi L.handleListEvent -updateBranchList :: State -> IO State -updateBranchList state = do +handleFilter :: State -> Event -> EventM Name (Next State) +handleFilter state event = + continue =<< handleEventLensed state filterL E.handleEditorEvent event + +focusBranches :: RemoteName -> State -> EventM Name (Next State) +focusBranches target state = if isAlreadySelected + then continue state + else do + offsetDiff <- listOffsetDiff target + continue $ state & changeList & syncPosition offsetDiff + where + isAlreadySelected = state ^. focusL == target + changeList = focusL .~ target + listIndex = fromMaybe 0 $ state ^. currentListL . L.listSelectedL + syncPosition diff = targetListL %~ L.listMoveTo (listIndex - diff) + (currentListL, targetListL) = case target of + RLocal -> (remoteBranchesL, localBranchesL) + RRemote -> (localBranchesL, remoteBranchesL) + +listOffsetDiff :: RemoteName -> EventM Name Int +listOffsetDiff target = do + offLocal <- getOffset Local + offRemote <- getOffset Remote + return + $ if target == RLocal then offRemote - offLocal else offLocal - offRemote + where getOffset name = maybe 0 (^. vpTop) <$> M.lookupViewport name + +fetchBranches :: State -> IO State +fetchBranches state = do putStrLn "Fetching branches" - output <- fetch + output <- Git.fetch putStr output - branches <- listBranches - return $ setBranches branches state + branches <- Git.listBranches + return $ updateLists state { _branches = branches, _filter = emptyFilter } -focusBranches :: Name -> State -> State -focusBranches target state = if state ^. focusL == target - then state - else state & toL `over` L.listMoveTo selectedIndex & focusL .~ target +updateLists :: State -> State +updateLists state = + state + & localBranchesL + .~ mkList Local local + & remoteBranchesL + .~ mkList Remote remote + & focusL + %~ toggleFocus (local, remote) where - selectedIndex = fromMaybe 0 $ L.listSelected (state ^. fromL) - (fromL, toL) = case target of - Local -> (remoteBranchesL, localBranchesL) - Remote -> (localBranchesL, remoteBranchesL) + mkList name xs = L.list name (Vec.fromList xs) rowHeight + lower = map toLower + filterString = lower $ unwords $ E.getEditContents $ _filter state + isBranchInFilter = isInfixOf filterString . Git.fullBranchName + filteredBranches = filter isBranchInFilter (_branches state) + (remote, local) = partition Git.isRemoteBranch filteredBranches -setBranches :: [Branch] -> State -> State -setBranches branches state = newState - where - (remote, local) = partition isRemote branches - isRemote (BranchRemote _ _) = True - isRemote _ = False - toList n xs = L.list n (Vec.fromList xs) 1 - newState = state { _localBranches = toList Local local - , _remoteBranches = toList Remote remote - } +toggleFocus :: ([Branch], [Branch]) -> RemoteName -> RemoteName +toggleFocus ([] , _ : _) RLocal = RRemote +toggleFocus (_ : _, [] ) RRemote = RLocal +toggleFocus _ x = x selectedBranch :: State -> Maybe Branch selectedBranch state = snd <$> L.listSelectedElement (state ^. focussedBranchesL) -createDialog :: GitCommand -> D.Dialog DialogOption +createDialog :: GitCommand -> Dialog createDialog cmd = D.dialog (Just title) (Just (0, choices)) 80 where choices = [(btnText $ show cmd, Confirm), ("Cancel", Cancel)] @@ -265,14 +357,16 @@ vimify 'l' = KRight vimify k = KChar k +rowHeight :: Int +rowHeight = 1 -- Lens focussedBranchesL :: Lens' State (L.List Name Branch) focussedBranchesL = let branchLens s = case s ^. focusL of - Local -> localBranchesL - Remote -> remoteBranchesL + RLocal -> localBranchesL + RRemote -> remoteBranchesL in lens (\s -> s ^. branchLens s) (\s bs -> (branchLens s .~ bs) s) localBranchesL :: Lens' State (L.List Name Branch) @@ -281,6 +375,11 @@ remoteBranchesL :: Lens' State (L.List Name Branch) remoteBranchesL = lens _remoteBranches (\s bs -> s { _remoteBranches = bs }) -focusL :: Lens' State Name +focusL :: Lens' State RemoteName focusL = lens _focus (\s f -> s { _focus = f }) +filterL :: Lens' State (E.Editor String Name) +filterL = lens _filter (\s f -> s { _filter = f }) + +isEditingFilterL :: Lens' State Bool +isEditingFilterL = lens _isEditingFilter (\s f -> s { _isEditingFilter = f }) diff --git a/app/Theme.hs b/app/Theme.hs --- a/app/Theme.hs +++ b/app/Theme.hs @@ -1,16 +1,15 @@ -module Theme - ( theme - ) -where +module Theme where -import Brick.AttrMap ( attrName ) -import Brick.Themes ( Theme - , newTheme - ) +import Brick.AttrMap ( AttrName + , attrName + ) +import Brick.Themes import Brick.Util import Graphics.Vty import qualified Brick.Widgets.Dialog as Dialog import qualified Brick.Widgets.List as List +import Brick.Widgets.Border as Border +import qualified Brick.Widgets.Edit as Edit theme :: Theme theme = newTheme @@ -21,10 +20,29 @@ , (Dialog.dialogAttr , fg brightWhite) , (Dialog.buttonAttr , brightBlack `on` white) , (Dialog.buttonSelectedAttr , black `on` brightMagenta) - , (attrName "key" , withStyle (fg brightMagenta) bold) - , (attrName "bold" , withStyle (fg white) bold) - , (attrName "under" , withStyle (fg brightWhite) underline) - , (attrName "current" , fg brightRed) - , (attrName "title" , withStyle (fg yellow) bold) + , (Border.borderAttr , fg white) + , (Edit.editFocusedAttr , fg brightWhite) + , (attrKey , withStyle (fg brightMagenta) bold) + , (attrBold , withStyle (fg white) bold) + , (attrUnder , withStyle (fg brightWhite) underline) + , (attrTitle , withStyle (fg brightWhite) bold) + , (attrTitleFocus , withStyle (fg yellow) bold) + , (attrBranchCurrent , fg brightRed) + , (attrBranchCommon , fg brightBlue) ] + +attrKey :: AttrName +attrKey = attrName "key" +attrBold :: AttrName +attrBold = attrName "bold" +attrUnder :: AttrName +attrUnder = attrName "under" +attrTitle :: AttrName +attrTitle = attrName "title" +attrTitleFocus :: AttrName +attrTitleFocus = attrName "title-focus" +attrBranchCurrent :: AttrName +attrBranchCurrent = attrName "current-branch" +attrBranchCommon :: AttrName +attrBranchCommon = attrName "common-branch" diff --git a/git-brunch.cabal b/git-brunch.cabal --- a/git-brunch.cabal +++ b/git-brunch.cabal @@ -1,15 +1,15 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0. +-- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack -- --- hash: d34febe8818f8646624200a52e8dd2e6088e6e11ab4ad0939aa2ad5153fd3564 +-- hash: 9068dd582fd66de4b8c0c3a49502d99cf46bfe110966c54ce4d8fd398c238146 name: git-brunch -version: 1.3.1.0 +version: 1.4.0.0 synopsis: git checkout command-line tool -description: Please see the README on GitHub at +description: Please see the README on GitHub at category: Git homepage: https://github.com/andys8/git-brunch#readme bug-reports: https://github.com/andys8/git-brunch/issues @@ -39,6 +39,7 @@ Paths_git_brunch hs-source-dirs: app + default-extensions: StrictData OverloadedStrings build-depends: base >=4.7 && <5 , brick @@ -64,6 +65,7 @@ hs-source-dirs: test app + default-extensions: StrictData OverloadedStrings ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -4,53 +4,53 @@ main :: IO () main = hspec $ describe "Git.toBranch" $ do - it "returns a remote branch is starts with remote" - $ toBranches "remotes/origin/master" - `shouldBe` [BranchRemote "origin" "master"] + it "returns a remote branch is starts with remote" + $ toBranches "remotes/origin/master" + `shouldBe` [BranchRemote "origin" "master"] - it "ignores leading spaces" - $ toBranches " master" - `shouldBe` [BranchLocal "master"] + it "ignores leading spaces" + $ toBranches " master" + `shouldBe` [BranchLocal "master"] - it "detects current branch by asterik" - $ toBranches "* master" - `shouldBe` [BranchCurrent "master"] + it "detects current branch by asterik" + $ toBranches "* master" + `shouldBe` [BranchCurrent "master"] - it "returns a local branch" - $ toBranches "master" - `shouldBe` [BranchLocal "master"] + it "returns a local branch" + $ toBranches "master" + `shouldBe` [BranchLocal "master"] - it "returns a branch with head in name" - $ toBranches "updateHead" - `shouldBe` [BranchLocal "updateHead"] + it "returns a branch with head in name" + $ toBranches "updateHead" + `shouldBe` [BranchLocal "updateHead"] - it "ignores HEAD" $ toBranches "HEAD" `shouldBe` [] + it "ignores HEAD" $ toBranches "HEAD" `shouldBe` [] - it "ignores origin/HEAD" $ toBranches "origin/HEAD" `shouldBe` [] + it "ignores origin/HEAD" $ toBranches "origin/HEAD" `shouldBe` [] - it "ignores detatched HEAD" - $ toBranches "* (HEAD detached at f01a202)" - `shouldBe` [] + it "ignores detatched HEAD" + $ toBranches "* (HEAD detached at f01a202)" + `shouldBe` [] - it "parses sample output" - $ toBranches sampleOutput - `shouldBe` [ BranchLocal "experimental/failing-debug-log-demo" - , BranchLocal "gh-pages" - , BranchLocal "master" - , BranchLocal "wip/delete-as-action" - , BranchRemote "origin" "experimental/failing-debug-log-demo" - , BranchRemote "origin" "gh-pages" - , BranchRemote "origin" "master" - ] + it "parses sample output" + $ toBranches sampleOutput + `shouldBe` [ BranchLocal "experimental/failing-debug-log-demo" + , BranchLocal "gh-pages" + , BranchLocal "master" + , BranchLocal "wip/delete-as-action" + , BranchRemote "origin" "experimental/failing-debug-log-demo" + , BranchRemote "origin" "gh-pages" + , BranchRemote "origin" "master" + ] sampleOutput :: String sampleOutput = - "* (HEAD detached at f01a202)\n" - ++ " experimental/failing-debug-log-demo\n" - ++ " gh-pages\n" - ++ " master\n" - ++ " wip/delete-as-action\n" - ++ " remotes/origin/HEAD -> origin/master\n" - ++ " remotes/origin/experimental/failing-debug-log-demo\n" - ++ " remotes/origin/gh-pages\n" - ++ " remotes/origin/master" + "* (HEAD detached at f01a202)\n" + ++ " experimental/failing-debug-log-demo\n" + ++ " gh-pages\n" + ++ " master\n" + ++ " wip/delete-as-action\n" + ++ " remotes/origin/HEAD -> origin/master\n" + ++ " remotes/origin/experimental/failing-debug-log-demo\n" + ++ " remotes/origin/gh-pages\n" + ++ " remotes/origin/master"