module Network.HaskellNet.IMAP.Types
    ( MailboxName
    , UID
    , Charset
    , MailboxInfo(..)
    , Flag(..)
    , Attribute(..)
    , MboxUpdate(..)
    , StatusCode(..)
    , ServerResponse(..)
    , MailboxStatus(..)
    , RespDerivs(..)
    , emptyMboxInfo
    )
where

import Data.Word
    ( Word64
    )
import Text.Packrat.Parse
    ( Result
    , Derivs(..)
    )
import Text.Packrat.Pos
    ( Pos
    )

type MailboxName = String
type UID = Word64
type Charset = String

data MailboxInfo = MboxInfo { MailboxInfo -> MailboxName
_mailbox :: MailboxName
                            , MailboxInfo -> Integer
_exists :: Integer
                            , MailboxInfo -> Integer
_recent :: Integer
                            , MailboxInfo -> [Flag]
_flags :: [Flag]
                            , MailboxInfo -> [Flag]
_permanentFlags :: [Flag]
                            , MailboxInfo -> Bool
_isWritable :: Bool
                            , MailboxInfo -> Bool
_isFlagWritable :: Bool
                            , MailboxInfo -> UID
_uidNext :: UID
                            , MailboxInfo -> UID
_uidValidity :: UID
                            }
                 deriving (Int -> MailboxInfo -> ShowS
[MailboxInfo] -> ShowS
MailboxInfo -> MailboxName
(Int -> MailboxInfo -> ShowS)
-> (MailboxInfo -> MailboxName)
-> ([MailboxInfo] -> ShowS)
-> Show MailboxInfo
forall a.
(Int -> a -> ShowS)
-> (a -> MailboxName) -> ([a] -> ShowS) -> Show a
showList :: [MailboxInfo] -> ShowS
$cshowList :: [MailboxInfo] -> ShowS
show :: MailboxInfo -> MailboxName
$cshow :: MailboxInfo -> MailboxName
showsPrec :: Int -> MailboxInfo -> ShowS
$cshowsPrec :: Int -> MailboxInfo -> ShowS
Show, MailboxInfo -> MailboxInfo -> Bool
(MailboxInfo -> MailboxInfo -> Bool)
-> (MailboxInfo -> MailboxInfo -> Bool) -> Eq MailboxInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MailboxInfo -> MailboxInfo -> Bool
$c/= :: MailboxInfo -> MailboxInfo -> Bool
== :: MailboxInfo -> MailboxInfo -> Bool
$c== :: MailboxInfo -> MailboxInfo -> Bool
Eq)

data Flag = Seen
          | Answered
          | Flagged
          | Deleted
          | Draft
          | Recent
          | Keyword String
            deriving Flag -> Flag -> Bool
(Flag -> Flag -> Bool) -> (Flag -> Flag -> Bool) -> Eq Flag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flag -> Flag -> Bool
$c/= :: Flag -> Flag -> Bool
== :: Flag -> Flag -> Bool
$c== :: Flag -> Flag -> Bool
Eq

instance Show Flag where
    showsPrec :: Int -> Flag -> ShowS
showsPrec Int
d Flag
f = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ MailboxName -> ShowS
showString (MailboxName -> ShowS) -> MailboxName -> ShowS
forall a b. (a -> b) -> a -> b
$ Flag -> MailboxName
showFlag Flag
f
        where app_prec :: Int
app_prec = Int
10
              showFlag :: Flag -> MailboxName
showFlag Flag
Seen        = MailboxName
"\\Seen"
              showFlag Flag
Answered    = MailboxName
"\\Answered"
              showFlag Flag
Flagged     = MailboxName
"\\Flagged"
              showFlag Flag
Deleted     = MailboxName
"\\Deleted"
              showFlag Flag
Draft       = MailboxName
"\\Draft"
              showFlag Flag
Recent      = MailboxName
"\\Recent"
              showFlag (Keyword MailboxName
s) = MailboxName
"\\" MailboxName -> ShowS
forall a. [a] -> [a] -> [a]
++ MailboxName
s

