summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Action.hs3
-rw-r--r--Core.hs4
-rw-r--r--MBox.hs4
-rw-r--r--Network/Mail/Mime.hs4
-rw-r--r--Notmuch.hs4
-rw-r--r--Notmuch/Message.hs6
-rw-r--r--Notmuch/SearchResult.hs2
-rw-r--r--RenderTreeView.hs32
-rw-r--r--TagUtils.hs6
-rw-r--r--TreeSearch.hs4
-rw-r--r--TreeView.hs10
11 files changed, 36 insertions, 43 deletions
diff --git a/Action.hs b/Action.hs
index 7ca023d..95bc7ca 100644
--- a/Action.hs
+++ b/Action.hs
@@ -193,9 +193,8 @@ topOverrun State{..} =
botOverrun :: State -> Int
botOverrun State{..} =
- max 0 (linearPos cursor - yoffset - (screenHeight - (length headBuffer) - 1))
+ max 0 (linearPos cursor - yoffset - (screenHeight - length headBuffer - 1))
setSubForest :: Tree.Forest a -> Tree.Tree a -> Tree.Tree a
setSubForest sf t = t { Tree.subForest = sf }
-
diff --git a/Core.hs b/Core.hs
index d08f55c..53f619c 100644
--- a/Core.hs
+++ b/Core.hs
@@ -181,12 +181,12 @@ render0 _q@State{..} = do
map (Blessings.take screenWidth . Blessings.drop xoffset) $
take screenHeight $
headBuffer ++ drop yoffset treeBuffer
- buffer ++ take (screenHeight - length buffer) (repeat "~")
+ buffer ++ replicate (screenHeight - length buffer) "~"
redraw :: State -> IO ()
redraw q@State{..} = do
- hPutStr stdout $ map (sub '\t' ' ') $ "\ESC[H" ++ (pp $ mintercalate "\n" $ map eraseRight $ render0 q)
+ hPutStr stdout $ map (sub '\t' ' ') $ "\ESC[H" ++ pp (mintercalate "\n" $ map eraseRight $ render0 q)
hFlush stdout
where
sub x x' c = if c == x then x' else c
diff --git a/MBox.hs b/MBox.hs
index 0bd3889..5071e48 100644
--- a/MBox.hs
+++ b/MBox.hs
@@ -72,7 +72,7 @@ sortTree :: Tree Message -> Tree Message
sortTree t =
Tree.Node (Tree.rootLabel t) $
map sortTree $
- List.sortBy (comparing $ getMessageDate . Tree.rootLabel) $
+ List.sortOn (getMessageDate . Tree.rootLabel) $
Tree.subForest t
@@ -131,7 +131,7 @@ headerMessageIds headerName =
parseMsgIds :: P.SourceName -> Text -> Either P.ParseError [Ident]
parseMsgIds srcName =
- either Left (Right . map (Text.init . Text.tail . Text.pack)) .
+ fmap (map (Text.init . Text.tail . Text.pack)) .
P.parse obs_in_reply_to_parser srcName .
Text.unpack
where
diff --git a/Network/Mail/Mime.hs b/Network/Mail/Mime.hs
index ac5ec9a..8fd9fe1 100644
--- a/Network/Mail/Mime.hs
+++ b/Network/Mail/Mime.hs
@@ -143,7 +143,7 @@ partToPair (Part contentType encoding disposition headers content) =
(headers', builder)
where
headers' =
- ((:) ("Content-Type", contentType))
+ (:) ("Content-Type", contentType)
$ (case encoding of
None -> id
Base64 -> (:) ("Content-Transfer-Encoding", "base64")
@@ -156,7 +156,7 @@ partToPair (Part contentType encoding disposition headers content) =
Just fn ->
(:) ("Content-Disposition", "attachment; filename="
`T.append` fn))
- $ headers
+ headers
builder =
case encoding of
None -> fromWriteList writeByteString $ L.toChunks content
diff --git a/Notmuch.hs b/Notmuch.hs
index 4d0ddd1..fc24d0e 100644
--- a/Notmuch.hs
+++ b/Notmuch.hs
@@ -141,8 +141,8 @@ notmuchWithInput args input = do
search :: [String] -> IO (Either String [SearchResult])
search args =
- notmuch ("search" : "--format=json" : "--format-version=2" : args)
- >>= return . eitherDecodeLenient'
+ eitherDecodeLenient' <$>
+ notmuch ("search" : "--format=json" : "--format-version=2" : args)
data ReplyTo = ToAll | ToSender
diff --git a/Notmuch/Message.hs b/Notmuch/Message.hs
index d0bb788..d08be39 100644
--- a/Notmuch/Message.hs
+++ b/Notmuch/Message.hs
@@ -102,7 +102,7 @@ instance FromJSON Message where
<*> v .: "tags"
<*> v .: "filename"
parseJSON (Array _) = return $ Message (MessageID "") defTime M.empty [] True False [] ""
- where defTime = UTCTime (ModifiedJulianDay 0) (fromInteger 0)
+ where defTime = UTCTime (ModifiedJulianDay 0) 0
parseJSON x = fail $ "Error parsing message: " ++ show x
hasTag :: T.Text -> Message -> Bool
@@ -110,10 +110,10 @@ hasTag tag = (tag `elem`) . messageTags
-data Thread = Thread { threadForest :: TR.Forest Message }
+newtype Thread = Thread { threadForest :: TR.Forest Message }
instance FromJSON Thread where
- parseJSON (Array vs) = Thread <$> (mapM parseTree $ V.toList vs)
+ parseJSON (Array vs) = Thread <$> mapM parseTree (V.toList vs)
parseJSON _ = fail "Thread is not an array"
parseTree :: Value -> Parser (TR.Tree Message)
diff --git a/Notmuch/SearchResult.hs b/Notmuch/SearchResult.hs
index 94bfecf..a59fa9c 100644
--- a/Notmuch/SearchResult.hs
+++ b/Notmuch/SearchResult.hs
@@ -38,7 +38,7 @@ instance HasNotmuchId SearchResult where
instance FromJSON SearchResult where
- parseJSON (Object v) = SearchResult <$> ((ThreadID . ("thread:"++)) <$> v .: "thread")
+ parseJSON (Object v) = SearchResult <$> (ThreadID . ("thread:"++) <$> v .: "thread")
<*> (posixSecondsToUTCTime . fromInteger <$> v .: "timestamp")
<*> v .: "date_relative"
<*> v .:? "subject" .!= ""
diff --git a/RenderTreeView.hs b/RenderTreeView.hs
index 2962d60..cf8e6f3 100644
--- a/RenderTreeView.hs
+++ b/RenderTreeView.hs
@@ -70,7 +70,7 @@ renderTreeView now cur =
renderPrefix :: Z.TreePos Z.Full TreeView -> Blessings String
renderPrefix =
- mconcat . reverse . map prefix . zip [(1 :: Int)..] . Z.path
+ mconcat . reverse . zipWith (curry prefix) [(1 :: Int)..] . Z.path
where
prefix (i, (_lhs, x, rhs)) = case x of
TVSearch _ -> ""
@@ -86,7 +86,7 @@ renderPrefix =
then spacePrefix
else pipePrefix
_ ->
- if null $ filter isTVMessage $ map rootLabel rhs
+ if not $ any (isTVMessage . rootLabel) rhs
then spacePrefix
else pipePrefix
@@ -145,15 +145,14 @@ renderTreeView1 now hasFocus x = case x of
in c $ Plain s
TVSearchResult sr ->
- let c = if hasFocus then focusSGR else
- if isUnread
- then unreadSearchSGR
- else boringSGR
- c_authors =
- if hasFocus then focusSGR else
- if isUnread
- then altSGR
- else boringSGR
+ let c
+ | hasFocus = focusSGR
+ | isUnread = unreadSearchSGR
+ | otherwise = boringSGR
+ c_authors
+ | hasFocus = focusSGR
+ | isUnread = altSGR
+ | otherwise = boringSGR
isUnread = "unread" `elem` Notmuch.searchTags sr
@@ -166,11 +165,10 @@ renderTreeView1 now hasFocus x = case x of
c $ title <> " " <> date <> " " <> tags
TVMessage m ->
- let fromSGR =
- if hasFocus then focusSGR else
- if "unread" `elem` Notmuch.messageTags m
- then unreadMessageSGR
- else boringMessageSGR
+ let fromSGR
+ | hasFocus = focusSGR
+ | "unread" `elem` Notmuch.messageTags m = unreadMessageSGR
+ | otherwise = boringMessageSGR
from = fromSGR $ renderFrom (M.lookup "from" $ Notmuch.messageHeaders m)
date = dateSGR $ renderDate now x
tags = tagsSGR $ renderTags (Notmuch.messageTags m) -- TODO filter common tags
@@ -239,6 +237,6 @@ renderTag tag = case tag of
dropAddress :: String -> String
dropAddress xs =
- case L.findIndices (=='<') xs of
+ case L.elemIndices '<' xs of
[] -> xs
is -> L.dropWhileEnd isSpace $ take (last is) xs
diff --git a/TagUtils.hs b/TagUtils.hs
index 64336a0..99d957d 100644
--- a/TagUtils.hs
+++ b/TagUtils.hs
@@ -1,6 +1,4 @@
{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
module TagUtils where
@@ -29,8 +27,8 @@ diffTags :: [Tag] -> [Tag] -> [TagOp]
diffTags old new =
let oldTags = Set.fromList old
newTags = Set.fromList new
- in (map DelTag $ Set.toList $ oldTags `Set.difference` newTags) ++
- (map AddTag $ Set.toList $ newTags `Set.difference` oldTags)
+ in map DelTag (Set.toList $ oldTags `Set.difference` newTags) ++
+ map AddTag (Set.toList $ newTags `Set.difference` oldTags)
patchRootLabelTags :: [TagOp] -> Tree TreeView -> Tree TreeView
diff --git a/TreeSearch.hs b/TreeSearch.hs
index 105603a..518c4d9 100644
--- a/TreeSearch.hs
+++ b/TreeSearch.hs
@@ -32,9 +32,7 @@ findPrev :: TreePos Full a -> Maybe (TreePos Full a)
findPrev loc =
case prev loc of
Just x -> trans_lastChild x
- Nothing -> case parent loc of
- Just x -> Just x
- Nothing -> Nothing
+ Nothing -> parent loc
where
trans_lastChild x =
case lastChild x of
diff --git a/TreeView.hs b/TreeView.hs
index 3cb8174..ecd25c8 100644
--- a/TreeView.hs
+++ b/TreeView.hs
@@ -93,7 +93,7 @@ xconvPart m p =
where
contents = case partContent p of
ContentText t ->
- map (xconvLine m p) $ zip [0..] (T.lines t)
+ zipWith (curry $ xconvLine m p) [0..] (T.lines t)
ContentMultipart parts ->
map (xconvPart m) parts
ContentMsgRFC822 _ ->
@@ -145,14 +145,14 @@ loadSubForest = \case
. subForest
$ xconvPart m mp'
- TVSearchResult sr -> do
+ TVSearchResult sr ->
Right
. unloadPartsWithFilename
. map unloadReadSubForests
. fromMessageForest
<$> notmuchShow (termFromSearchResult sr)
- TVSearch s -> do
+ TVSearch s ->
Right
. subForest
. fromSearchResults s
@@ -180,9 +180,9 @@ unloadSubForest t = case rootLabel t of
hasUnloadedSubForest :: Tree TreeView -> Bool
hasUnloadedSubForest t = case rootLabel t of
TVMessage _ ->
- null $ filter (not . isTVMessage . rootLabel) $ subForest t
+ all (isTVMessage . rootLabel) $ subForest t
TVMessagePart _ _ ->
- null $ filter (not . isTVMessagePart . rootLabel) $ subForest t
+ all (isTVMessagePart . rootLabel) $ subForest t
_ ->
null $ subForest t
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-29 20:55:57 +0000