-- This file is part of hs-notmuch - Haskell Notmuch binding
-- Copyright (C) 2014, 2017  Fraser Tweedale
--
-- hs-notmuch is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}

{-|

High-level interface to the /notmuch/ mail indexer.

Example program to add/remove a tag on all messages matching a query:

@
main :: IO ()
main = getArgs >>= \\args -> case args of
  [path, expr, \'+\':tag] -> go path expr tag 'messageAddTag'
  [path, expr, \'-\':tag] -> go path expr tag 'messageRemoveTag'
  _ -> 'die' "usage: hs-notmuch-tag-set DB-DIR SEARCH-TERM +TAG|-TAG"
  where
    go path expr tag f =
      'runExceptT' (do
        db <- 'databaseOpen' path
        'query' db ('Bare' expr) >>= 'messages' >>= traverse_ (f ('fromString' tag))
      ) >>= either (die . (show :: 'Status' -> String)) pure
@

== File descriptor exhaustion

Some 'Message' operations cause the message file to be opened (and
remain open until the object gets garbage collected):

- 'messageHeader' will open the file to read the headers, except for the
  @From@, @Subject@ and @Message-Id@ headers which are indexed.

If the RTS is using a multi-generation collector (the default), and if
you are working with lots of messages, you may hit /max open files/
limits.  The best way to avoid this is to avoid the scenarios outlined
above.  Alternative approaches that could help include:

- Use a single-generation collector (build with @-rtsopts@ and run
  with @+RTS -G1@).  This incurs the cost of scanning the entire
  heap on every GC run.

- In an interactive program, build with @-threaded@ to enable
  parallel GC.  By default, major GC will be triggered when the
  program is idle for a certain time.

- Manually execute 'System.Mem.performMajorGC' at relevant times
  to ensure that older generations get cleaned up.

-}
module Notmuch
  (
  -- * Opening a database
    databaseOpen
  , databaseOpenReadOnly
  , databasePath
  , databaseVersion
  , Database
  -- ** Database modes
  , Mode
  , DatabaseMode(..)
  , RO
  , RW

  -- * Querying the database
  , Query
  , query
  , queryCountMessages
  , queryCountThreads

  -- ** Search expressions
  , SearchTerm(..)

  -- * Working with threads
  , HasThread(..)
  , Thread
  , threadToplevelMessages
  , threadNewestDate
  , threadSubject
  , threadAuthors
  , threadTotalMessages

  -- ** Thread ID
  , ThreadId
  , HasThreads(..)

  -- ** Thread authors
  , ThreadAuthors
  , Author
  , matchedAuthors
  , unmatchedAuthors

  -- * Working with messages
  , findMessage
  , HasMessages(..)
  , Message
  -- ** Headers
  , MessageId
  , messageId
  , messageDate
  , messageHeader
  -- ** Tags
  , messageSetTags
  , messageAddTag
  , messageRemoveTag
  , withFrozenMessage
  -- ** Files
  , messageFilename
  , indexFile
  , removeFile
  , RemoveResult(..)

  -- * Tags
  , HasTags(..)
  , Tag
  , mkTag
  , getTag
  , tagMaxLen

  -- * Errors
  , Status(..)
  , AsNotmuchError(..)

  -- * Library information
  , 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

-- | Objects with tags
class HasTags a where
  tags :: MonadIO m => a -> m [Tag]

-- | Get all tags used in the database
instance HasTags (Database a) where
  tags :: forall (m :: * -> *). MonadIO m => Database a -> m [Tag]
tags = IO [Tag] -> m [Tag]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Tag] -> m [Tag])
-> (Database a -> IO [Tag]) -> Database a -> m [Tag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Database a -> IO [Tag]
forall (a :: DatabaseMode). Database a -> IO [Tag]
database_get_all_tags

-- | Get all tags used in a thread
instance HasTags (Thread a) where
  tags :: forall (m :: * -> *). MonadIO m => Thread a -> m [Tag]
tags = IO [Tag] -> m [Tag]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Tag] -> m [Tag])
-> (Thread a -> IO [Tag]) -> Thread a -> m [Tag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Thread a -> IO [Tag]
forall (a :: DatabaseMode). Thread a -> IO [Tag]
thread_get_tags

-- | Get the tags of a single message
instance HasTags (Message n a) where
  tags :: forall (m :: * -> *). MonadIO m => Message n a -> m [Tag]
tags = IO [Tag] -> m [Tag]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Tag] -> m [Tag])
-> (Message n a -> IO [Tag]) -> Message n a -> m [Tag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message n a -> IO [Tag]
forall (n :: Nat) (a :: DatabaseMode). Message n a -> IO [Tag]
message_get_tags


-- | Objects with associated messages.
class HasMessages a where
  messages
    :: (AsNotmuchError e, MonadError e m, MonadIO m)
    => a mode -> m [Message 0 mode]

-- | Retrieve all messages matching a 'Query'
instance HasMessages Query where
  messages :: forall e (m :: * -> *) (mode :: DatabaseMode).
(AsNotmuchError e, MonadError e m, MonadIO m) =>
Query mode -> m [Message 0 mode]
messages = Query mode -> m [Message 0 mode]
forall e (m :: * -> *) (mode :: DatabaseMode).
(AsNotmuchError e, MonadError e m, MonadIO m) =>
Query mode -> m [Message 0 mode]
query_search_messages

-- | Retrieve the messages in a 'Thread'
instance HasMessages Thread where
  messages :: forall e (m :: * -> *) (mode :: DatabaseMode).
(AsNotmuchError e, MonadError e m, MonadIO m) =>
Thread mode -> m [Message 0 mode]
messages = Thread mode -> m [Message 0 mode]
forall (m :: * -> *) (a :: DatabaseMode).
MonadIO m =>
Thread a -> m [Message 0 a]
thread_get_messages

-- | Retrieve the replies to a 'Message'
instance HasMessages (Message n) where
  messages :: forall e (m :: * -> *) (mode :: DatabaseMode).
(AsNotmuchError e, MonadError e m, MonadIO m) =>
Message n mode -> m [Message 0 mode]
messages = Message n mode -> m [Message 0 mode]
forall (m :: * -> *) (n :: Nat) (a :: DatabaseMode).
MonadIO m =>
Message n a -> m [Message 0 a]
message_get_replies

-- | Objects with associated threads
class HasThreads a where
  threads
    :: (AsNotmuchError e, MonadError e m, MonadIO m)
    => a mode -> m [Thread mode]

-- | Retrieve the threads matching a 'Query'
instance HasThreads Query where
  threads :: forall e (m :: * -> *) (mode :: DatabaseMode).
(AsNotmuchError e, MonadError e m, MonadIO m) =>
Query mode -> m [Thread mode]
threads = Query mode -> m [Thread mode]
forall e (m :: * -> *) (mode :: DatabaseMode).
(AsNotmuchError e, MonadError e m, MonadIO m) =>
Query mode -> m [Thread mode]
query_search_threads

-- | Objects with an associated 'ThreadId'
class HasThread a where
  threadId :: MonadIO m => a -> m ThreadId

-- | Get the 'ThreadId' of a 'Thread'
instance HasThread (Thread a) where
  threadId :: forall (m :: * -> *). MonadIO m => Thread a -> m ThreadId
threadId = IO ThreadId -> m ThreadId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> m ThreadId)
-> (Thread a -> IO ThreadId) -> Thread a -> m ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Thread a -> IO ThreadId
forall (a :: DatabaseMode). Thread a -> IO ThreadId
thread_get_thread_id

