From 63bf1907d3e6629ac21da87b9e45303bcec2bdf9 Mon Sep 17 00:00:00 2001
From: tv <tv@krebsco.de>
Date: Wed, 30 Sep 2020 11:45:41 +0200
Subject: render non-text parts

---
 src/Much/API.hs            |  1 +
 src/Much/Core.hs           |  4 ++++
 src/Much/RenderTreeView.hs | 24 ++++++++++++++++++++++++
 src/Much/State.hs          |  2 ++
 src/Much/TreeView.hs       |  9 +++++++++
 src/Much/TreeView/Types.hs |  4 ++++
 6 files changed, 44 insertions(+)

(limited to 'src/Much')

diff --git a/src/Much/API.hs b/src/Much/API.hs
index 0c1bf8d..a9999ef 100644
--- a/src/Much/API.hs
+++ b/src/Much/API.hs
@@ -84,6 +84,7 @@ main Config{socketPath} putEvent = do
         TVMessageHeaderField m _    -> notmuchId m
         TVMessagePart m _           -> notmuchId m
         TVMessageQuoteLine m _ _ _  -> notmuchId m
+        TVMessageRawLine m _ _ _    -> notmuchId m
         TVMessageLine m _ _ _       -> notmuchId m
         TVSearch s                  -> s
         TVSearchResult r            -> notmuchId r
diff --git a/src/Much/Core.hs b/src/Much/Core.hs
index b0f9a51..47d6706 100644
--- a/src/Much/Core.hs
+++ b/src/Much/Core.hs
@@ -60,6 +60,8 @@ emptyState = State
         , alt = SGR [38,5,182]
         , search = SGR [38,5,162]
         , focus = SGR [38,5,160]
+        , unprintableFocus = SGR [38,5,204]
+        , unprintableNormal = SGR [35]
         , quote = SGR [38,5,242]
         , boring = SGR [38,5,240]
         , prefix = SGR [38,5,235]
@@ -95,6 +97,8 @@ importConfig config state = state
       , search = fromColorConfig search search
       , focus = fromColorConfig focus focus
       , quote = fromColorConfig quote quote
+      , unprintableFocus = fromColorConfig unprintableFocus unprintableFocus
+      , unprintableNormal = fromColorConfig unprintableNormal unprintableNormal
       , boring = fromColorConfig boring boring
       , prefix = fromColorConfig prefix prefix
       , date = fromColorConfig date date
diff --git a/src/Much/RenderTreeView.hs b/src/Much/RenderTreeView.hs
index d5999b2..d16a75c 100644
--- a/src/Much/RenderTreeView.hs
+++ b/src/Much/RenderTreeView.hs
@@ -13,7 +13,9 @@ import qualified Data.Text as T
 import qualified Data.Tree.Zipper as Z
 import qualified Much.TreeZipperUtils as Z
 import Blessings
+import Control.Arrow
 import Data.Char
+import Data.Function
 import Data.Maybe
 import Data.Time
 import Data.Time.Format.Human
@@ -166,6 +168,28 @@ renderTreeView1 q@State{..} hasFocus x = case x of
             then focus colorConfig $ Plain s
             else quote colorConfig $ Plain s
 
+    TVMessageRawLine _ _ _ s ->
+        mconcat . map (uncurry renderClassifiedString) $ classifiedGroupBy isPrint s
+      where
+        renderClassifiedString :: Bool -> String -> Blessings String
+        renderClassifiedString = \case
+            True -> printableColor . Plain
+            False -> unprintableColor . Plain . showLitChar'
+
+        (printableColor, unprintableColor) =
+            if hasFocus
+              then (focus colorConfig, unprintableFocus colorConfig)
+              else (quote colorConfig, 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 focus colorConfig $ Plain s
diff --git a/src/Much/State.hs b/src/Much/State.hs
index b7b01e6..8bc2de9 100644
--- a/src/Much/State.hs
+++ b/src/Much/State.hs
@@ -49,6 +49,8 @@ data ColorConfig a = ColorConfig
     , unreadMessage :: a
     , boringMessage :: a
     , tagMap :: M.Map T.Text a
+    , unprintableFocus :: a
+    , unprintableNormal :: a
     } deriving (Generic, Show)
 
 instance FromJSON a => FromJSON (ColorConfig a)
diff --git a/src/Much/TreeView.hs b/src/Much/TreeView.hs
index 9487f74..e963497 100644
--- a/src/Much/TreeView.hs
+++ b/src/Much/TreeView.hs
@@ -18,6 +18,7 @@ module Much.TreeView
     ) where
 
 
+import qualified Data.ByteString.Lazy.Char8 as LBS8
 import qualified Data.Text as T
 import Data.Tree
 import Notmuch
@@ -94,6 +95,8 @@ xconvPart m p =
     contents = case partContent p of
         ContentText t ->
             zipWith (curry $ xconvLine m p) [0..] (T.lines t)
+        ContentRaw raw _ ->
+            zipWith (xconvRawLine m p) [0..] (lines . LBS8.unpack $ raw)
         ContentMultipart parts ->
             map (xconvPart m) parts
         ContentMsgRFC822 _ ->
@@ -111,6 +114,12 @@ xconvLine m p (i, s) =
             else TVMessageLine
 
 
+xconvRawLine
+  :: Message -> MessagePart -> LineNr -> String -> Tree TreeView
+xconvRawLine m p i s =
+    Node (TVMessageRawLine m p i s) []
+
+
 isQuoteLine :: T.Text -> Bool
 isQuoteLine s0 = do
     let s = T.stripStart s0
diff --git a/src/Much/TreeView/Types.hs b/src/Much/TreeView/Types.hs
index 6e4ac6b..f30b0bc 100644
--- a/src/Much/TreeView/Types.hs
+++ b/src/Much/TreeView/Types.hs
@@ -16,6 +16,7 @@ data TreeView
     | TVMessageHeaderField Message (CI.CI T.Text)
     | TVMessagePart Message MessagePart
     | TVMessageQuoteLine Message MessagePart LineNr String
+    | TVMessageRawLine Message MessagePart LineNr String
     | TVMessageLine Message MessagePart LineNr String
     | TVSearch String
     | TVSearchResult SearchResult
@@ -53,6 +54,9 @@ treeViewId = \case
     TVMessageQuoteLine m mp lineNr _ ->
         TVIDMessageLine (fromMessage m) (partID mp) lineNr
 
+    TVMessageRawLine m mp lineNr _ ->
+        TVIDMessageLine (fromMessage m) (partID mp) lineNr
+
     TVSearch s ->
         TVIDSearch (T.pack s)
 
-- 
cgit v1.2.3