summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--TreeView.hs26
1 files changed, 25 insertions, 1 deletions
diff --git a/TreeView.hs b/TreeView.hs
index 62bded4..26b04bd 100644
--- a/TreeView.hs
+++ b/TreeView.hs
@@ -179,6 +179,7 @@ loadSubForest :: TreeView -> IO (Either String (Forest TreeView))
loadSubForest = \case
TVMessage m ->
Right
+ . unloadPartsWithFilename
. concatMap subForest
. fromMessageForest
. findFirsts messageMatch
@@ -188,10 +189,15 @@ loadSubForest = \case
-- TODO parse --format=raw
notmuchShowPart (termFromMessage m) (partID mp) >>= return . \case
Left e -> Left $ show e
- Right mp' -> Right $ subForest $ xconvPart m mp'
+ Right mp' ->
+ Right
+ . unloadPartsWithFilename
+ . subForest
+ $ xconvPart m mp'
TVSearchResult sr -> do
Right
+ . unloadPartsWithFilename
. map unloadReadSubForests
. fromMessageForest
<$> notmuchShow (termFromSearchResult sr)
@@ -246,6 +252,24 @@ unloadReadSubForests t = case rootLabel t of
}
+unloadPartsWithFilename :: Forest TreeView -> Forest TreeView
+unloadPartsWithFilename =
+ map (rewriteTree f)
+ where
+ f x@Node{..} = case rootLabel of
+ TVMessagePart _ mp ->
+ case partContentFilename mp of
+ Nothing -> x
+ Just _ ->
+ x { subForest = [] }
+ _ -> x
+
+ rewriteTree :: (Tree a -> Tree a) -> Tree a -> Tree a
+ rewriteTree f x =
+ let x' = f x
+ in x' { subForest = map (rewriteTree f) $ subForest x' }
+
+
findFirsts :: (a -> Bool) -> Forest a -> Forest a
findFirsts p =
concatMap rec