-- | Get the 'ThreadId' of a 'Message'
instance HasThread (Message n a) where
  threadId :: forall (m :: * -> *). MonadIO m => Message n a -> m ThreadId
threadId = IO ThreadId -> m ThreadId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> m ThreadId)
-> (Message n a -> IO ThreadId) -> Message n a -> m ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message n a -> IO ThreadId
forall (n :: Nat) (a :: DatabaseMode). Message n a -> IO ThreadId
message_get_thread_id

-- | Open a database.  The database will be closed and associated
-- resources freed upon garbage collection.
--
-- The mode is determined by usage.  Because read-only functions
-- also work on read-write databases, 'databaseOpenReadOnly' is also
-- provided for convenience.
--
databaseOpen
  :: (Mode a, AsNotmuchError e, MonadError e m, MonadIO m)
  => FilePath -> m (Database a)
databaseOpen :: forall (a :: DatabaseMode) e (m :: * -> *).
(Mode a, AsNotmuchError e, MonadError e m, MonadIO m) =>
FilePath -> m (Database a)
databaseOpen = FilePath -> m (Database a)
forall (a :: DatabaseMode) e (m :: * -> *).
(AsNotmuchError e, Mode a, MonadError e m, MonadIO m) =>
FilePath -> m (Database a)
database_open

