diff options
Diffstat (limited to 'src/Notmuch')
| -rw-r--r-- | src/Notmuch/Message.hs | 35 | ||||
| -rw-r--r-- | src/Notmuch/SearchResult.hs | 4 |
2 files changed, 23 insertions, 16 deletions
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 |