data Attribute = Noinferiors
               | Noselect
               | Marked
               | Unmarked
               | OtherAttr String
                 deriving (Int -> Attribute -> ShowS
[Attribute] -> ShowS
Attribute -> MailboxName
(Int -> Attribute -> ShowS)
-> (Attribute -> MailboxName)
-> ([Attribute] -> ShowS)
-> Show Attribute
forall a.
(Int -> a -> ShowS)
-> (a -> MailboxName) -> ([a] -> ShowS) -> Show a
showList :: [Attribute] -> ShowS
$cshowList :: [Attribute] -> ShowS
show :: Attribute -> MailboxName
$cshow :: Attribute -> MailboxName
showsPrec :: Int -> Attribute -> ShowS
$cshowsPrec :: Int -> Attribute -> ShowS
Show, Attribute -> Attribute -> Bool
(Attribute -> Attribute -> Bool)
-> (Attribute -> Attribute -> Bool) -> Eq Attribute
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Attribute -> Attribute -> Bool
$c/= :: Attribute -> Attribute -> Bool
== :: Attribute -> Attribute -> Bool
$c== :: Attribute -> Attribute -> Bool
Eq)

data MboxUpdate = MboxUpdate { MboxUpdate -> Maybe Integer
exists :: Maybe Integer
                             , MboxUpdate -> Maybe Integer
recent :: Maybe Integer }
                deriving (Int -> MboxUpdate -> ShowS
[MboxUpdate] -> ShowS
MboxUpdate -> MailboxName
(Int -> MboxUpdate -> ShowS)
-> (MboxUpdate -> MailboxName)
-> ([MboxUpdate] -> ShowS)
-> Show MboxUpdate
forall a.
(Int -> a -> ShowS)
-> (a -> MailboxName) -> ([a] -> ShowS) -> Show a
showList :: [MboxUpdate] -> ShowS
$cshowList :: [MboxUpdate] -> ShowS
show :: MboxUpdate -> MailboxName
$cshow :: MboxUpdate -> MailboxName
showsPrec :: Int -> MboxUpdate -> ShowS
$cshowsPrec :: Int -> MboxUpdate -> ShowS
Show, MboxUpdate -> MboxUpdate -> Bool
(MboxUpdate -> MboxUpdate -> Bool)
-> (MboxUpdate -> MboxUpdate -> Bool) -> Eq MboxUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MboxUpdate -> MboxUpdate -> Bool
$c/= :: MboxUpdate -> MboxUpdate -> Bool
== :: MboxUpdate -> MboxUpdate -> Bool
$c== :: MboxUpdate -> MboxUpdate -> Bool
Eq)

data StatusCode = ALERT
                | BADCHARSET [Charset]
                | CAPABILITY_sc [String]
                | PARSE
                | PERMANENTFLAGS [Flag]
                | READ_ONLY
                | READ_WRITE
                | TRYCREATE
                | UIDNEXT_sc UID
                | UIDVALIDITY_sc UID
                | UNSEEN_sc Integer
                  deriving (StatusCode -> StatusCode -> Bool
(StatusCode -> StatusCode -> Bool)
-> (StatusCode -> StatusCode -> Bool) -> Eq StatusCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatusCode -> StatusCode -> Bool
$c/= :: StatusCode -> StatusCode -> Bool
== :: StatusCode -> StatusCode -> Bool
$c== :: StatusCode -> StatusCode -> Bool
Eq, Int -> StatusCode -> ShowS
[StatusCode] -> ShowS
StatusCode -> MailboxName
(Int -> StatusCode -> ShowS)
-> (StatusCode -> MailboxName)
-> ([StatusCode] -> ShowS)
-> Show StatusCode
forall a.
(Int -> a -> ShowS)
-> (a -> MailboxName) -> ([a] -> ShowS) -> Show a
showList :: [StatusCode] -> ShowS
$cshowList :: [StatusCode] -> ShowS
show :: StatusCode -> MailboxName
$cshow :: StatusCode -> MailboxName
showsPrec :: Int -> StatusCode -> ShowS
$cshowsPrec :: Int -> StatusCode -> ShowS
Show)