-- | Convenience function for opening a database read-only
databaseOpenReadOnly
  :: (AsNotmuchError e, MonadError e m, MonadIO m)
   => FilePath -> m (Database RO)
databaseOpenReadOnly :: forall e (m :: * -> *).
(AsNotmuchError e, MonadError e m, MonadIO m) =>
FilePath -> m (Database RO)
databaseOpenReadOnly = FilePath -> m (Database RO)
forall (a :: DatabaseMode) e (m :: * -> *).
(AsNotmuchError e, Mode a, MonadError e m, MonadIO m) =>
FilePath -> m (Database a)
database_open

-- | Database format version of the given database.
databaseVersion :: MonadIO m => Database a -> m Int
databaseVersion :: forall (m :: * -> *) (a :: DatabaseMode).
MonadIO m =>
Database a -> m Int
databaseVersion = IO Int -> m Int
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> (Database a -> IO Int) -> Database a -> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Database a -> IO Int
forall (a :: DatabaseMode). Database a -> IO Int
database_get_version

-- | Look for a particular message in the database.
findMessage
  :: (AsNotmuchError e, MonadError e m, MonadIO m)
  => Database a -> MessageId -> m (Maybe (Message 0 a))
findMessage :: forall e (m :: * -> *) (a :: DatabaseMode).
(AsNotmuchError e, MonadError e m, MonadIO m) =>
Database a -> ThreadId -> m (Maybe (Message 0 a))
findMessage = Database a -> ThreadId -> m (Maybe (Message 0 a))
forall e (m :: * -> *) (a :: DatabaseMode).
(AsNotmuchError e, MonadError e m, MonadIO m) =>
Database a -> ThreadId -> m (Maybe (Message 0 a))
database_find_message

