andys8 · andys8 · Dec 28, 2022 · Dec 28, 2022 · Dec 28, 2022
diff --git 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,47 +45,47 @@ 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 ->
10000
; 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
+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
@@ -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
@@ -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
@@ -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
@@ -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"