diff --git a/app/Git.hs b/app/Git.hs index e879f61..24899d0 100644 --- a/app/Git.hs +++ b/app/Git.hs @@ -13,22 +13,24 @@ module Git ( ) where import Data.Char (isSpace) -import Data.List +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.IO qualified as T import System.Exit import System.Process data Branch - = BranchLocal String - | BranchCurrent String - | BranchRemote String String + = BranchLocal Text + | BranchCurrent Text + | BranchRemote Text Text deriving (Eq) instance Show Branch where - show (BranchLocal n) = n - show (BranchCurrent n) = n <> "*" - show (BranchRemote o n) = o <> "/" <> n + show (BranchLocal n) = T.unpack n + show (BranchCurrent n) = T.unpack $ n <> "*" + show (BranchRemote o n) = T.unpack $ o <> "/" <> n -fetch :: IO String +fetch :: IO Text fetch = readGit ["fetch", "--all", "--prune"] listBranches :: IO [Branch] @@ -43,35 +45,35 @@ listBranches = , "--no-color" ] -toBranches :: String -> [Branch] -toBranches input = toBranch <$> filter validBranch (lines input) +toBranches :: Text -> [Branch] +toBranches input = toBranch <$> filter validBranch (T.lines input) where validBranch b = not $ isHead b || isDetachedHead b || isNoBranch b -toBranch :: String -> Branch -toBranch line = mkBranch $ words $ dropWhile isSpace line +toBranch :: Text -> Branch +toBranch line = mkBranch $ T.words $ T.dropWhile isSpace line where mkBranch ("*" : name : _) = BranchCurrent name - mkBranch (name : _) = case stripPrefix "remotes/" name of + mkBranch (name : _) = case T.stripPrefix "remotes/" name of Just rest -> parseRemoteBranch rest Nothing -> BranchLocal name mkBranch [] = error "empty branch name" parseRemoteBranch str = BranchRemote remote name where - (remote, rest) = span ('/' /=) str - name = drop 1 rest + (remote, rest) = T.span ('/' /=) str + name = T.drop 1 rest checkout :: Branch -> IO ExitCode checkout branch = spawnGit ["checkout", branchName branch] rebaseInteractive :: Branch -> IO ExitCode rebaseInteractive branch = do - putStrLn $ "Rebase onto " <> fullBranchName branch + T.putStrLn $ "Rebase onto " <> fullBranchName branch spawnGit ["rebase", "--interactive", "--autostash", fullBranchName branch] merge :: Branch -> IO ExitCode merge branch = do - putStrLn $ "Merge branch " <> fullBranchName branch + T.putStrLn $ "Merge branch " <> fullBranchName branch spawnGit ["merge", fullBranchName branch] deleteBranch :: Branch -> IO ExitCode @@ -79,11 +81,11 @@ 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 +spawnGit :: [Text] -> IO ExitCode +spawnGit args = waitForProcess =<< spawnProcess "git" (T.unpack <$> args) -readGit :: [String] -> IO String -readGit args = readProcess "git" args [] +readGit :: [Text] -> IO Text +readGit args = T.pack <$> readProcess "git" (T.unpack <$> args) [] isCommonBranch :: Branch -> Bool isCommonBranch b = branchName b `elem` commonBranchNames @@ -105,23 +107,23 @@ isRemoteBranch _ = False --- Helper -branchName :: Branch -> String +branchName :: Branch -> Text branchName (BranchCurrent n) = n branchName (BranchLocal n) = n branchName (BranchRemote _ n) = n -fullBranchName :: Branch -> String +fullBranchName :: Branch -> Text fullBranchName (BranchCurrent n) = n fullBranchName (BranchLocal n) = n fullBranchName (BranchRemote r n) = r <> "/" <> n -isHead :: String -> Bool -isHead = isInfixOf "HEAD" +isHead :: Text -> Bool +isHead = T.isInfixOf "HEAD" -isDetachedHead :: String -> Bool -isDetachedHead = isInfixOf "HEAD detached" +isDetachedHead :: Text -> Bool +isDetachedHead = T.isInfixOf "HEAD detached" -- While rebasing git will show "no branch" -- e.g. "* (no branch, rebasing branch-name)" -isNoBranch :: String -> Bool -isNoBranch = isInfixOf "(no branch," +isNoBranch :: Text -> Bool +isNoBranch = T.isInfixOf "(no branch," diff --git a/app/GitBrunch.hs b/app/GitBrunch.hs index b3a7fe9..a36bcfa 100644 --- a/app/GitBrunch.hs +++ b/app/GitBrunch.hs @@ -17,6 +17,9 @@ import Control.Monad.Extra (ifM, unlessM) import Data.Char import Data.List import Data.Maybe (fromMaybe, isJust) +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.IO qualified as T import Data.Vector qualified as Vec import Graphics.Vty hiding (update) import Lens.Micro (Lens', lens, (%~), (&), (.~), (^.), _Just) @@ -56,7 +59,7 @@ data State = State , _localBranches :: L.List Name Branch , _remoteBranches :: L.List Name Branch , _dialog :: Maybe (D.Dialog DialogOption) - , _filter :: E.Editor String Name + , _filter :: E.Editor Text Name , _isEditingFilter :: Bool } @@ -99,7 +102,7 @@ emptyState = where mkList focus = L.list focus Vec.empty rowHeight -emptyFilter :: E.Editor String Name +emptyFilter :: E.Editor Text Name emptyFilter = E.editor Filter Nothing "" app :: M.App State e Name @@ -144,7 +147,7 @@ drawFilter :: State -> Widget Name drawFilter state = withBorderStyle BS.unicodeBold $ B.border $ vLimit 1 $ label <+> editor where - editor = E.renderEditor (str . unlines) True (state ^. filterL) + editor = E.renderEditor (txt . T.unlines) True (state ^. filterL) label = str " Filter: " drawDialog :: State -> Widget n @@ -179,11 +182,11 @@ drawListElement isListFocussed branch = highlight b | Git.isCommonBranch b = withAttr attrBranchCommon highlight _ = id -drawInstruction :: String -> String -> Widget n +drawInstruction :: Text -> Text -> Widget n drawInstruction keys action = - withAttr attrKey (str keys) - <+> str " to " - <+> withAttr attrBold (str action) + withAttr attrKey (txt keys) + <+> txt " to " + <+> withAttr attrBold (txt action) & C.hCenter appHandleEvent :: BrickEvent Name e -> EventM Name State () @@ -311,9 +314,9 @@ listOffsetDiff target = do fetchBranches :: IO [Branch] fetchBranches = do - putStrLn "Fetching branches" + T.putStrLn "Fetching branches" output <- Git.fetch - putStr output + T.putStr output Git.listBranches updateBranches :: [Branch] -> State -> State @@ -330,9 +333,8 @@ syncBranchLists state = & focusL %~ toggleFocus (local, remote) where 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 + filterText = T.toLower $ T.unwords $ E.getEditContents $ _filter state + isBranchInFilter = T.isInfixOf filterText . Git.fullBranchName filteredBranches = filter isBranchInFilter (_branches state) (remote, local) = partition Git.isRemoteBranch filteredBranches @@ -391,7 +393,7 @@ remoteBranchesL = lens _remoteBranches (\s bs -> s{_remoteBranches = bs}) focusL :: Lens' State RemoteName focusL = lens _focus (\s f -> s{_focus = f}) -filterL :: Lens' State (E.Editor String Name) +filterL :: Lens' State (E.Editor Text Name) filterL = lens _filter (\s f -> s{_filter = f}) branchesL :: Lens' State [Branch] diff --git a/git-brunch.cabal b/git-brunch.cabal index 82cf3a4..e923480 100644 --- a/git-brunch.cabal +++ b/git-brunch.cabal @@ -52,6 +52,7 @@ executable git-brunch , mtl , optparse-applicative , process + , text , vector , vty default-language: Haskell2010 @@ -86,6 +87,7 @@ test-suite git-brunch-test , mtl , optparse-applicative , process + , text , vector , vty default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index fe92974..e3f0d12 100644 --- a/package.yaml +++ b/package.yaml @@ -21,10 +21,11 @@ dependencies: - microlens - microlens-mtl - mtl + - optparse-applicative - process + - text - vector - vty - - optparse-applicative - hspec # workaround for language servers default-extensions: diff --git a/test/Spec.hs b/test/Spec.hs index 3899ed0..e1eacde 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,57 +1,59 @@ +import Data.Text (Text) import Git import Test.Hspec main :: IO () -main = hspec $ describe "Git.toBranch" $ do - it "returns a remote branch is starts with remote" $ do - toBranches "remotes/origin/master" `shouldBe` [BranchRemote "origin" "master"] +main = hspec $ + describe "Git.toBranch" $ do + it "returns a remote branch is starts with remote" $ do + toBranches "remotes/origin/master" `shouldBe` [BranchRemote "origin" "master"] - it "ignores leading spaces" $ do - toBranches " master" `shouldBe` [BranchLocal "master"] + it "ignores leading spaces" $ do + toBranches " master" `shouldBe` [BranchLocal "master"] - it "detects current branch by asterik" $ do - toBranches "* master" `shouldBe` [BranchCurrent "master"] + it "detects current branch by asterik" $ do + toBranches "* master" `shouldBe` [BranchCurrent "master"] - it "returns a local branch" $ do - toBranches "master" `shouldBe` [BranchLocal "master"] + it "returns a local branch" $ do + toBranches "master" `shouldBe` [BranchLocal "master"] - it "returns a branch with head in name" $ do - toBranches "updateHead" `shouldBe` [BranchLocal "updateHead"] + it "returns a branch with head in name" $ do + toBranches "updateHead" `shouldBe` [BranchLocal "updateHead"] - it "ignores HEAD" $ do - toBranches "HEAD" `shouldBe` [] + it "ignores HEAD" $ do + toBranches "HEAD" `shouldBe` [] - it "ignores empty" $ do - toBranches "" `shouldBe` [] + it "ignores empty" $ do + toBranches "" `shouldBe` [] - it "ignores origin/HEAD" $ do - toBranches "origin/HEAD" `shouldBe` [] + it "ignores origin/HEAD" $ do + toBranches "origin/HEAD" `shouldBe` [] - it "ignores detatched HEAD" $ do - toBranches "* (HEAD detached at f01a202)" `shouldBe` [] + it "ignores detatched HEAD" $ do + toBranches "* (HEAD detached at f01a202)" `shouldBe` [] - it "ignores 'no branch' during rebase" $ do - toBranches "* (no branch, rebasing branch-name)" `shouldBe` [] + it "ignores 'no branch' during rebase" $ do + toBranches "* (no branch, rebasing branch-name)" `shouldBe` [] - it "parses sample output" $ do - 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" $ do + 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 :: Text 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" + <> " 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"