data ServerResponse = OK (Maybe StatusCode) String
                    | NO (Maybe StatusCode) String
                    | BAD (Maybe StatusCode) String
                    | PREAUTH (Maybe StatusCode) String
                      deriving (ServerResponse -> ServerResponse -> Bool
(ServerResponse -> ServerResponse -> Bool)
-> (ServerResponse -> ServerResponse -> Bool) -> Eq ServerResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServerResponse -> ServerResponse -> Bool
$c/= :: ServerResponse -> ServerResponse -> Bool
== :: ServerResponse -> ServerResponse -> Bool
$c== :: ServerResponse -> ServerResponse -> Bool
Eq, Int -> ServerResponse -> ShowS
[ServerResponse] -> ShowS
ServerResponse -> MailboxName
(Int -> ServerResponse -> ShowS)
-> (ServerResponse -> MailboxName)
-> ([ServerResponse] -> ShowS)
-> Show ServerResponse
forall a.
(Int -> a -> ShowS)
-> (a -> MailboxName) -> ([a] -> ShowS) -> Show a
showList :: [ServerResponse] -> ShowS
$cshowList :: [ServerResponse] -> ShowS
show :: ServerResponse -> MailboxName
$cshow :: ServerResponse -> MailboxName
showsPrec :: Int -> ServerResponse -> ShowS
$cshowsPrec :: Int -> ServerResponse -> ShowS
Show)


-- | the query data type for the status command
data MailboxStatus = MESSAGES     -- ^ the number of messages in the mailbox
                   | RECENT       -- ^ the number of messages with the \Recent flag set
                   | UIDNEXT      -- ^ the next unique identifier value of the mailbox
                   | UIDVALIDITY  -- ^ the unique identifier validity value of the mailbox
                   | UNSEEN       -- ^ the number of messages with the \Unseen flag set
                     deriving (Int -> MailboxStatus -> ShowS
[MailboxStatus] -> ShowS
MailboxStatus -> MailboxName
(Int -> MailboxStatus -> ShowS)
-> (MailboxStatus -> MailboxName)
-> ([MailboxStatus] -> ShowS)
-> Show MailboxStatus
forall a.
(Int -> a -> ShowS)
-> (a -> MailboxName) -> ([a] -> ShowS) -> Show a
showList :: [MailboxStatus] -> ShowS
$cshowList :: [MailboxStatus] -> ShowS
show :: MailboxStatus -> MailboxName
$cshow :: MailboxStatus -> MailboxName
showsPrec :: Int -> MailboxStatus -> ShowS
$cshowsPrec :: Int -> MailboxStatus -> ShowS
Show, ReadPrec [MailboxStatus]
ReadPrec MailboxStatus
Int -> ReadS MailboxStatus
ReadS [MailboxStatus]
(Int -> ReadS MailboxStatus)
-> ReadS [MailboxStatus]
-> ReadPrec MailboxStatus
-> ReadPrec [MailboxStatus]
-> Read MailboxStatus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MailboxStatus]
$creadListPrec :: ReadPrec [MailboxStatus]
readPrec :: ReadPrec MailboxStatus
$creadPrec :: ReadPrec MailboxStatus
readList :: ReadS [MailboxStatus]
$creadList :: ReadS [MailboxStatus]
readsPrec :: Int -> ReadS MailboxStatus
$creadsPrec :: Int -> ReadS MailboxStatus
Read, MailboxStatus -> MailboxStatus -> Bool
(MailboxStatus -> MailboxStatus -> Bool)
-> (MailboxStatus -> MailboxStatus -> Bool) -> Eq MailboxStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MailboxStatus -> MailboxStatus -> Bool
$c/= :: MailboxStatus -> MailboxStatus -> Bool
== :: MailboxStatus -> MailboxStatus -> Bool
$c== :: MailboxStatus -> MailboxStatus -> Bool
Eq)




data RespDerivs =
    RespDerivs { RespDerivs -> Result RespDerivs [Flag]
dvFlags  :: Result RespDerivs [Flag]
               , RespDerivs -> Result RespDerivs MailboxName
advTag   :: Result RespDerivs String
               , RespDerivs -> Result RespDerivs Char
advChar  :: Result RespDerivs Char
               , RespDerivs -> Pos
advPos   :: Pos
               }

instance Derivs RespDerivs where
    dvChar :: RespDerivs -> Result RespDerivs Char
dvChar = RespDerivs -> Result RespDerivs Char
advChar
    dvPos :: RespDerivs -> Pos
dvPos  = RespDerivs -> Pos
advPos

emptyMboxInfo :: MailboxInfo
emptyMboxInfo :: MailboxInfo
emptyMboxInfo = MailboxName
-> Integer
-> Integer
-> [Flag]
-> [Flag]
-> Bool
-> Bool
-> UID
-> UID
-> MailboxInfo
MboxInfo MailboxName
"" Integer
0 Integer
0 [] [] Bool
False Bool
False UID
0 UID
0