html render html parts with lynx

1 files changed, 21 insertions, 1 deletions

diff --git a/src/Much/TreeView.hs b/src/Much/TreeView.hs
index e963497..9b309bc 100644
--- a/src/Much/TreeView.hs
+++ b/src/Much/TreeView.hs
@@ -25,6 +25,8 @@ import Notmuch
 import Notmuch.Message
 import Notmuch.SearchResult
 import Much.TreeView.Types as Export
+import System.Exit (ExitCode(ExitSuccess))
+import System.Process.ByteString.Lazy (readProcessWithExitCode)
 
 
 getMessage :: TreeView -> Maybe Message
@@ -144,8 +146,26 @@ loadSubForest = \case
             . findFirsts messageMatch
             <$> notmuchShow (termFromMessage m)
 
+    TVMessagePart m mp@MessagePart{partContentType="text/html"} ->
+      notmuchShowPartRaw (termFromMessage m) (partID mp) >>= \case
+          Left e -> return $ Left $ show e
+          Right html ->
+            readProcessWithExitCode
+                "lynx"
+                [ "-dump"
+                , "-nomargins"
+                , "-stdin"
+                ]
+                html
+              >>= \case
+                (ExitSuccess, out, _err) ->
+                  return $ Right $
+                    zipWith (\i s -> Node (TVMessageLine m mp i s) []) [0..] (lines . LBS8.unpack $ out)
+
+                (exitCode, _out, err) ->
+                  return $ Left $ show exitCode <> ": " <> LBS8.unpack err
+
     TVMessagePart m mp ->
-        -- TODO parse --format=raw
         notmuchShowPart (termFromMessage m) (partID mp) >>= return . \case
             Left e -> Left $ show e
             Right mp' ->