{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
module Notmuch
(
databaseOpen
, databaseOpenReadOnly
, databaseVersion
, Database
, Mode
, DatabaseMode(..)
, RO
, RW
, Query
, query
, queryCountMessages
, queryCountThreads
, SearchTerm(..)
, HasThread(..)
, Thread
, threadToplevelMessages
, threadNewestDate
, threadSubject
, threadAuthors
, threadTotalMessages
, ThreadId
, HasThreads(..)
, ThreadAuthors
, Author
, matchedAuthors
, unmatchedAuthors
, findMessage
, HasMessages(..)
, Message
, MessageId
, messageId
, messageDate
, messageHeader
, messageFilename
, messageSetTags
, messageAddTag
, messageRemoveTag
, withFrozenMessage
, HasTags(..)
, Tag
, mkTag
, getTag
, tagMaxLen
, Status(..)
, AsNotmuchError(..)
, libnotmuchVersion
) where
import Control.Exception (bracket)
import Control.Monad.Except (MonadError(..))
import Control.Monad.IO.Class (MonadIO(..))
import Data.Foldable (traverse_)
import GHC.Generics (Generic)
import Control.DeepSeq (NFData)
import qualified Data.ByteString as B
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time (UTCTime)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Notmuch.Tag
import Notmuch.Binding
import Notmuch.Binding.Constants (libnotmuchVersion)
import Notmuch.Search
import Notmuch.Util
class HasTags a where
tags :: MonadIO m => a -> m [Tag]
instance HasTags (Database a) where
tags = liftIO . database_get_all_tags
instance HasTags (Thread a) where
tags = liftIO . thread_get_tags
instance HasTags (Message n a) where
tags = liftIO . message_get_tags
class HasMessages a where
messages
:: (AsNotmuchError e, MonadError e m, MonadIO m)
=> a mode -> m [Message 0 mode]
instance HasMessages Query where
messages = query_search_messages
instance HasMessages Thread where
messages = thread_get_messages
instance HasMessages (Message n) where
messages = message_get_replies
class HasThreads a where
threads
:: (AsNotmuchError e, MonadError e m, MonadIO m)
=> a mode -> m [Thread mode]
instance HasThreads Query where
threads = query_search_threads
class HasThread a where
threadId :: MonadIO m => a -> m ThreadId
instance HasThread (Thread a) where
threadId = liftIO . thread_get_thread_id
instance HasThread (Message n a) where
threadId = liftIO . message_get_thread_id
databaseOpen
:: (Mode a, AsNotmuchError e, MonadError e m, MonadIO m)
=> FilePath -> m (Database a)
databaseOpen = database_open
databaseOpenReadOnly
:: (AsNotmuchError e, MonadError e m, MonadIO m)
=> FilePath -> m (Database RO)
databaseOpenReadOnly = database_open
databaseVersion :: MonadIO m => Database a -> m Int
databaseVersion = liftIO . database_get_version
findMessage
:: (AsNotmuchError e, MonadError e m, MonadIO m)
=> Database a -> MessageId -> m (Maybe (Message 0 a))
findMessage = database_find_message
query :: (MonadIO m) => Database a -> SearchTerm -> m (Query a)
query db = liftIO . query_create db . show
queryCountMessages
:: (AsNotmuchError e, MonadError e m, MonadIO m)
=> Query a -> m Int
queryCountMessages = query_count_messages
queryCountThreads
:: (AsNotmuchError e, MonadError e m, MonadIO m)
=> Query a -> m Int
queryCountThreads = query_count_threads
messageId :: MonadIO m => Message n a -> m MessageId
messageId = liftIO . message_get_message_id
messageDate :: MonadIO m => Message n a -> m UTCTime
messageDate = liftIO . fmap (posixSecondsToUTCTime . realToFrac) . message_get_date
messageHeader :: MonadIO m => B.ByteString -> Message n a -> m (Maybe B.ByteString)
messageHeader k = liftIO . flip message_get_header k
messageFilename :: MonadIO m => Message n a -> m FilePath
messageFilename = liftIO . message_get_filename
withFrozenMessage :: (Message 1 RW -> IO a) -> Message 0 RW -> IO a
withFrozenMessage k msg = bracket (message_freeze msg) message_thaw k
messageSetTags :: (MonadIO m, Foldable t) => t Tag -> Message 0 RW -> m ()
messageSetTags l = liftIO . withFrozenMessage (\msg ->
message_remove_all_tags msg *> traverse_ (message_add_tag msg) l)
messageAddTag :: (MonadIO m) => Tag -> Message n RW -> m ()
messageAddTag tag msg = liftIO $ message_add_tag msg tag
messageRemoveTag :: (MonadIO m) => Tag -> Message n RW -> m ()
messageRemoveTag tag msg = liftIO $ message_remove_tag msg tag
threadToplevelMessages
:: (AsNotmuchError e, MonadError e m, MonadIO m)
=> Thread a -> m [Message 0 a]
threadToplevelMessages = thread_get_toplevel_messages
threadNewestDate :: MonadIO m => Thread a -> m UTCTime
threadNewestDate = liftIO . fmap (posixSecondsToUTCTime . realToFrac) . thread_get_newest_date
threadSubject :: MonadIO m => Thread a -> m B.ByteString
threadSubject = liftIO . thread_get_subject
type Author = T.Text
data ThreadAuthors = ThreadAuthors
{ _matchedAuthors :: [Author]
, _unmatchedAuthors :: [Author]
} deriving (Show, Generic, NFData)
matchedAuthors :: Lens' ThreadAuthors [Author]
matchedAuthors f (ThreadAuthors a b) = fmap (\a' -> ThreadAuthors a' b) (f a)
{-# ANN matchedAuthors ("HLint: ignore Avoid lambda" :: String) #-}
unmatchedAuthors :: Lens' ThreadAuthors [Author]
unmatchedAuthors f (ThreadAuthors a b) = fmap (\b' -> ThreadAuthors a b') (f b)
{-# ANN unmatchedAuthors ("HLint: ignore Avoid lambda" :: String) #-}
threadAuthors :: MonadIO m => Thread a -> m ThreadAuthors
threadAuthors t = do
a <- liftIO $ thread_get_authors t
pure $ maybe (ThreadAuthors [] []) (convertAuthors . T.decodeUtf8) a
convertAuthors :: T.Text -> ThreadAuthors
convertAuthors raw =
let t = T.breakOn (T.pack "|") raw
matched = T.strip <$> T.splitOn (T.pack ",") (fst t)
unmatched = filter (not . T.null) (T.splitOn (T.pack "|") $ snd t)
in ThreadAuthors matched unmatched
threadTotalMessages :: MonadIO m => Thread a -> m Int
threadTotalMessages = liftIO . thread_get_total_messages