-- | Query the database.  To retrieve results from a @Query@, use
-- 'threads' or 'messages'.
--
query :: (MonadIO m) => Database a -> SearchTerm -> m (Query a)
query :: forall (m :: * -> *) (a :: DatabaseMode).
MonadIO m =>
Database a -> SearchTerm -> m (Query a)
query Database a
db = IO (Query a) -> m (Query a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Query a) -> m (Query a))
-> (SearchTerm -> IO (Query a)) -> SearchTerm -> m (Query a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Database a -> FilePath -> IO (Query a)
forall (a :: DatabaseMode). Database a -> FilePath -> IO (Query a)
query_create Database a
db (FilePath -> IO (Query a))
-> (SearchTerm -> FilePath) -> SearchTerm -> IO (Query a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SearchTerm -> FilePath
forall a. Show a => a -> FilePath
show

-- | Count the number of messages matching a query.
--
-- Complexity: same as the underlying Xapian search…
--
queryCountMessages
  :: (AsNotmuchError e, MonadError e m, MonadIO m)
  => Query a -> m Int
queryCountMessages :: forall e (m :: * -> *) (a :: DatabaseMode).
(AsNotmuchError e, MonadError e m, MonadIO m) =>
Query a -> m Int
queryCountMessages = Query a -> m Int
forall e (m :: * -> *) (a :: DatabaseMode).
(AsNotmuchError e, MonadError e m, MonadIO m) =>
Query a -> m Int
query_count_messages

-- | Count the number of threads matching a query.
--
-- __/Θ(n)/ in the number of messages__!
queryCountThreads
  :: (AsNotmuchError e, MonadError e m, MonadIO m)
  => Query a -> m Int
queryCountThreads :: forall e (m :: * -> *) (a :: DatabaseMode).
(AsNotmuchError e, MonadError e m, MonadIO m) =>
Query a -> m Int
queryCountThreads = Query a -> m Int
forall e (m :: * -> *) (a :: DatabaseMode).
(AsNotmuchError e, MonadError e m, MonadIO m) =>
Query a -> m Int
query_count_threads

-- | Get the message ID.
messageId :: MonadIO m => Message n a -> m MessageId
messageId :: forall (m :: * -> *) (n :: Nat) (a :: DatabaseMode).
MonadIO m =>
Message n a -> m ThreadId
messageId = IO ThreadId -> m ThreadId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> m ThreadId)
-> (Message n a -> IO ThreadId) -> Message n a -> m ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message n a -> IO ThreadId
forall (n :: Nat) (a :: DatabaseMode). Message n a -> IO ThreadId
message_get_message_id

-- | Get the date the message was sent.
messageDate :: MonadIO m => Message n a -> m UTCTime
messageDate :: forall (m :: * -> *) (n :: Nat) (a :: DatabaseMode).
MonadIO m =>
Message n a -> m UTCTime
messageDate = IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime -> m UTCTime)
-> (Message n a -> IO UTCTime) -> Message n a -> m UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CLong -> UTCTime) -> IO CLong -> IO UTCTime
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> (CLong -> POSIXTime) -> CLong -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac) (IO CLong -> IO UTCTime)
-> (Message n a -> IO CLong) -> Message n a -> IO UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message n a -> IO CLong
forall (n :: Nat) (a :: DatabaseMode). Message n a -> IO CLong
message_get_date

-- | Get the named header as a UTF-8 encoded string.
-- Empty string if header is missing or @Nothing@ on error.
--
-- __May open a file descriptor__ that will not be closed until the
-- message gets garbage collected.
--
messageHeader :: MonadIO m => B.ByteString -> Message n a -> m (Maybe B.ByteString)
messageHeader :: forall (m :: * -> *) (n :: Nat) (a :: DatabaseMode).
MonadIO m =>
ThreadId -> Message n a -> m (Maybe ThreadId)
messageHeader ThreadId
k = IO (Maybe ThreadId) -> m (Maybe ThreadId)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ThreadId) -> m (Maybe ThreadId))
-> (Message n a -> IO (Maybe ThreadId))
-> Message n a
-> m (Maybe ThreadId)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Message n a -> ThreadId -> IO (Maybe ThreadId))
-> ThreadId -> Message n a -> IO (Maybe ThreadId)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Message n a -> ThreadId -> IO (Maybe ThreadId)
forall (n :: Nat) (a :: DatabaseMode).
Message n a -> ThreadId -> IO (Maybe ThreadId)
message_get_header ThreadId
k

-- | Get the filename of the message.
messageFilename :: MonadIO m => Message n a -> m FilePath
messageFilename :: forall (m :: * -> *) (n :: Nat) (a :: DatabaseMode).
MonadIO m =>
Message n a -> m FilePath
messageFilename = IO FilePath -> m FilePath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath)
-> (Message n a -> IO FilePath) -> Message n a -> m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message n a -> IO FilePath
forall (n :: Nat) (a :: DatabaseMode). Message n a -> IO FilePath
message_get_filename

