25 files changed, 318 insertions, 283 deletions

diff --git a/app/much.hs b/app/much.hs
index 84eda6b..fb84186 100644
--- a/app/much.hs
+++ b/app/much.hs
@@ -1,25 +1,24 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 
 module Main (main) where
 
-import Blessings.String.WCWidth
 import Data.Default
 import Data.Maybe
+import Data.String (fromString)
+import Data.Tree qualified as Tree
+import Data.Tree.Zipper qualified as Z
+import Much.API qualified
 import Much.Action
 import Much.Core
 import Much.State
 import Much.TreeView
+import Notmuch.Message qualified as Notmuch
 import Scanner
 import System.Environment (getEnv)
 import System.IO.Unsafe (unsafePerformIO)
 import Text.Hyphenation
 import Text.LineBreak
-import qualified Data.Tree as Tree
-import qualified Data.Tree.Zipper as Z
-import qualified Much.API
-import qualified Notmuch.Message as Notmuch
 
 
 scrollLines :: Int
@@ -43,6 +42,7 @@ myKeymap :: String -> State -> IO State
 
 myKeymap "a" = toggleTagAtCursor "inbox"
 myKeymap "s" = toggleTagAtCursor "unread"
+myKeymap "S" = toggleTagAtCursor "spam"
 myKeymap "g" = toggleTagAtCursor "killed"
 myKeymap "f" = toggleTagAtCursor "star"
 myKeymap "&" = toggleTagAtCursor "killed"
@@ -99,13 +99,15 @@ myKeymap "=" = \q@State{..} ->
         bf = BreakFormat 80 8 shy hyp
 
 -- <F1>
+myKeymap "\ESCOP" = myKeymap "\ESC[11~"
 myKeymap "\ESC[11~" = \q@State{..} ->
-    return q { flashMessage = Plain $ show $ treeViewId $ Z.label cursor }
+    return q { flashMessage = fromString $ show $ treeViewId $ Z.label cursor }
 
 -- <F2>
+myKeymap "\ESCOQ" = myKeymap "\ESC[12~"
 myKeymap "\ESC[12~" = \q@State{..} ->
     return q { flashMessage =
-                  Plain $
+                  fromString $
                   show $
                   maybe Nothing (Just . Notmuch.messageFilename) $
                   getMessage $
@@ -113,8 +115,8 @@ myKeymap "\ESC[12~" = \q@State{..} ->
               }
 
 -- TODO Stuff Vim sends after exit (also there is more...)
-myKeymap "\ESC[2;2R" = \q -> return q { flashMessage = flashMessage q <> " " <> Plain "stupid" }
-myKeymap "\ESC[>85;95;0c" = \q -> return q { flashMessage = flashMessage q <> " " <> Plain "stupid" }
+myKeymap "\ESC[2;2R" = \q -> return q { flashMessage = flashMessage q <> " " <> "stupid" }
+myKeymap "\ESC[>85;95;0c" = \q -> return q { flashMessage = flashMessage q <> " " <> "stupid" }
 
 myKeymap s = displayKey s
 
diff --git a/much.cabal b/much.cabal
index 9615dee..2088d61 100644
--- a/much.cabal
+++ b/much.cabal
@@ -1,6 +1,6 @@
 cabal-version:  3.8
 name:           much
-version:        1.4.0
+version:        1.4.2
 license:        MIT
 author:         tv <tv@krebsco.de>
 maintainer:     tv@krebsco.de
@@ -8,13 +8,15 @@ build-type:     Simple
 
 common common-stuff
   build-depends:
-    blessings >= 2.5.0
+      blessings >= 3.0.0
+    , mono-traversable
+    , text-wcwidth
 
 executable much
   import:           common-stuff
   hs-source-dirs:   app
   main-is:          much.hs
-  default-language: Haskell2010
+  default-language: GHC2024
   ghc-options:      -O2 -threaded -with-rtsopts=-N
   build-depends:    much
                   , base
@@ -59,7 +61,7 @@ library
                  , Notmuch.Class
                  , Notmuch.Message
                  , Notmuch.SearchResult
-  other-modules:   Blessings.String.Extra
+  other-modules:   Blessings.Extra
                  , Codec.MIME.Base64
                  , Codec.MIME.Decode
                  , Codec.MIME.Parse
@@ -67,6 +69,7 @@ library
                  , Codec.MIME.Type
                  , Data.Aeson.Extends
                  , Data.Tree.Extra
+                 , Data.WText.Aeson
   build-depends:   base
                  , aeson
                  , attoparsec
@@ -105,5 +108,5 @@ library
                  , vector
                  , wai
                  , warp
-  default-language: Haskell2010
+  default-language: GHC2024
   ghc-options: -O2 -Wall
