1{-# LANGUAGE Safe #-}
2{-
3Copyright (c) 2005-2011 John Goerzen <jgoerzen@complete.org>
4
5All rights reserved.
6
7For license and copyright information, see the file LICENSE
8-}
9
10{- |
11   Module     : Network.Email.Mailbox
12   Copyright  : Copyright (C) 2005-2011 John Goerzen
13   SPDX-License-Identifier: BSD-3-Clause
14
15   Stability  : provisional
16   Portability: portable
17
18General support for e-mail mailboxes
19
20Written by John Goerzen, jgoerzen\@complete.org
21-}
22
23module Network.Email.Mailbox(Flag(..), Flags, Message,
24                              MailboxReader(..),
25                              MailboxWriter(..))
26where
27
28{- | The flags which may be assigned to a message. -}
29data Flag =
30           SEEN
31           | ANSWERED
32           | FLAGGED
33           | DELETED
34           | DRAFT
35           | FORWARDED
36           | OTHERFLAG String
37           deriving (Eq, Show)
38
39{- | Convenience shortcut -}
40type Flags = [Flag]
41
42{- | A Message is represented as a simple String. -}
43type Message = String
44
45{- | Main class for readable mailboxes.
46
47The mailbox object /a/ represents zero or more 'Message's.  Each message
48has a unique identifier /b/ in a format specific to each given mailbox.
49This identifier may or may not be persistent.
50
51Functions which return a list are encouraged -- but not guaranteed -- to
52do so lazily.
53
54Implementing classes must provide, at minimum, 'getAll'.
55-}
56class (Show a, Show b, Eq b) => MailboxReader a b where
57    {- | Returns a list of all unique identifiers. -}
58    listIDs :: a -> IO [b]
59    {- | Returns a list of all unique identifiers as well as all flags. -}
60    listMessageFlags :: a -> IO [(b, Flags)]
61    {- | Returns a list of all messages, including their content,
62       flags, and unique identifiers. -}
63    getAll :: a -> IO [(b, Flags, Message)]
64    {- | Returns information about specific messages. -}
65    getMessages :: a -> [b] -> IO [(b, Flags, Message)]
66
67    listIDs mb = listMessageFlags mb >>= return . map fst
68    listMessageFlags mb = getAll mb >>= return .
69                           map (\(i, f, _) -> (i, f))
70    getMessages mb list =
71        do messages <- getAll mb
72           return $ filter (\(id, f, m) -> id `elem` list) messages
73
74class (MailboxReader a b) => MailboxWriter a b where
75    appendMessages :: a -> [(Flags, Message)] -> IO [b]
76    deleteMessages :: a -> [b] -> IO ()
77    addFlags :: a -> [b] -> Flags -> IO ()
78    removeFlags :: a -> [b] -> Flags -> IO ()
79    setFlags :: a -> [b] -> Flags -> IO ()
80