Use a column width percentage for authors

When purebred renders a list of threads, we render every attribute of a thread in sequential order. That makes it harder to skim through the threads than it has to be. This patch renders all authors in a column with a fixed percentage (see jtdaugherty/brick#182). This provides a better anchor point for the eyes to quickly skim through mails.
purebred-mua · Aug 7, 2018 · ad84e2f · ad84e2f
1 parent 0c275d3
commit ad84e2f
Show file tree

Hide file tree

Showing 4 changed files with 16 additions and 17 deletions.
diff --git a/purebred.cabal b/purebred.cabal
@@ -70,7 +70,7 @@ library
                      , Network.Mail.Mime.Lens
   build-depends:       base >= 4.9 && < 5
                      , lens
-                     , brick >= 0.34
+                     , brick >= 0.40
                      , text-zipper
                      , vty
                      , vector
@@ -129,5 +129,5 @@ test-suite unittests
                      , notmuch
                      , time
                      , filepath
-                     , brick >= 0.34
+                     , brick >= 0.40
                      , vector
diff --git a/src/UI/Index/Main.hs b/src/UI/Index/Main.hs
@@ -10,7 +10,7 @@ module UI.Index.Main (
 import Brick.Types (Padding(..), Widget)
 import Brick.AttrMap (AttrName)
 import Brick.Widgets.Core
-       (hLimit, padLeft, txt, vLimit, withAttr, (<+>))
+       (hLimitPercent, padLeft, txt, vLimit, withAttr, (<+>))
 import qualified Brick.Widgets.List as L
 import Control.Lens.Getter (view)
 import qualified Data.ByteString as B
@@ -56,8 +56,8 @@ listDrawMail s sel a =
     let settings = view (asConfig . confNotmuch) s
         isNewMail = hasTag (view nmNewTag settings) a
         widget = padLeft (Pad 1) (txt $ formatDate (view mailDate a)) <+>
-                 padLeft (Pad 1) (renderTagsWidget (view mailTags a) (view nmNewTag settings)) <+>
                  padLeft (Pad 1) (renderAuthors sel $ view mailFrom a) <+>
+                 padLeft (Pad 1) (renderTagsWidget (view mailTags a) (view nmNewTag settings)) <+>
                  padLeft (Pad 1) (txt (view mailSubject a)) <+> fillLine
     in withAttr (getListAttr isNewMail sel) widget
 
@@ -66,9 +66,9 @@ listDrawThread s sel a =
     let settings = view (asConfig . confNotmuch) s
         isNewMail = hasTag (view nmNewTag settings) a
         widget = padLeft (Pad 1) (txt $ formatDate (view thDate a)) <+>
+                 padLeft (Pad 1) (renderAuthors sel $ T.unwords $ view thAuthors a) <+>
                  padLeft (Pad 1) (txt $ pack $ "(" <> show (view thReplies a) <> ")") <+>
                  padLeft (Pad 1) (renderTagsWidget (view thTags a) (view nmNewTag settings)) <+>
-                 padLeft (Pad 1) (renderAuthors sel $ T.unwords $ view thAuthors a) <+>
                  padLeft (Pad 1) (txt (view thSubject a)) <+> fillLine
     in withAttr (getListAttr isNewMail sel) widget
 
@@ -89,7 +89,7 @@ renderAuthors isSelected authors =
             if isSelected
                 then mailSelectedAuthorsAttr
                 else mailAuthorsAttr
-    in withAttr attribute $ hLimit 15 (txt authors)
+    in withAttr attribute $ hLimitPercent 20 (txt authors <+> fillLine)
 
 renderTagsWidget :: [Tag] -> Tag -> Widget Name
 renderTagsWidget tgs ignored =

diff --git a/stack.yaml b/stack.yaml
@@ -51,12 +51,12 @@ packages:
 extra-deps:
 - concise-0.1.0.1
 - config-ini-0.2.2.0
-- data-clist-0.1.2.0
+- data-clist-0.1.2.1
 - word-wrap-0.4.1
-- vty-5.20
-- brick-0.34
-- megaparsec-6.4.0
-- parser-combinators-0.4.0
+- vty-5.23.1
+- brick-0.40
+- megaparsec-6.5.0
+- parser-combinators-1.0.0
 
 # Override default flag values for local packages and extra-deps
 flags: {}

diff --git a/test/TestUserAcceptance.hs b/test/TestUserAcceptance.hs
@@ -110,14 +110,14 @@ testUpdatesReadState = withTmuxSession "updates read state for mail and thread"
     sendKeys "Down" (Literal "2 of 2")
 
     liftIO $ step "go back to thread list which is read"
-    sendKeys "q q" (Regex (buildAnsiRegex [] ["37"] ["43"] <> " 08/Feb \\(2\\)"))
+    sendKeys "q q" (Regex (buildAnsiRegex [] ["37"] ["43"] <> " 08/Feb\\sRóman\\sJoost\\s+\\(2\\)"))
 
     liftIO $ step "set one mail to unread"
     sendKeys "Enter" (Literal "Beginning of large text")
-    sendKeys "q t" (Regex (buildAnsiRegex ["1"] [] [] <> "\\sWIP Refactor\\s" <> buildAnsiRegex ["0"] ["34"] ["40"]))
+    sendKeys "q t" (Regex (buildAnsiRegex ["1"] ["37"] [] <> "\\sWIP Refactor\\s" <> buildAnsiRegex ["0"] ["34"] ["40"]))
 
     liftIO $ step "returning to thread list shows thread unread"
-    sendKeys "q" (Regex (buildAnsiRegex ["1"] ["37"] ["43"] <> " 08/Feb \\(2\\)"))
+    sendKeys "q" (Regex (buildAnsiRegex ["1"] ["37"] [] <> "\\sWIP Refactor\\s"))
 
     pure ()
 
@@ -361,7 +361,7 @@ testManageTagsOnThreads = withTmuxSession "manage tags on threads" $
     sendKeys "Escape" (Regex (buildAnsiRegex [] ["36"] []
                               <> "replied thread"
                               <> buildAnsiRegex [] ["37"] []
-                              <> "\\sRóman Joost\\s<\\w+\\sRe: WIP Refactor"))
+                              <> "\\sRe: WIP Refactor"))
 
     liftIO $ step "go back to list of threads"
     sendKeys "Escape" (Literal "List of Threads")
@@ -445,11 +445,10 @@ testUserViewsMailSuccessfully = withTmuxSession "user can view mail" $
     liftIO $ step "shows tag"
     out <- capture
     assertSubstrInOutput "inbox" out
-    -- Should have white space removed (see: #152)
     assertSubstrInOutput "Testmail with whitespace in the subject" out
 
     liftIO $ step "open thread"
-    sendKeys "Enter" (Regex "url.user\\s+Testmail with whitespace in the subject")
+    sendKeys "Enter" (Literal "Testmail with whitespace in the subject")
 
     liftIO $ step "view mail"
     sendKeys "Enter" (Literal "This is a test mail")