diff --git a/src/Blessings/Extra.hs b/src/Blessings/Extra.hs
new file mode 100644
index 0000000..caa8e2d
--- /dev/null
+++ b/src/Blessings/Extra.hs
@@ -0,0 +1,37 @@
+module Blessings.Extra where
+
+import Blessings
+import Data.Char (isPrint,showLitChar)
+import Data.MonoTraversable (Element, oall, ofoldMap)
+import Data.Sequences (singleton)
+import Data.String (fromString)
+
+quoteSpecials :: (Blessable a, Element a ~ Char) => Blessings a -> Blessings a
+quoteSpecials = cataBlessings quoteSpecialsPlain SGR Append
+
+quoteSpecialsPlain :: (Blessable a, Element a ~ Char) => a -> Blessings a
+quoteSpecialsPlain =
+    quoteSpecialsPlain' id (SGR [35])
+
+quoteSpecialsPlain'
+    :: forall a. (Blessable a, Element a ~ Char)
+    => (Blessings a -> Blessings a)
+    -> (Blessings a -> Blessings a)
+    -> a
+    -> Blessings a
+quoteSpecialsPlain' printable unprintable s =
+    if oall isPrint s
+      then printable (Plain s)
+      else normalize (ofoldMap quoteSpecialChar s)
+  where
+
+    quoteSpecialChar :: (Blessable a, Element a ~ Char) => Char -> Blessings a
+    quoteSpecialChar c =
+        if isPrint c
+          then printable (Plain (singleton c))
+          else unprintable (Plain (fromString (showLitChar' c)))
+
+    showLitChar' :: Char -> String
+    showLitChar' = \case
+        '\ESC' -> "^["
+        c -> showLitChar c ""
diff --git a/src/Blessings/String/Extra.hs b/src/Blessings/String/Extra.hs
deleted file mode 100644
index 51d13eb..0000000
--- a/src/Blessings/String/Extra.hs
+++ /dev/null
@@ -1,41 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-module Blessings.String.Extra where
-
-import Blessings
-import Control.Arrow ((&&&))
-import Data.Char (isPrint,showLitChar)
-import Data.Function (on)
-import Data.List (groupBy)
-
-
-quoteSpecials :: Blessings String -> Blessings String
-quoteSpecials = \case
-  Plain s -> quoteSpecials' s
-  SGR pm x -> SGR pm (quoteSpecials x)
-  Append a b -> Append (quoteSpecials a) (quoteSpecials b)
-  Empty -> Empty
-
-
-quoteSpecials' :: String -> Blessings String
-quoteSpecials' 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) =
-        (id, SGR [35])
-        --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) . groupBy ((==) `on` f)
diff --git a/src/Data/Aeson/Extends.hs b/src/Data/Aeson/Extends.hs
index d78f81d..2905e60 100644
--- a/src/Data/Aeson/Extends.hs
+++ b/src/Data/Aeson/Extends.hs
@@ -1,10 +1,9 @@
 module Data.Aeson.Extends (module Data.Aeson.Extends) where
 
 import Data.Aeson as Data.Aeson.Extends
-
-import qualified Data.ByteString.Lazy as LBS
-import qualified Data.Text.Encoding.Error as TE
-import qualified Data.Text.Lazy.Encoding as LT
+import Data.ByteString.Lazy qualified as LBS
+import Data.Text.Encoding.Error qualified as TE
+import Data.Text.Lazy.Encoding qualified as LT
 
 
 eitherDecodeLenient' :: FromJSON a => LBS.ByteString -> Either String a
diff --git a/src/Data/WText/Aeson.hs b/src/Data/WText/Aeson.hs
new file mode 100644
index 0000000..06aa4fb
--- /dev/null
+++ b/src/Data/WText/Aeson.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE DerivingVia #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Data.WText.Aeson where
+
+import Data.Aeson (FromJSON, ToJSON)
+import Data.Text (Text)
+import Data.WText (WText(WText))
+
+
+deriving via Text instance FromJSON WText
+deriving via Text instance ToJSON WText
diff --git a/src/Much/API.hs b/src/Much/API.hs
index a9999ef..5ddf2c6 100644
--- a/src/Much/API.hs
+++ b/src/Much/API.hs
@@ -1,8 +1,4 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeOperators #-}
 
 module Much.API (module Much.API) where
 
@@ -11,6 +7,7 @@ import Control.Exception (catch, finally, throwIO)
 import Control.Monad.IO.Class
 import Data.Function ((&))
 import Data.Proxy (Proxy)
+import Data.Tree.Zipper qualified as Z
 import Much.API.Config as Much.API
 import Much.Event
 import Much.State
@@ -23,7 +20,6 @@ import Notmuch.Message
 import Servant
 import System.IO.Error (isDoesNotExistError)
 import System.Posix.Files (removeLink)
-import qualified Data.Tree.Zipper as Z
 
 
 type API =
diff --git a/src/Much/Action.hs b/src/Much/Action.hs
index d76e503..102bc2c 100644
--- a/src/Much/Action.hs
+++ b/src/Much/Action.hs
@@ -1,29 +1,31 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+
 module Much.Action where
 
-import Blessings.String.WCWidth
+import Blessings (Blessings(SGR))
 import Data.Maybe
+import Data.String (fromString)
 import Data.Tree.Extra (setSubForest)
-import Scanner
+import Data.Tree.Zipper qualified as Z
 import Much.State
 import Much.TagUtils
 import Much.TreeSearch
 import Much.TreeView
 import Much.TreeZipperUtils
-import qualified Data.Tree.Zipper as Z
-import qualified Notmuch
-import qualified Notmuch.Message as Notmuch
-import qualified Notmuch.SearchResult as Notmuch
+import Notmuch qualified
+import Notmuch.Message qualified as Notmuch
+import Notmuch.SearchResult qualified as Notmuch
+import Scanner
+
 
 displayKey :: String -> State -> IO State
-displayKey s q = return q { flashMessage = Plain $ show s }
+displayKey s q = return q { flashMessage = fromString (show s) }
 
 
 displayMouse :: Scan -> State -> IO State
 displayMouse info q =
-    return q { flashMessage = SGR [38,5,202] $ Plain $ show info }
+    return q { flashMessage = SGR [38,5,202] $ fromString (show info) }
 
 defaultMouse1Click :: Monad m => Int -> State -> m State
 defaultMouse1Click y q@State{..} = do
@@ -35,7 +37,7 @@ defaultMouse1Click y q@State{..} = do
     case linearClickPos of
         Nothing ->
             return q
-                { flashMessage = Plain "nothing to click"
+                { flashMessage = "nothing to click"
                 }
         Just i ->
             return q
@@ -162,7 +164,7 @@ openFold q@State{..} =
   where
     handle = \case
         Left err ->
-            q { flashMessage = SGR [31] $ Plain err }
+            q { flashMessage = SGR [31] $ fromString err }
         Right sf ->
             q { cursor = Z.modifyTree (setSubForest sf) cursor }
 
diff --git a/src/Much/Config.hs b/src/Much/Config.hs
index 36f06bf..1aa8f44 100644
--- a/src/Much/Config.hs
+++ b/src/Much/Config.hs
@@ -1,11 +1,11 @@
-{-# LANGUAGE DeriveGeneric #-}
 module Much.Config where
 
-import GHC.Generics (Generic)
 import Data.Aeson (FromJSON)
+import Data.Map qualified as M
+import Data.Text qualified as T
+import GHC.Generics (Generic)
 import Much.State (ColorConfig)
-import qualified Data.Text as T
-import qualified Data.Map as M
+
 
 data Config = Config
   { colorConfig :: Maybe (ColorConfig Maybe)
diff --git a/src/Much/Core.hs b/src/Much/Core.hs
index 1c8daa7..b7f833a 100644
--- a/src/Much/Core.hs
+++ b/src/Much/Core.hs
@@ -1,38 +1,42 @@
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+
 module Much.Core where
 
-import Blessings.String.WCWidth (Blessings(Plain,SGR),pp)
+import Blessings (Blessings(SGR),pp)
 import Control.Concurrent
 import Control.Monad
 import Data.Aeson
 import Data.Functor
 import Data.Functor.Identity
+import Data.Map qualified as M
 import Data.Maybe
+import Data.MonoTraversable (ointercalate)
+import Data.Sequences qualified as S
+import Data.String (fromString)
+import Data.Text qualified as T
+import Data.Text.IO qualified as T
 import Data.Time
+import Data.Tree.Zipper qualified as Z
+import Data.WText (WText(unWText))
 import Much.API
 import Much.Action
+import Much.Config qualified as Config
 import Much.Event
 import Much.RenderTreeView (renderTreeView)
 import Much.Screen
 import Much.State
 import Much.TreeSearch
 import Much.TreeView
-import Much.Utils
+import Notmuch qualified
 import Options.Applicative
 import Scanner (scan,Scan(..))
+import System.Console.Terminal.Size qualified as Term
 import System.Environment
 import System.Exit
 import System.IO
 import System.Posix.Signals
-import qualified Blessings.Internal as Blessings
-import qualified Data.Map as M
-import qualified Data.Tree.Zipper as Z
-import qualified Much.Config as Config
-import qualified Notmuch
-import qualified System.Console.Terminal.Size as Term
+
 
 importConfig :: Config.Config -> State -> State
 importConfig config state = state
@@ -180,13 +184,13 @@ processEvent q = \case
     EResize w h ->
         return $ Right q
             { screenWidth = w, screenHeight = h
-            , flashMessage = Plain $ "resize " <> show (w,h)
+            , flashMessage = fromString $ "resize " <> show (w,h)
             }
     EStateGet f ->
         forkIO (f q) $> Right q
     ev ->
         return $ Right q
-            { flashMessage = SGR [31,1] $ Plain $ "unhandled event: " <> show ev
+            { flashMessage = SGR [31,1] $ fromString $ "unhandled event: " <> show ev
             }
 
 
@@ -198,18 +202,18 @@ render q@State{..} =
   where
     newTreeBuf = renderTreeView q (Z.root cursor)
     newHeadBuf =
-        [ Plain (show screenWidth) <> "x" <> Plain (show screenHeight)
-          <> " " <> Plain (show $ linearPos cursor - yoffset)
-          <> " " <> Plain (show $ topOverrun q)
-          <> " " <> Plain (show $ botOverrun q)
+        [ fromString (show screenWidth) <> "x" <> fromString (show screenHeight)
+          <> " " <> fromString (show $ linearPos cursor - yoffset)
+          <> " " <> fromString (show $ topOverrun q)
+          <> " " <> fromString (show $ botOverrun q)
           <> " " <> flashMessage
-          <> " " <> Plain (show (xoffset, yoffset))
+          <> " " <> fromString (show (xoffset, yoffset))
         ]
 
-render0 :: State -> [Blessings String]
+render0 :: State -> [Blessings WText]
 render0 _q@State{..} = do
     let buffer =
-            map (Blessings.take screenWidth . Blessings.drop xoffset) $
+            map (S.take screenWidth . S.drop xoffset) $
             take screenHeight $
             headBuffer ++ drop yoffset treeBuffer
     buffer ++ replicate (screenHeight - length buffer) "~"
@@ -217,11 +221,11 @@ render0 _q@State{..} = do
 
 redraw :: State -> IO ()
 redraw q@State{..} = do
-    hPutStr stdout $ map (sub '\t' ' ') $ "\ESC[H" ++ pp (mintercalate "\n" $ map eraseRight $ render0 q)
+    T.hPutStr stdout $ T.map (sub '\t' ' ') $ unWText $ "\ESC[H" <> pp (ointercalate "\n" $ map eraseRight $ render0 q)
     hFlush stdout
   where
     sub x x' c = if c == x then x' else c
     eraseRight s =
-        if Blessings.length s < screenWidth
+        if S.lengthIndex s < screenWidth
             then s <> "\ESC[K"
             else s
diff --git a/src/Much/Event.hs b/src/Much/Event.hs
index 5edb5d2..76b3a05 100644
--- a/src/Much/Event.hs
+++ b/src/Much/Event.hs
@@ -1,11 +1,12 @@
 module Much.Event where
 
 import Blessings
+import Data.WText (WText)
 import Much.State
 import Scanner
 
 data Event =
-    EFlash (Blessings String) |
+    EFlash (Blessings WText) |
     EScan Scan |
     EShutdown |
     EReload |
diff --git a/src/Much/MBox.hs b/src/Much/MBox.hs
index 9299eea..5c7c0a6 100644
--- a/src/Much/MBox.hs
+++ b/src/Much/MBox.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+
 module Much.MBox
     (
       -- TODO don't re-export MBox but use our own Message type
@@ -8,28 +9,27 @@ module Much.MBox
     , toForest
     ) where
 
-import qualified Data.MBox as Export
-
-import           Control.Applicative
-import qualified Data.CaseInsensitive as CI
-import qualified Data.List as List
-import           Data.Map.Strict   (Map)
-import qualified Data.Map.Strict as Map
-import           Data.Maybe
-import           Data.MBox
-import           Data.Ord
-import           Data.Set   (Set)
-import qualified Data.Set as Set
-import           Data.Text.Lazy   (Text)
-import           Data.Time
-import           Data.Tree   (Tree, Forest)
-import qualified Data.Tree as Tree
-import qualified MappedSets
-import qualified Data.Text.Lazy as Text
-import           Safe
-import           System.Locale
-import qualified Text.ParserCombinators.Parsec.Rfc2822 as P
-import qualified Text.ParserCombinators.Parsec as P
+import Control.Applicative
+import Data.CaseInsensitive qualified as CI
+import Data.List qualified as List
+import Data.MBox
+import Data.MBox qualified as Export
+import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as Map
+import Data.Maybe
+import Data.Ord
+import Data.Set (Set)
+import Data.Set qualified as Set
+import Data.Text.Lazy (Text)
+import Data.Text.Lazy qualified as Text
+import Data.Time
+import Data.Tree (Tree, Forest)
+import Data.Tree qualified as Tree
+import MappedSets qualified
+import Safe
+import System.Locale
+import Text.ParserCombinators.Parsec qualified as P
+import Text.ParserCombinators.Parsec.Rfc2822 qualified as P
 
 
 type Ident = Text
diff --git a/src/Much/MappedSets.hs b/src/Much/MappedSets.hs
index ec0ae73..7db2279 100644
--- a/src/Much/MappedSets.hs
+++ b/src/Much/MappedSets.hs
@@ -1,11 +1,11 @@
 module Much.MappedSets (invert, mk) where
 
-import           Control.Arrow
-import           Data.Map.Strict   (Map)
-import qualified Data.Map.Strict as Map
-import           Data.Maybe
-import           Data.Set   (Set)
-import qualified Data.Set as Set
+import Control.Arrow
+import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as Map
+import Data.Maybe
+import Data.Set (Set)
+import Data.Set qualified as Set
 
 
 mk :: (Ord a, Ord b) => [(a, [b])] -> Map a (Set b)
diff --git a/src/Much/ParseMail.hs b/src/Much/ParseMail.hs
index d9bb733..6644db6 100644
--- a/src/Much/ParseMail.hs
+++ b/src/Much/ParseMail.hs
@@ -1,26 +1,24 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Much.ParseMail (readMail) where
 
-import qualified Data.Attoparsec.ByteString.Char8 as A8
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Char8 as BS8
-import qualified Data.ByteString.Lazy as LBS
-import qualified Data.CaseInsensitive as CI
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
-import qualified Data.Text.Lazy as LT
-import qualified Data.Text.Lazy.Encoding as LT
-import qualified Network.Email.Header.Parser as P
-import qualified Network.Email.Header.Types as H
-import qualified Network.Mail.Mime as M
 import Codec.MIME.Parse
-import qualified Codec.MIME.QuotedPrintable as QP
+import Codec.MIME.QuotedPrintable qualified as QP
 import Codec.MIME.Type
 import Control.Applicative
+import Data.Attoparsec.ByteString.Char8 qualified as A8
+import Data.ByteString qualified as BS
+import Data.ByteString.Char8 qualified as BS8
+import Data.ByteString.Lazy qualified as LBS
+import Data.CaseInsensitive qualified as CI
 import Data.Char
-
+import Data.Text qualified as T
+import Data.Text.Encoding qualified as T
+import Data.Text.Lazy qualified as LT
+import Data.Text.Lazy.Encoding qualified as LT
+import Network.Email.Header.Parser qualified as P
+import Network.Email.Header.Types qualified as H
+import Network.Mail.Mime qualified as M
 
 
 -- TODO eventually we want our completely own Address, i.e. w/o M.Address
diff --git a/src/Much/RenderTreeView.hs b/src/Much/RenderTreeView.hs
index ea81fe2..f1eaf6e 100644
--- a/src/Much/RenderTreeView.hs
+++ b/src/Much/RenderTreeView.hs
@@ -1,32 +1,33 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 
 module Much.RenderTreeView (renderTreeView) where
 
-import qualified Notmuch.Message as Notmuch
-import qualified Notmuch.SearchResult as Notmuch
-import qualified Data.CaseInsensitive as CI
-import qualified Data.List as L
-import qualified Data.Map as M
-import qualified Data.Text as T
-import qualified Data.Tree.Zipper as Z
-import qualified Much.TreeZipperUtils as Z
 import Blessings
-import Blessings.String.Extra (quoteSpecials)
+import Blessings.Extra (quoteSpecialsPlain, quoteSpecialsPlain')
 import Control.Arrow
+import Data.CaseInsensitive qualified as CI
 import Data.Char
-import Data.Function
 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
+import Much.TreeZipperUtils qualified as Z
+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
@@ -54,7 +55,7 @@ humanTimeLocale = defaultHumanTimeLocale
 renderTreeView
     :: State
     -> Z.TreePos Z.Full TreeView
-    -> [Blessings String]
+    -> [Blessings WText]
 renderTreeView q@State{..} =
     renderNode
   where
@@ -76,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
@@ -103,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) "│ "
@@ -113,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
@@ -132,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
@@ -152,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)
diff --git a/src/Much/Screen.hs b/src/Much/Screen.hs
index 47bb90c..9d75728 100644
--- a/src/Much/Screen.hs
+++ b/src/Much/Screen.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE RecordWildCards #-}
+
 module Much.Screen (Screen(..), setScreen, withScreen) where
 
 import Control.Exception
diff --git a/src/Much/State.hs b/src/Much/State.hs
index a1de01f..30716a1 100644
--- a/src/Much/State.hs
+++ b/src/Much/State.hs
@@ -1,34 +1,35 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE OverloadedStrings #-}
+
 module Much.State where
 
 import Blessings
 import Data.Aeson
+import Data.CaseInsensitive qualified as CI
 import Data.Default
 import Data.Functor.Identity
+import Data.Map qualified as M
+import Data.Text qualified as T
 import Data.Time
+import Data.Tree qualified as Tree
+import Data.Tree.Zipper qualified as Z
+import Data.WText (WText)
 import GHC.Generics
+import Much.API.Config qualified
 import Much.TreeView (TreeView(TVSearch))
+import Notmuch.Message qualified as Notmuch
 import Scanner
 import System.Posix.Signals
-import qualified Data.CaseInsensitive as CI
-import qualified Data.Map as M
-import qualified Data.Text as T
-import qualified Data.Tree as Tree
-import qualified Data.Tree.Zipper as Z
-import qualified Much.API.Config
-import qualified Notmuch.Message as Notmuch
+
 
 data State = State
     { cursor :: Z.TreePos Z.Full TreeView
     , xoffset :: Int
     , yoffset :: Int
-    , flashMessage :: Blessings String
+    , flashMessage :: Blessings WText
     , screenWidth :: Int
     , screenHeight :: Int
-    , headBuffer :: [Blessings String]
-    , treeBuffer :: [Blessings String]
+    , headBuffer :: [Blessings WText]
+    , treeBuffer :: [Blessings WText]
     , now :: UTCTime
     , signalHandlers :: [(Signal, IO ())]
     , query :: String
diff --git a/src/Much/TagUtils.hs b/src/Much/TagUtils.hs
index d4e4d30..d6130e4 100644
--- a/src/Much/TagUtils.hs
+++ b/src/Much/TagUtils.hs
@@ -1,15 +1,13 @@
-{-# LANGUAGE LambdaCase #-}
-
 module Much.TagUtils where
 
-import qualified Data.Set as Set
-import qualified Data.Text as T
 import Data.Char
 import Data.List.Split (wordsBy)
+import Data.Set qualified as Set
+import Data.Text qualified as T
 import Data.Tree
+import Much.TreeView.Types
 import Notmuch.Message
 import Notmuch.SearchResult
-import Much.TreeView.Types
 
 
 type Tag = T.Text
diff --git a/src/Much/TreeView.hs b/src/Much/TreeView.hs
index 9b309bc..b3d36e8 100644
--- a/src/Much/TreeView.hs
+++ b/src/Much/TreeView.hs
@@ -1,8 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RecordWildCards #-}
 
-
 module Much.TreeView
     ( module Export
     , getMessage
@@ -17,14 +15,14 @@ module Much.TreeView
     , hasUnloadedSubForest
     ) where
 
-
-import qualified Data.ByteString.Lazy.Char8 as LBS8
-import qualified Data.Text as T
+import Data.ByteString.Lazy.Char8 qualified as LBS8
+import Data.CaseInsensitive qualified as CI
+import Data.Text qualified as T
 import Data.Tree
+import Much.TreeView.Types as Export
 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)
 
@@ -74,7 +72,7 @@ fromMessageForest = map fromMessageTree
 fromMessageTree :: Tree Message -> Tree TreeView
 fromMessageTree (Node m ms) =
     Node (TVMessage m)
-         (xconvHead m <> xconvBody m <> map fromMessageTree ms)
+         (xconvHead m <> xconvBody m <> fromMessageForest ms)
 
 
 xconvHead :: Message -> Forest TreeView
@@ -87,7 +85,8 @@ xconvHead m =
 
 
 xconvBody :: Message -> Forest TreeView
-xconvBody m = map (xconvPart m) (messageBody m)
+xconvBody m =
+    [xconvPart m (messageBody m)]
 
 
 xconvPart :: Message -> MessagePart -> Tree TreeView
@@ -134,16 +133,16 @@ isQuoteLine s0 = do
 -- Loading / Unloading
 --
 
-
 loadSubForest :: TreeView -> IO (Either String (Forest TreeView))
 loadSubForest = \case
     TVMessage m ->
-        Right
+        pure . Right =<<
+            loadPrimaryMessagePart m =<< id
             . unloadPartsWithFilename
             . map unloadReadSubForests
             . concatMap subForest
             . fromMessageForest
-            . findFirsts messageMatch
+            . findTopmost messageMatch
             <$> notmuchShow (termFromMessage m)
 
     TVMessagePart m mp@MessagePart{partContentType="text/html"} ->
@@ -151,10 +150,8 @@ loadSubForest = \case
           Left e -> return $ Left $ show e
           Right html ->
             readProcessWithExitCode
-                "lynx"
-                [ "-dump"
-                , "-nomargins"
-                , "-stdin"
+                "show"
+                [ T.unpack (CI.foldedCase (partContentType mp))
                 ]
                 html
               >>= \case
@@ -175,7 +172,13 @@ loadSubForest = \case
                     $ xconvPart m mp'
 
     TVSearchResult sr ->
-        Right
+        pure . Right =<<
+            mapM
+              (\case
+                Node tv@(TVMessage m) parts -> Node tv <$> loadPrimaryMessagePart m parts
+                node                        -> pure node
+              )
+            =<< id
             . unloadPartsWithFilename
             . map unloadReadSubForests
             . fromMessageForest
@@ -196,6 +199,36 @@ loadSubForest = \case
     termFromSearchResult = unThreadID . searchThread
 
 
+loadPrimaryMessagePart :: Message -> Forest TreeView -> IO (Forest TreeView)
+loadPrimaryMessagePart m parts =
+    mapM (rewriteTreeIO isPrimaryPart loadNode) parts
+  where
+    pid = partID (primaryMessagePart (messageBody m))
+    mid = messageId m
+
+    isPrimaryPart :: TreeView -> Bool
+    isPrimaryPart = \case
+        TVMessagePart m' mp ->
+            messageId m' == mid && partID mp == pid
+        _ -> False
+
+    loadNode :: Tree TreeView -> IO (Tree TreeView)
+    loadNode node@(Node tv _) =
+        loadSubForest tv >>= \case
+            Right subForest' -> pure (Node tv subForest')
+            Left _           -> pure node
+
+
+rewriteTreeIO :: (a -> Bool) -> (Tree a -> IO (Tree a)) -> Tree a -> IO (Tree a)
+rewriteTreeIO shouldRewrite f t@(Node v children)
+  | shouldRewrite v = do
+      Node v' children' <- f t
+      Node v' <$> mapM (rewriteTreeIO shouldRewrite f) children'
+
+  | otherwise = do
+      Node v <$> mapM (rewriteTreeIO shouldRewrite f) children
+
+
 unloadSubForest :: Tree TreeView -> Forest TreeView
 unloadSubForest t = case rootLabel t of
     TVMessage _ ->
@@ -248,8 +281,8 @@ unloadPartsWithFilename =
         in x' { subForest = map rewriteTree $ subForest x' }
 
 
-findFirsts :: (a -> Bool) -> Forest a -> Forest a
-findFirsts p =
+findTopmost :: (a -> Bool) -> Forest a -> Forest a
+findTopmost p =
     concatMap rec
   where
     rec t@Node{..} =
diff --git a/src/Much/TreeView/Types.hs b/src/Much/TreeView/Types.hs
index f30b0bc..28ed302 100644
--- a/src/Much/TreeView/Types.hs
+++ b/src/Much/TreeView/Types.hs
@@ -1,9 +1,7 @@
-{-# LANGUAGE LambdaCase #-}
-
 module Much.TreeView.Types where
 
-import qualified Data.CaseInsensitive as CI
-import qualified Data.Text as T
+import Data.CaseInsensitive qualified as CI
+import Data.Text qualified as T
 import Notmuch.Message
 import Notmuch.SearchResult
 
diff --git a/src/Much/Utils.hs b/src/Much/Utils.hs
index 80615fc..df23c82 100644
--- a/src/Much/Utils.hs
+++ b/src/Much/Utils.hs
@@ -10,11 +10,6 @@ withTempFile tmpdir template =
     bracket (openTempFile tmpdir template) (removeFile . fst)
 
 
-mintercalate :: Monoid b => b -> [b] -> b
-mintercalate c (h:t) = foldl (\acc x -> acc <> c <> x) h t
-mintercalate _ [] = mempty
-
-
 padl :: Int -> a -> [a] -> [a]
 padl n c s =
     if length s < n
diff --git a/src/Network/Mail/Mime.hs b/src/Network/Mail/Mime.hs
index 8fd9fe1..8c6f580 100644
--- a/src/Network/Mail/Mime.hs
+++ b/src/Network/Mail/Mime.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP, OverloadedStrings #-}
+
 module Network.Mail.Mime
     ( -- * Datatypes
       Boundary (..)
@@ -33,29 +34,30 @@ module Network.Mail.Mime
     , quotedPrintable
     ) where
 
-import qualified Data.ByteString.Lazy as L
-import Blaze.ByteString.Builder.Char.Utf8
 import Blaze.ByteString.Builder
-import System.Random
+import Blaze.ByteString.Builder.Char.Utf8
 import Control.Arrow
-import System.Process
-import System.IO
-import System.Exit
-import System.FilePath (takeFileName)
-import qualified Data.ByteString.Base64 as Base64
-import Control.Monad ((<=<), foldM)
 import Control.Exception (throwIO, ErrorCall (ErrorCall))
-import Data.List (intersperse)
-import qualified Data.Text.Lazy as LT
-import qualified Data.Text.Lazy.Encoding as LT
-import Data.ByteString.Char8 ()
+import Control.Monad ((<=<), foldM)
 import Data.Bits ((.&.), shiftR)
+import Data.ByteString qualified as S
+import Data.ByteString.Base64 qualified as Base64
+import Data.ByteString.Char8 ()
+import Data.ByteString.Lazy qualified as L
 import Data.Char (isAscii)
-import Data.Word (Word8)
-import qualified Data.ByteString as S
+import Data.List (intersperse)
 import Data.Text (Text)
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as TE
+import Data.Text qualified as T
+import Data.Text.Encoding qualified as TE
+import Data.Text.Lazy qualified as LT
+import Data.Text.Lazy.Encoding qualified as LT
+import Data.Word (Word8)
+import System.Exit
+import System.FilePath (takeFileName)
+import System.IO
+import System.Process
+import System.Random
+
 
 -- | Generates a random sequence of alphanumerics of the given length.
 randomString :: RandomGen d => Int -> d -> (String, d)
diff --git a/src/Notmuch.hs b/src/Notmuch.hs
index 310657a..68c3c68 100644
--- a/src/Notmuch.hs
+++ b/src/Notmuch.hs
@@ -1,23 +1,23 @@
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+
 module Notmuch where
 
-import qualified Data.ByteString.Lazy as LBS
-import qualified Data.ByteString.Lazy.Char8 as LBS8
-import qualified Data.Text.Lazy as LT
-import qualified Data.Text.Lazy.Encoding as LT
-import qualified Network.Mail.Mime as M
 import Data.Aeson.Extends
+import Data.ByteString.Lazy qualified as LBS
+import Data.ByteString.Lazy.Char8 qualified as LBS8
 import Data.Either.Combinators (mapRight)
 import Data.Functor ((<&>))
+import Data.Text.Lazy qualified as LT
+import Data.Text.Lazy.Encoding qualified as LT
 import Data.Tree
+import Much.ParseMail (readMail)
+import Much.TagUtils
+import Network.Mail.Mime qualified as M
 import Notmuch.Class
 import Notmuch.Message
 import Notmuch.SearchResult
-import Much.ParseMail (readMail)
 import System.Exit
 import System.Process.ByteString.Lazy (readProcessWithExitCode)
-import Much.TagUtils
 
 
 notmuch :: [String] -> IO LBS.ByteString
diff --git a/src/Notmuch/Message.hs b/src/Notmuch/Message.hs
index 681b5db..93ed07f 100644
--- a/src/Notmuch/Message.hs
+++ b/src/Notmuch/Message.hs
@@ -1,21 +1,18 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
+
 module Notmuch.Message where
 
 import Data.Aeson
 import Data.Aeson.Types (Parser)
-import Data.Time.Calendar
+import Data.ByteString.Lazy.Char8 qualified as LBS8
+import Data.CaseInsensitive qualified as CI
+import Data.Map qualified as M
+import Data.Text qualified as T
 import Data.Time.Clock
 import Data.Time.Clock.POSIX
+import Data.Tree qualified as TR
+import Data.Vector qualified as V
 import Notmuch.Class
-import qualified Data.ByteString.Lazy.Char8 as LBS8
-import qualified Data.Text as T
-import qualified Data.Map as M
-import qualified Data.CaseInsensitive as CI
-import qualified Data.Vector as V
-
-import qualified Data.Tree as TR
 
 
 newtype MessageID = MessageID { unMessageID :: String }
@@ -49,6 +46,13 @@ contentSize (ContentMsgRFC822 xs) = sum $ map (sum . map (contentSize . partCont
 contentSize (ContentRaw _ contentLength) = contentLength
 
 
+primaryMessagePart :: MessagePart -> MessagePart
+primaryMessagePart mp =
+    case partContent mp of
+      ContentMultipart (mp':_) -> primaryMessagePart mp'
+      _ -> mp
+
+
 parseRFC822 :: V.Vector Value -> Parser MessageContent
 parseRFC822 lst = ContentMsgRFC822 . V.toList <$> V.mapM p lst
     where
@@ -90,7 +94,7 @@ data Message = Message {
       messageId :: MessageID
     , messageTime :: UTCTime
     , messageHeaders :: MessageHeaders
-    , messageBody :: [MessagePart]
+    , messageBody :: MessagePart
     , messageExcluded :: Bool
     , messageMatch :: Bool
     , messageTags :: [T.Text]
@@ -110,14 +114,17 @@ instance FromJSON Message where
     parseJSON (Object v) = Message <$> (MessageID . ("id:"<>) <$> v .: "id")
                                    <*> (posixSecondsToUTCTime . fromInteger <$> v .: "timestamp")
                                    <*> (M.mapKeys CI.mk <$> v .: "headers")
-                                   <*> v .: "body"
+                                   <*> (one =<< v .: "body")
                                    <*> v .: "excluded"
                                    <*> v .: "match"
                                    <*> v .: "tags"
                                    <*> v .: "filename"
-    parseJSON (Array _) = return $ Message (MessageID "") defTime M.empty [] True False [] ""
-        where defTime = UTCTime (ModifiedJulianDay 0) 0
     parseJSON x = fail $ "Error parsing message: " ++ show x
+
+
+one :: [a] -> Parser a
+one [x] = pure x
+one _ = fail "Expected exactly one element"
 
 hasTag :: T.Text -> Message -> Bool
 hasTag tag = (tag `elem`) . messageTags
diff --git a/src/Notmuch/SearchResult.hs b/src/Notmuch/SearchResult.hs
index a59fa9c..93eeb7b 100644
--- a/src/Notmuch/SearchResult.hs
+++ b/src/Notmuch/SearchResult.hs
@@ -1,9 +1,9 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE OverloadedStrings #-}
+
 module Notmuch.SearchResult where
 
 import Data.Aeson
-import Data.Text
+import Data.Text (Text)
 import Data.Time.Clock
 import Data.Time.Clock.POSIX
 import Notmuch.Class