-- | Freeze the message, run the given computation
-- and return the result.  The message is always thawed at the end.
--
-- Have to start with @Message 0 RW@ due to GHC type system limitation
-- (type-level Nat is not inductive).
--
withFrozenMessage :: (forall n. Message n RW -> IO a) -> Message 0 RW -> IO a
withFrozenMessage :: forall a.
(forall (n :: Nat). Message n RW -> IO a) -> Message 0 RW -> IO a
withFrozenMessage forall (n :: Nat). Message n RW -> IO a
k Message 0 RW
msg = IO (Message 1 RW)
-> (Message 1 RW -> IO (Message 0 RW))
-> (Message 1 RW -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Message 0 RW -> IO (Message (0 + 1) RW)
forall (n :: Nat). Message n RW -> IO (Message (n + 1) RW)
message_freeze Message 0 RW
msg) Message 1 RW -> IO (Message 0 RW)
Message 1 RW -> IO (Message (1 - 1) RW)
forall (n :: Nat).
(1 <= n) =>
Message n RW -> IO (Message (n - 1) RW)
message_thaw Message 1 RW -> IO a
forall (n :: Nat). Message n RW -> IO a
k

-- | Set tags for the message.  Atomic.
--
messageSetTags :: (MonadIO m, Foldable t) => t Tag -> Message 0 RW -> m ()
messageSetTags :: forall (m :: * -> *) (t :: * -> *).
(MonadIO m, Foldable t) =>
t Tag -> Message 0 RW -> m ()
messageSetTags t Tag
l = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Message 0 RW -> IO ()) -> Message 0 RW -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (n :: Nat). Message n RW -> IO ()) -> Message 0 RW -> IO ()
forall a.
(forall (n :: Nat). Message n RW -> IO a) -> Message 0 RW -> IO a
withFrozenMessage (\Message n RW
msg ->
  Message n RW -> IO ()
forall (n :: Nat). Message n RW -> IO ()
message_remove_all_tags Message n RW
msg IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Tag -> IO ()) -> t Tag -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Message n RW -> Tag -> IO ()
forall (n :: Nat). Message n RW -> Tag -> IO ()
message_add_tag Message n RW
msg) t Tag
l)

-- | Add the tag to a message.  If adding/removing multiple tags,
-- use 'messageSetTags' to set the whole tag list atomically, or use
-- 'withFrozenMessage' to avoid inconsistent states when
-- adding/removing tags.
--
messageAddTag :: (MonadIO m) => Tag -> Message n RW -> m ()
messageAddTag :: forall (m :: * -> *) (n :: Nat).
MonadIO m =>
Tag -> Message n RW -> m ()
messageAddTag Tag
tag Message n RW
msg = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Message n RW -> Tag -> IO ()
forall (n :: Nat). Message n RW -> Tag -> IO ()
message_add_tag Message n RW
msg Tag
tag

-- | Remove the tag from a message.  If adding/removing multiple
-- tags, use 'messageSetTags' to set the whole tag list atomically,
-- or use 'withFrozenMessage' to avoid inconsistent states when
-- adding/removing tags.
--
messageRemoveTag :: (MonadIO m) => Tag -> Message n RW -> m ()
messageRemoveTag :: forall (m :: * -> *) (n :: Nat).
MonadIO m =>
Tag -> Message n RW -> m ()
messageRemoveTag Tag
tag Message n RW
msg = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Message n RW -> Tag -> IO ()
forall (n :: Nat). Message n RW -> Tag -> IO ()
message_remove_tag Message n RW
msg Tag
tag

-- | Returns only messages in a thread which are not replies to other messages in the thread.
threadToplevelMessages
  :: (AsNotmuchError e, MonadError e m, MonadIO m)
  => Thread a -> m [Message 0 a]
threadToplevelMessages :: forall e (m :: * -> *) (mode :: DatabaseMode).
(AsNotmuchError e, MonadError e m, MonadIO m) =>
Thread mode -> m [Message 0 mode]
threadToplevelMessages = Thread a -> m [Message 0 a]
forall (m :: * -> *) (a :: DatabaseMode).
MonadIO m =>
Thread a -> m [Message 0 a]
thread_get_toplevel_messages

