git-brunch 1.2.0.0 → 1.3.0.0
raw patch · 4 files changed
+168/−104 lines, 4 files
Files
- app/Git.hs +10/−8
- app/GitBrunch.hs +147/−90
- app/Theme.hs +8/−3
- git-brunch.cabal +3/−3
app/Git.hs view
@@ -4,21 +4,22 @@ , fetch , rebaseInteractive , toBranches+ , deleteBranch , Branch(..) ) where -import System.Process+import Data.Char ( isSpace ) import Data.List-import Data.Char ( isSpace ) import System.Exit+import System.Process + data Branch = BranchLocal String | BranchCurrent String | BranchRemote String String deriving Eq - instance (Show Branch) where show (BranchLocal n ) = n show (BranchCurrent n ) = n <> "*"@@ -40,12 +41,11 @@ [] fetch :: IO String-fetch = readProcess "git" ["fetch", "--all"] []+fetch = readProcess "git" ["fetch", "--all", "--prune"] [] toBranches :: String -> [Branch] toBranches input = toBranch <$> filter (not . isHead) (lines input) - toBranch :: String -> Branch toBranch line = toBranch' $ words $ dropWhile isSpace line where@@ -55,21 +55,22 @@ Nothing -> BranchLocal name toBranch' [] = error "empty branch name" - checkout :: Branch -> IO ExitCode checkout branch = spawnGit ["checkout", branchName branch] - rebaseInteractive :: Branch -> IO ExitCode rebaseInteractive branch = do putStrLn $ "Rebase onto " <> fullBranchName branch spawnGit ["rebase", "--interactive", "--autostash", fullBranchName branch] +deleteBranch :: Branch -> IO ExitCode+deleteBranch (BranchCurrent _ ) = error "Cannot delete current branch"+deleteBranch (BranchLocal n ) = spawnGit ["branch", "-D", n]+deleteBranch (BranchRemote o n) = spawnGit ["push", o, "--delete", n] spawnGit :: [String] -> IO ExitCode spawnGit args = waitForProcess =<< spawnProcess "git" args - parseRemoteBranch :: String -> Branch parseRemoteBranch str = BranchRemote remote name where (remote, _ : name) = span ('/' /=) str@@ -89,3 +90,4 @@ isHead :: String -> Bool isHead = isInfixOf "HEAD"+
app/GitBrunch.hs view
@@ -6,57 +6,57 @@ ) where -import Data.Maybe ( fromMaybe )-import qualified Graphics.Vty as V-import Lens.Micro ( (^.) -- view- , (.~) -- set- , (%~) -- over- , (&)- , Lens'- , lens- )-+import Brick.Main ( halt+ , continue+ , suspendAndResume+ )+import Brick.Themes ( themeToAttrMap )+import Brick.Types+import Brick.Widgets.Core+import Control.Monad+import Data.Char+import Data.List+import Data.Maybe ( fromMaybe )+import Graphics.Vty hiding ( update )+import Lens.Micro ( (^.)+ , (.~)+ , (&)+ , Lens'+ , lens+ , over+ )+import System.Exit import qualified Brick.Main as M-import Brick.Types ( Widget )-import Brick.Themes ( themeToAttrMap )-import qualified Brick.Types as T import qualified Brick.Widgets.Border as B import qualified Brick.Widgets.Border.Style as BS import qualified Brick.Widgets.Center as C-import Brick.Widgets.Core ( hLimit- , str- , vBox- , hBox- , padAll- , padLeft- , padRight- , withAttr- , withBorderStyle- , (<+>)- )+import qualified Brick.Widgets.Dialog as D import qualified Brick.Widgets.List as L import qualified Data.Vector as Vec-import Data.List-import Data.Char-import Control.Monad-import System.Exit import Git-import Theme ( theme )+import Theme data Name = Local | Remote deriving (Ord, Eq, Show)-data GitCommand = GitRebase | GitCheckout deriving (Ord, Eq)+data GitCommand = GitRebase | GitCheckout | GitDeleteBranch deriving (Ord, Eq)++data DialogOption = Cancel | Confirm+data DialogResult = SetDialog (D.Dialog DialogOption)+ | EndDialog DialogOption+ data State = State { _focus :: Name , _gitCommand :: GitCommand , _localBranches :: L.List Name Branch , _remoteBranches :: L.List Name Branch+ , _dialog :: Maybe (D.Dialog DialogOption) } instance (Show GitCommand) where- show GitCheckout = "checkout"- show GitRebase = "rebase"+ show GitCheckout = "checkout"+ show GitRebase = "rebase"+ show GitDeleteBranch = "delete" main :: IO a main = do@@ -65,12 +65,16 @@ let gitCommand = _gitCommand state let branch = selectedBranch state let runGit = \case- GitCheckout -> Git.checkout- GitRebase -> Git.rebaseInteractive+ 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 +initialState :: State+initialState = State Local GitCheckout (toList Local) (toList Remote) Nothing+ where toList n = L.list n Vec.empty 1 app :: M.App State e Name app = M.App { M.appDraw = appDraw@@ -80,18 +84,18 @@ , M.appAttrMap = const $ themeToAttrMap theme } - appDraw :: State -> [Widget Name] appDraw state =- [ C.vCenter $ padAll 1 $ vBox- [ hBox- [ C.hCenter $ toBranchList localBranchesL- , C.hCenter $ toBranchList remoteBranchesL- ]- , str " "- , instructions+ drawDialog state+ : [ C.vCenter $ padAll 1 $ vBox+ [ hBox+ [ C.hCenter $ toBranchList localBranchesL+ , C.hCenter $ toBranchList remoteBranchesL+ ]+ , str " "+ , instructions+ ] ]- ] where toBranchList lens' = state ^. lens' & (\l -> drawBranchList (hasFocus l) l) hasFocus = (_focus state ==) . L.listName@@ -100,8 +104,22 @@ , drawInstruction "Enter" "checkout" , drawInstruction "R" "rebase" , drawInstruction "F" "fetch"+ , drawInstruction "D" "delete" ] +drawDialog :: State -> Widget n+drawDialog state = case _dialog state of+ Nothing -> emptyWidget+ Just dialog -> D.renderDialog dialog $ C.hCenter $ padAll 1 content+ where+ branch = maybe "" show $ selectedBranch state+ action = show (_gitCommand state)+ content =+ str "Really "+ <+> withAttr "under" (str action)+ <+> str " branch "+ <+> withAttr "bold" (str branch)+ <+> str "?" drawBranchList :: Bool -> L.List Name Branch -> Widget Name drawBranchList hasFocus list =@@ -114,15 +132,13 @@ title Remote = map toUpper "remote" drawTitle = withAttr "title" . str . title . L.listName - drawListElement :: Bool -> Branch -> Widget Name drawListElement _ branch =- padLeft (T.Pad 1) $ padRight T.Max $ highlight branch $ str $ show branch+ padLeft (Pad 1) $ padRight Max $ highlight branch $ str $ show branch where highlight (BranchCurrent _) = withAttr "current" highlight _ = id - drawInstruction :: String -> String -> Widget n drawInstruction keys action = withAttr "key" (str keys)@@ -130,35 +146,68 @@ <+> withAttr "bold" (str action) & C.hCenter +appHandleEvent :: State -> BrickEvent Name e -> EventM Name (Next State)+appHandleEvent state e = case _dialog state of+ Nothing -> appHandleEventMain state e+ Just d -> toState =<< appHandleEventDialog d e+ where+ toState (SetDialog dlg ) = continue $ state { _dialog = Just dlg }+ toState (EndDialog Confirm) = halt $ state { _dialog = Nothing }+ toState (EndDialog Cancel) =+ continue $ state { _dialog = Nothing, _gitCommand = GitCheckout } -appHandleEvent :: State -> T.BrickEvent Name e -> T.EventM Name (T.Next State)-appHandleEvent state (T.VtyEvent e) =- let endWithCheckout = M.halt $ state { _gitCommand = GitCheckout }- endWithRebase = M.halt $ state { _gitCommand = GitRebase }- focusLocal = M.continue $ focusBranches Local state- focusRemote = M.continue $ focusBranches Remote state- deleteSelection = focussedBranchesL %~ L.listClear- quit = M.halt $ deleteSelection state- updateBranches = M.suspendAndResume (updateBranchList state)- in case lowerCaseEvent e of- V.EvKey V.KEsc [] -> quit- V.EvKey (V.KChar 'q') [] -> quit- V.EvKey (V.KChar 'c') [V.MCtrl] -> quit- V.EvKey (V.KChar 'd') [V.MCtrl] -> quit- V.EvKey V.KEnter [] -> endWithCheckout- V.EvKey (V.KChar 'r') [] -> endWithRebase- V.EvKey V.KLeft [] -> focusLocal- V.EvKey (V.KChar 'h') [] -> focusLocal- V.EvKey V.KRight [] -> focusRemote- V.EvKey (V.KChar 'l') [] -> focusRemote- V.EvKey (V.KChar 'f') [] -> updateBranches- event -> navigate state event- where- lowerCaseEvent (V.EvKey (V.KChar c) []) = V.EvKey (V.KChar (toLower c)) []- lowerCaseEvent e' = e'+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 -appHandleEvent state _ = M.continue state+appHandleEventDialog+ :: D.Dialog DialogOption -> BrickEvent Name e -> EventM Name DialogResult+appHandleEventDialog dialog (VtyEvent e) =+ let quit = pure $ EndDialog Cancel+ 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+appHandleEventDialog dialog _ = pure $ SetDialog dialog +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+ updateBranchList :: State -> IO State updateBranchList state = do putStrLn "Fetching branches"@@ -170,26 +219,13 @@ focusBranches :: Name -> State -> State focusBranches target state = if state ^. focusL == target then state- else state & toL %~ L.listMoveTo selectedIndex & focusL .~ target+ else state & toL `over` L.listMoveTo selectedIndex & focusL .~ target where selectedIndex = fromMaybe 0 $ L.listSelected (state ^. fromL) (fromL, toL) = case target of Local -> (remoteBranchesL, localBranchesL) Remote -> (localBranchesL, remoteBranchesL) --navigate :: State -> V.Event -> T.EventM Name (T.Next State)-navigate state event = do- let update = L.handleListEventVi L.handleListEvent- newState <- T.handleEventLensed state focussedBranchesL update event- M.continue newState---initialState :: State-initialState =- State Local GitCheckout (L.list Local Vec.empty 1) (L.list Remote Vec.empty 1)-- setBranches :: [Branch] -> State -> State setBranches branches state = newState where@@ -201,12 +237,35 @@ , _remoteBranches = toList Remote remote } - selectedBranch :: State -> Maybe Branch selectedBranch state = snd <$> L.listSelectedElement (state ^. focussedBranchesL) +createDialog :: GitCommand -> D.Dialog DialogOption+createDialog cmd = D.dialog (Just title) (Just (0, choices)) 80+ where+ choices = [("Cancel", Cancel), (btnText $ show cmd, Confirm)]+ title = map toUpper $ show cmd+ btnText (x : xs) = toUpper x : xs+ btnText x = x +mapKey :: (Char -> Key) -> Event -> Event+mapKey f (EvKey (KChar k) []) = EvKey (f k) []+mapKey _ e = e++lowerKey :: Event -> Event+lowerKey = mapKey (KChar . toLower)++vimKey :: Event -> Event+vimKey = mapKey vimify+ where+ vimify 'h' = KLeft+ vimify 'j' = KRight+ vimify 'k' = KLeft+ vimify 'l' = KRight+ vimify k = KChar k++ -- Lens focussedBranchesL :: Lens' State (L.List Name Branch)@@ -216,14 +275,12 @@ Remote -> remoteBranchesL in lens (\s -> s ^. branchLens s) (\s bs -> (branchLens s .~ bs) s) - localBranchesL :: Lens' State (L.List Name Branch) localBranchesL = lens _localBranches (\s bs -> s { _localBranches = bs }) - remoteBranchesL :: Lens' State (L.List Name Branch) remoteBranchesL = lens _remoteBranches (\s bs -> s { _remoteBranches = bs }) - focusL :: Lens' State Name focusL = lens _focus (\s f -> s { _focus = f })+
app/Theme.hs view
@@ -3,13 +3,14 @@ ) where -import Graphics.Vty-import qualified Brick.Widgets.List as List import Brick.AttrMap ( attrName )-import Brick.Util import Brick.Themes ( Theme , newTheme )+import Brick.Util+import Graphics.Vty+import qualified Brick.Widgets.Dialog as Dialog+import qualified Brick.Widgets.List as List theme :: Theme theme = newTheme@@ -17,8 +18,12 @@ [ (List.listAttr , fg brightWhite) , (List.listSelectedAttr , fg brightWhite) , (List.listSelectedFocusedAttr, black `on` brightYellow)+ , (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) ]
git-brunch.cabal view
@@ -1,13 +1,13 @@ 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: 22a15a4c423b8a74ed7792d569b01d8dd5213d7fbd8986b8f9d632f6497cbee5+-- hash: d318a782db89bc0b4a6bdc40133edcf04bcf8a4a3c8085585b42c27a4766e31f name: git-brunch-version: 1.2.0.0+version: 1.3.0.0 synopsis: git checkout command-line tool description: Please see the README on GitHub at <https://github.com/andys8/git-brunch#readme> category: Git