blessings: 2 -> 3

1 files changed, 31 insertions, 43 deletions

diff --git a/src/Much/RenderTreeView.hs b/src/Much/RenderTreeView.hs
index 21af597..f1eaf6e 100644
--- a/src/Much/RenderTreeView.hs
+++ b/src/Much/RenderTreeView.hs
@@ -4,7 +4,7 @@
 module Much.RenderTreeView (renderTreeView) where
 
 import Blessings
-import Blessings.String.Extra (quoteSpecials)
+import Blessings.Extra (quoteSpecialsPlain, quoteSpecialsPlain')
 import Control.Arrow
 import Data.CaseInsensitive qualified as CI
 import Data.Char
@@ -12,11 +12,13 @@ import Data.Functor.Identity
 import Data.List qualified as L
 import Data.Map qualified as M
 import Data.Maybe
+import Data.String (fromString)
 import Data.Text qualified as T
 import Data.Time
 import Data.Time.Format.Human
 import Data.Tree
 import Data.Tree.Zipper qualified as Z
+import Data.WText (WText(WText))
 import Much.State
 import Much.TagUtils (Tag)
 import Much.TreeView
@@ -25,7 +27,7 @@ import Notmuch.Message qualified as Notmuch
 import Notmuch.SearchResult qualified as Notmuch
 
 
-color :: (ColorConfig Identity -> Identity Pm) -> ColorConfig Identity -> Blessings String -> Blessings String
+color :: (ColorConfig Identity -> Identity Pm) -> ColorConfig Identity -> Blessings WText -> Blessings WText
 color key config = SGR $ runIdentity $ key config
 
 -- TODO make configurable
@@ -53,7 +55,7 @@ humanTimeLocale = defaultHumanTimeLocale
 renderTreeView
     :: State
     -> Z.TreePos Z.Full TreeView
-    -> [Blessings String]
+    -> [Blessings WText]
 renderTreeView q@State{..} =
     renderNode
   where
@@ -75,7 +77,7 @@ renderTreeView q@State{..} =
         maybe mempty renderSubForest
 
 
-renderPrefix :: State -> Z.TreePos Z.Full TreeView -> Blessings String
+renderPrefix :: State -> Z.TreePos Z.Full TreeView -> Blessings WText
 renderPrefix state =
     mconcat . reverse . zipWith (curry prefix) [(1 :: Int)..] . Z.path
   where
@@ -102,7 +104,7 @@ spacePrefix
     , teePrefix
     , pipePrefix
     , endPrefix
-    :: State -> Blessings String
+    :: State -> Blessings WText
 spacePrefix q = color prefix (colorConfig q) "  "
 teePrefix q = color prefix (colorConfig q) "├╴"
 pipePrefix q = color prefix (colorConfig q) "│ "
@@ -112,12 +114,12 @@ endPrefix q = color prefix (colorConfig q) "└╴"
 -- TODO locale-style: headerKey = \s -> SGR [..] (s <> ": ")
 
 
-renderTreeView1 :: State -> Bool -> TreeView -> Blessings String
+renderTreeView1 :: State -> Bool -> TreeView -> Blessings WText
 renderTreeView1 q@State{..} hasFocus x = case x of
 
     TVSearch s ->
         let c = if hasFocus then color focus colorConfig else color search colorConfig
-        in c $ Plain s
+        in c $ fromString s
 
     TVSearchResult sr ->
         let c
@@ -131,9 +133,9 @@ renderTreeView1 q@State{..} hasFocus x = case x of
 
             isUnread = "unread" `elem` Notmuch.searchTags sr
 
-            authors = Plain $ T.unpack $ Notmuch.searchAuthors sr
+            authors = Plain $ WText $ Notmuch.searchAuthors sr
             date = color Much.State.date colorConfig $ renderDate now x
-            subject = quoteSpecials $ Plain $ T.unpack $ Notmuch.searchSubject sr
+            subject = quoteSpecialsPlain (WText $ Notmuch.searchSubject sr)
             tags = color Much.State.tags colorConfig $ renderTags q (Notmuch.searchTags sr)
             title = if subject /= "" then subject else c_authors authors
         in
@@ -151,88 +153,74 @@ renderTreeView1 q@State{..} hasFocus x = case x of
 
     TVMessageHeaderField m fieldName ->
         let c = if hasFocus then color focus colorConfig else color boring colorConfig
-            k = Plain $ T.unpack $ CI.original fieldName
+            k = Plain $ WText $ CI.original fieldName
             v = maybe "nothing"
-                      (Plain . T.unpack)
+                      (Plain . WText)
                       (M.lookup fieldName $ Notmuch.messageHeaders m)
         in c $ k <> ": " <> v
 
     TVMessagePart _ p ->
         let c = if hasFocus then color focus colorConfig else color boring colorConfig
-            i = Plain $ show $ Notmuch.partID p
-            t = Plain $ T.unpack $ CI.original $ Notmuch.partContentType p
-            filename = maybe "" (Plain . (" "<>) . show) $ Notmuch.partContentFilename p
-            charset = maybe "" (Plain . (" "<>) . show) $ Notmuch.partContentCharset p
-            size = Plain $ show $ Notmuch.contentSize (Notmuch.partContent p)
+            i = fromString $ show $ Notmuch.partID p
+            t = Plain $ WText $ CI.original $ Notmuch.partContentType p
+            filename = maybe "" (fromString . (" "<>) . show) $ Notmuch.partContentFilename p
+            charset = maybe "" (fromString . (" "<>) . show) $ Notmuch.partContentCharset p
+            size = fromString $ show $ Notmuch.contentSize (Notmuch.partContent p)
         in c $ "part#" <> i <> " " <> t <> filename <> charset <> " " <> size
 
     TVMessageQuoteLine _ _ _ s ->
         if hasFocus
-            then color focus colorConfig $ Plain s
-            else color quote colorConfig $ Plain s
+            then color focus colorConfig $ fromString s
+            else color quote colorConfig $ fromString s
 
     TVMessageRawLine _ _ _ s ->
-        mconcat . map (uncurry renderClassifiedString) $ classifiedGroupBy isPrint s
+        quoteSpecialsPlain' printableColor unprintableColor (fromString s)
       where
-        renderClassifiedString :: Bool -> String -> Blessings String
-        renderClassifiedString = \case
-            True -> printableColor . Plain
-            False -> unprintableColor . Plain . showLitChar'
-
         (printableColor, unprintableColor) =
             if hasFocus
               then (color focus colorConfig, color unprintableFocus colorConfig)
               else (color quote colorConfig, color unprintableNormal colorConfig)
 
-        showLitChar' :: String -> String
-        showLitChar' = (>>= f)
-          where f '\ESC' = "^["
-                f c = showLitChar c ""
-
-        classifiedGroupBy :: Eq b => (a -> b) -> [a] -> [(b, [a])]
-        classifiedGroupBy f =
-            map (f . head &&& id) . L.groupBy ((==) `on` f)
-
     TVMessageLine _ _ _ s ->
         if hasFocus
-            then color focus colorConfig $ Plain s
-            else Plain s
+            then color focus colorConfig $ fromString s
+            else fromString s
 
 
 
-renderDate :: UTCTime -> TreeView -> Blessings String
+renderDate :: UTCTime -> TreeView -> Blessings WText
 renderDate now = \case
     TVSearchResult sr -> f humanTimeLocale (Notmuch.searchTime sr)
     TVMessage m -> f humanTimeLocale (Notmuch.messageTime m)
     _ -> SGR [35,1] "timeless"
   where
     f timeLocale time =
-        Plain $ humanReadableTimeI18N' timeLocale now time
+        Plain $ fromString $ humanReadableTimeI18N' timeLocale now time
 
 
-renderFrom :: Maybe T.Text -> Blessings String
+renderFrom :: Maybe T.Text -> Blessings WText
 renderFrom = \case
     Just fromLine ->
       Plain $
         case readFrom (T.unpack fromLine) of
-          ("", address) -> address
-          (name, _) -> name
+          ("", address) -> fromString address
+          (name, _) -> fromString name
     Nothing ->
       SGR [35,1] "Anonymous"
 
 
-renderTags :: State -> [Tag] -> Blessings String
+renderTags :: State -> [Tag] -> Blessings WText
 renderTags state =
     -- TODO sort somewhere else
     mconcat . L.intersperse " " . map (renderTag state) . L.sort
 
 
-renderTag :: State -> Tag -> Blessings String
+renderTag :: State -> Tag -> Blessings WText
 renderTag state tag = case M.lookup tag $ runIdentity $ tagMap $ colorConfig state of
     Just visual -> SGR (runIdentity visual) plain
     Nothing -> plain
   where
-    plain = Plain $ T.unpack $ fromMaybe tag $ M.lookup tag (aliases state)
+    plain = Plain $ WText $ fromMaybe tag $ M.lookup tag (aliases state)
 
 
 readFrom :: String -> (String, String)