-- | /O(1)/ Date of the newest message in a 'Thread'.
threadNewestDate :: MonadIO m => Thread a -> m UTCTime
threadNewestDate :: forall (m :: * -> *) (a :: DatabaseMode).
MonadIO m =>
Thread a -> m UTCTime
threadNewestDate = IO UTCTime -> m UTCTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UTCTime -> m UTCTime)
-> (Thread a -> IO UTCTime) -> Thread a -> m UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CLong -> UTCTime) -> IO CLong -> IO UTCTime
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> (CLong -> POSIXTime) -> CLong -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac) (IO CLong -> IO UTCTime)
-> (Thread a -> IO CLong) -> Thread a -> IO UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Thread a -> IO CLong
forall (a :: DatabaseMode). Thread a -> IO CLong
thread_get_newest_date

-- | Returns the subject of the first message in the query results that belongs to this thread.
threadSubject :: MonadIO m => Thread a -> m B.ByteString
threadSubject :: forall (m :: * -> *) (a :: DatabaseMode).
MonadIO m =>
Thread a -> m ThreadId
threadSubject = IO ThreadId -> m ThreadId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> m ThreadId)
-> (Thread a -> IO ThreadId) -> Thread a -> m ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Thread a -> IO ThreadId
forall (a :: DatabaseMode). Thread a -> IO ThreadId
thread_get_subject

-- | Author of a message.
type Author = T.Text

-- | Authors belonging to messages in a query result of a thread ordered by date.
data ThreadAuthors = ThreadAuthors
    { ThreadAuthors -> [Author]
_matchedAuthors :: [Author]
    -- ^ authors matching the query
    , ThreadAuthors -> [Author]
_unmatchedAuthors :: [Author]
    -- ^ non-matched authors
    } deriving (Int -> ThreadAuthors -> ShowS
[ThreadAuthors] -> ShowS
ThreadAuthors -> FilePath
(Int -> ThreadAuthors -> ShowS)
-> (ThreadAuthors -> FilePath)
-> ([ThreadAuthors] -> ShowS)
-> Show ThreadAuthors
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ThreadAuthors -> ShowS
showsPrec :: Int -> ThreadAuthors -> ShowS
$cshow :: ThreadAuthors -> FilePath
show :: ThreadAuthors -> FilePath
$cshowList :: [ThreadAuthors] -> ShowS
showList :: [ThreadAuthors] -> ShowS
Show, (forall x. ThreadAuthors -> Rep ThreadAuthors x)
-> (forall x. Rep ThreadAuthors x -> ThreadAuthors)
-> Generic ThreadAuthors
forall x. Rep ThreadAuthors x -> ThreadAuthors
forall x. ThreadAuthors -> Rep ThreadAuthors x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ThreadAuthors -> Rep ThreadAuthors x
from :: forall x. ThreadAuthors -> Rep ThreadAuthors x
$cto :: forall x. Rep ThreadAuthors x -> ThreadAuthors
to :: forall x. Rep ThreadAuthors x -> ThreadAuthors
Generic, ThreadAuthors -> ()
(ThreadAuthors -> ()) -> NFData ThreadAuthors
forall a. (a -> ()) -> NFData a
$crnf :: ThreadAuthors -> ()
rnf :: ThreadAuthors -> ()
NFData)

