RenderTreeView.renderFrom: admit <address>1.3.1

1 files changed, 19 insertions, 6 deletions

diff --git a/src/Much/RenderTreeView.hs b/src/Much/RenderTreeView.hs
index 6babb29..ebed6e0 100644
--- a/src/Much/RenderTreeView.hs
+++ b/src/Much/RenderTreeView.hs
@@ -212,8 +212,13 @@ renderDate now = \case
 
 renderFrom :: Maybe T.Text -> Blessings String
 renderFrom = \case
-    Just fromLine -> Plain $ dropAddress $ T.unpack fromLine
-    Nothing -> SGR [35,1] "Anonymous"
+    Just fromLine ->
+      Plain $
+        case readFrom (T.unpack fromLine) of
+          ("", address) -> address
+          (name, _) -> name
+    Nothing ->
+      SGR [35,1] "Anonymous"
 
 
 renderTags :: State -> [Tag] -> Blessings String
@@ -230,8 +235,16 @@ renderTag state tag = case M.lookup tag $ runIdentity $ tagMap $ colorConfig sta
     plain = Plain $ T.unpack $ fromMaybe tag $ M.lookup tag (aliases state)
 
 
-dropAddress :: String -> String
-dropAddress xs =
+readFrom :: String -> (String, String)
+readFrom xs =
     case L.elemIndices '<' xs of
-        [] -> xs
-        is -> L.dropWhileEnd isSpace $ take (last is) xs
+        [] ->
+          ("", xs)
+        is ->
+          readName *** readAddress $ splitAt (last is - 1) xs
+  where
+    readAddress :: String -> String
+    readAddress = L.takeWhile (/='>') . dropWhile (=='<')
+
+    readName :: String -> String
+    readName = L.dropWhileEnd isSpace