-- | Lens to matched authors.  See also 'threadAuthors'.
matchedAuthors :: Lens' ThreadAuthors [Author]
matchedAuthors :: Lens' ThreadAuthors [Author]
matchedAuthors [Author] -> f [Author]
f (ThreadAuthors [Author]
a [Author]
b) = ([Author] -> ThreadAuthors) -> f [Author] -> f ThreadAuthors
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Author]
a' -> [Author] -> [Author] -> ThreadAuthors
ThreadAuthors [Author]
a' [Author]
b) ([Author] -> f [Author]
f [Author]
a)
{-# ANN matchedAuthors ("HLint: ignore Avoid lambda using `infix`" :: String) #-}

-- | Lens to unmatched authors.  See also 'threadAuthors'.
unmatchedAuthors :: Lens' ThreadAuthors [Author]
unmatchedAuthors :: Lens' ThreadAuthors [Author]
unmatchedAuthors [Author] -> f [Author]
f (ThreadAuthors [Author]
a [Author]
b) = ([Author] -> ThreadAuthors) -> f [Author] -> f ThreadAuthors
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Author]
b' -> [Author] -> [Author] -> ThreadAuthors
ThreadAuthors [Author]
a [Author]
b') ([Author] -> f [Author]
f [Author]
b)
{-# ANN unmatchedAuthors ("HLint: ignore Avoid lambda" :: String) #-}

-- | Return authors of a thread.  These are split into:
--
-- * Authors of messages matching the query (accessible via 'matchedAuthors').
-- * Authors of non-matching messages (accessible via 'unmatchedAuthors').
--
threadAuthors :: MonadIO m => Thread a -> m ThreadAuthors
threadAuthors :: forall (m :: * -> *) (a :: DatabaseMode).
MonadIO m =>
Thread a -> m ThreadAuthors
threadAuthors Thread a
t = do
  Maybe ThreadId
a <- IO (Maybe ThreadId) -> m (Maybe ThreadId)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ThreadId) -> m (Maybe ThreadId))
-> IO (Maybe ThreadId) -> m (Maybe ThreadId)
forall a b. (a -> b) -> a -> b
$ Thread a -> IO (Maybe ThreadId)
forall (a :: DatabaseMode). Thread a -> IO (Maybe ThreadId)
thread_get_authors Thread a
t
  ThreadAuthors -> m ThreadAuthors
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ThreadAuthors -> m ThreadAuthors)
-> ThreadAuthors -> m ThreadAuthors
forall a b. (a -> b) -> a -> b
$ ThreadAuthors
-> (ThreadId -> ThreadAuthors) -> Maybe ThreadId -> ThreadAuthors
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Author] -> [Author] -> ThreadAuthors
ThreadAuthors [] []) (Author -> ThreadAuthors
convertAuthors (Author -> ThreadAuthors)
-> (ThreadId -> Author) -> ThreadId -> ThreadAuthors
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThreadId -> Author
T.decodeUtf8) Maybe ThreadId
a

convertAuthors :: T.Text -> ThreadAuthors
convertAuthors :: Author -> ThreadAuthors
convertAuthors Author
raw =
  let t :: (Author, Author)
t = HasCallStack => Author -> Author -> (Author, Author)
Author -> Author -> (Author, Author)
T.breakOn (FilePath -> Author
T.pack FilePath
"|") Author
raw
      matched :: [Author]
matched = Author -> Author
T.strip (Author -> Author) -> [Author] -> [Author]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Author -> Author -> [Author]
Author -> Author -> [Author]
T.splitOn (FilePath -> Author
T.pack FilePath
",") ((Author, Author) -> Author
forall a b. (a, b) -> a
fst (Author, Author)
t)
      unmatched :: [Author]
unmatched = (Author -> Bool) -> [Author] -> [Author]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Author -> Bool) -> Author -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Author -> Bool
T.null) (HasCallStack => Author -> Author -> [Author]
Author -> Author -> [Author]
T.splitOn (FilePath -> Author
T.pack FilePath
"|") (Author -> [Author]) -> Author -> [Author]
forall a b. (a -> b) -> a -> b
$ (Author, Author) -> Author
forall a b. (a, b) -> b
snd (Author, Author)
t)
  in [Author] -> [Author] -> ThreadAuthors
ThreadAuthors [Author]
matched [Author]
unmatched

-- | /O(1)/ count of messages in the thread.
threadTotalMessages :: MonadIO m => Thread a -> m Int
threadTotalMessages :: forall (m :: * -> *) (a :: DatabaseMode).
MonadIO m =>
Thread a -> m Int
threadTotalMessages = IO Int -> m Int
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> m Int) -> (Thread a -> IO Int) -> Thread a -> m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Thread a -> IO Int
forall (a :: DatabaseMode). Thread a -> IO Int
thread_get_total_messages