-- | Parsers for IMAP server responses
module Network.HaskellNet.IMAP.Parsers
    ( eval
    , eval'
    , pNone
    , pCapability
    , pSelect
    , pList
    , pLsub
    , pStatus
    , pExpunge
    , pSearch
    , pFetch
    )
where

import Text.Packrat.Parse hiding (space, spaces)
import Text.Packrat.Pos

import Data.Maybe

import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS

import Network.HaskellNet.IMAP.Types

eval :: (RespDerivs -> Result RespDerivs r) -> String -> ByteString -> r
eval :: (RespDerivs -> Result RespDerivs r) -> String -> ByteString -> r
eval RespDerivs -> Result RespDerivs r
pMain String
tag ByteString
s = case RespDerivs -> Result RespDerivs r
pMain (String -> Pos -> ByteString -> RespDerivs
parse String
tag (String -> Int -> Int -> Pos
Pos String
tag Int
1 Int
1) ByteString
s) of
                     Parsed r
v RespDerivs
_ ParseError
_ -> r
v
                     NoParse ParseError
e    -> String -> r
forall a. HasCallStack => String -> a
error (ParseError -> String
forall a. Show a => a -> String
show ParseError
e)

parse :: String -> Pos -> ByteString -> RespDerivs
parse :: String -> Pos -> ByteString -> RespDerivs
parse String
tagstr Pos
pos ByteString
s = RespDerivs
d
    where d :: RespDerivs
d    = Result RespDerivs [Flag]
-> Result RespDerivs String
-> Result RespDerivs Char
-> Pos
-> RespDerivs
RespDerivs Result RespDerivs [Flag]
flag Result RespDerivs String
tag Result RespDerivs Char
chr Pos
pos
          flag :: Result RespDerivs [Flag]
flag = RespDerivs -> Result RespDerivs [Flag]
pParenFlags RespDerivs
d
          tag :: Result RespDerivs String
tag  = String -> RespDerivs -> ParseError -> Result RespDerivs String
forall d v. v -> d -> ParseError -> Result d v
Parsed String
tagstr RespDerivs
d (RespDerivs -> ParseError
forall d. Derivs d => d -> ParseError
nullError RespDerivs
d)
          chr :: Result RespDerivs Char
chr  = if ByteString -> Bool
BS.null ByteString
s
                 then ParseError -> Result RespDerivs Char
forall d v. ParseError -> Result d v
NoParse (RespDerivs -> ParseError
forall d. Derivs d => d -> ParseError
eofError RespDerivs
d)
                 else let (Char
c, ByteString
s') = (ByteString -> Char
BS.head ByteString
s, ByteString -> ByteString
BS.tail ByteString
s)
                      in Char -> RespDerivs -> ParseError -> Result RespDerivs Char
forall d v. v -> d -> ParseError -> Result d v
Parsed Char
c (String -> Pos -> ByteString -> RespDerivs
parse String
tagstr (Pos -> Char -> Pos
nextPos Pos
pos Char
c) ByteString
s')
                           (RespDerivs -> ParseError
forall d. Derivs d => d -> ParseError
nullError RespDerivs
d)

eval' :: (RespDerivs -> Result RespDerivs r) -> String -> String -> r
eval' :: (RespDerivs -> Result RespDerivs r) -> String -> String -> r
eval' RespDerivs -> Result RespDerivs r
pMain String
tag String
s = case RespDerivs -> Result RespDerivs r
pMain (String -> Pos -> String -> RespDerivs
parse' String
tag (String -> Int -> Int -> Pos
Pos String
tag Int
1 Int
1) String
s) of
                      Parsed r
v RespDerivs
_ ParseError
_ -> r
v
                      NoParse ParseError
e    -> String -> r
forall a. HasCallStack => String -> a
error (ParseError -> String
forall a. Show a => a -> String
show ParseError
e)

parse' :: String -> Pos -> String -> RespDerivs
parse' :: String -> Pos -> String -> RespDerivs
parse' String
tagstr Pos
pos String
s = RespDerivs
d
    where d :: RespDerivs
d    = Result RespDerivs [Flag]
-> Result RespDerivs String
-> Result RespDerivs Char
-> Pos
-> RespDerivs
RespDerivs Result RespDerivs [Flag]
flag Result RespDerivs String
tag Result RespDerivs Char
chr Pos
pos
          flag :: Result RespDerivs [Flag]
flag = RespDerivs -> Result RespDerivs [Flag]
pParenFlags RespDerivs
d
          tag :: Result RespDerivs String
tag  = String -> RespDerivs -> ParseError -> Result RespDerivs String
forall d v. v -> d -> ParseError -> Result d v
Parsed String
tagstr RespDerivs
d (RespDerivs -> ParseError
forall d. Derivs d => d -> ParseError
nullError RespDerivs
d)
          chr :: Result RespDerivs Char
chr  = case String
s of
                   (Char
c:String
s') -> Char -> RespDerivs -> ParseError -> Result RespDerivs Char
forall d v. v -> d -> ParseError -> Result d v
Parsed Char
c (String -> Pos -> String -> RespDerivs
parse' String
tagstr (Pos -> Char -> Pos
nextPos Pos
pos Char
c) String
s')
                               (RespDerivs -> ParseError
forall d. Derivs d => d -> ParseError
nullError RespDerivs
d)
                   String
_      -> ParseError -> Result RespDerivs Char
forall d v. ParseError -> Result d v
NoParse (RespDerivs -> ParseError
forall d. Derivs d => d -> ParseError
eofError RespDerivs
d)

mkMboxUpdate :: [Either (String, Integer) b] -> (MboxUpdate, [b])
mkMboxUpdate :: [Either (String, Integer) b] -> (MboxUpdate, [b])
mkMboxUpdate [Either (String, Integer) b]
untagged = (Maybe Integer -> Maybe Integer -> MboxUpdate
MboxUpdate Maybe Integer
exists' Maybe Integer
recent', [b]
others)
    where exists' :: Maybe Integer
exists' = String -> [(String, Integer)] -> Maybe Integer
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"EXISTS" ([(String, Integer)] -> Maybe Integer)
-> [(String, Integer)] -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ [Either (String, Integer) b] -> [(String, Integer)]
forall a b. [Either a b] -> [a]
catLefts [Either (String, Integer) b]
untagged
          recent' :: Maybe Integer
recent' = String -> [(String, Integer)] -> Maybe Integer
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"RECENT" ([(String, Integer)] -> Maybe Integer)
-> [(String, Integer)] -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ [Either (String, Integer) b] -> [(String, Integer)]
forall a b. [Either a b] -> [a]
catLefts [Either (String, Integer) b]
untagged
          others :: [b]
others = [Either (String, Integer) b] -> [b]
forall a b. [Either a b] -> [b]
catRights [Either (String, Integer) b]
untagged

pNone :: RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ())
Parser RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, ())
pNone =
    do [Either (String, Integer) Any]
untagged <- Parser RespDerivs (Either (String, Integer) Any)
-> Parser RespDerivs [Either (String, Integer) Any]
forall d v. Derivs d => Parser d v -> Parser d [v]
many Parser RespDerivs (Either (String, Integer) Any)
forall b. Parser RespDerivs (Either (String, Integer) b)
pOtherLine
       ServerResponse
resp <- (RespDerivs -> Result RespDerivs ServerResponse)
-> Parser RespDerivs ServerResponse
forall d v. (d -> Result d v) -> Parser d v
Parser RespDerivs -> Result RespDerivs ServerResponse
pDone
       let (MboxUpdate
mboxUp, [Any]
_) = [Either (String, Integer) Any] -> (MboxUpdate, [Any])
forall b. [Either (String, Integer) b] -> (MboxUpdate, [b])
mkMboxUpdate [Either (String, Integer) Any]
untagged
       (ServerResponse, MboxUpdate, ())
-> Parser RespDerivs (ServerResponse, MboxUpdate, ())
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerResponse
resp, MboxUpdate
mboxUp, ())

pCapability :: RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, [String])
Parser RespDerivs
-> Result RespDerivs (ServerResponse, MboxUpdate, [String])
pCapability =
    do [Either (String, Integer) [String]]
untagged <- Parser RespDerivs (Either (String, Integer) [String])
-> Parser RespDerivs [Either (String, Integer) [String]]
forall d v. Derivs d => Parser d v -> Parser d [v]
many (Parser RespDerivs (Either (String, Integer) [String])
forall a. Parser RespDerivs (Either a [String])
pCapabilityLine Parser RespDerivs (Either (String, Integer) [String])
-> Parser RespDerivs (Either (String, Integer) [String])
-> Parser RespDerivs (Either (String, Integer) [String])
forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> Parser RespDerivs (Either (String, Integer) [String])
forall b. Parser RespDerivs (Either (String, Integer) b)
pOtherLine)
       ServerResponse
resp <- (RespDerivs -> Result RespDerivs ServerResponse)
-> Parser RespDerivs ServerResponse
forall d v. (d -> Result d v) -> Parser d v
Parser RespDerivs -> Result RespDerivs ServerResponse
pDone
       let (MboxUpdate
mboxUp, [[String]]
caps) = [Either (String, Integer) [String]] -> (MboxUpdate, [[String]])
forall b. [Either (String, Integer) b] -> (MboxUpdate, [b])
mkMboxUpdate [Either (String, Integer) [String]]
untagged
       (ServerResponse, MboxUpdate, [String])
-> Parser RespDerivs (ServerResponse, MboxUpdate, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerResponse
resp, MboxUpdate
mboxUp, [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[String]]
caps)

pList :: RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, [([Attribute], String, MailboxName)])
Parser RespDerivs
-> Result
     RespDerivs
     (ServerResponse, MboxUpdate, [([Attribute], String, String)])
pList =
    do [Either (String, Integer) ([Attribute], String, String)]
untagged <- Parser
  RespDerivs (Either (String, Integer) ([Attribute], String, String))
-> Parser
     RespDerivs [Either (String, Integer) ([Attribute], String, String)]
forall d v. Derivs d => Parser d v -> Parser d [v]
many (String
-> Parser
     RespDerivs (Either (String, Integer) ([Attribute], String, String))
forall a.
String
-> Parser RespDerivs (Either a ([Attribute], String, String))
pListLine String
"LIST" Parser
  RespDerivs (Either (String, Integer) ([Attribute], String, String))
-> Parser
     RespDerivs (Either (String, Integer) ([Attribute], String, String))
-> Parser
     RespDerivs (Either (String, Integer) ([Attribute], String, String))
forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> Parser
  RespDerivs (Either (String, Integer) ([Attribute], String, String))
forall b. Parser RespDerivs (Either (String, Integer) b)
pOtherLine)
       ServerResponse
resp <- (RespDerivs -> Result RespDerivs ServerResponse)
-> Parser RespDerivs ServerResponse
forall d v. (d -> Result d v) -> Parser d v
Parser RespDerivs -> Result RespDerivs ServerResponse
pDone
       let (MboxUpdate
mboxUp, [([Attribute], String, String)]
listRes) = [Either (String, Integer) ([Attribute], String, String)]
-> (MboxUpdate, [([Attribute], String, String)])
forall b. [Either (String, Integer) b] -> (MboxUpdate, [b])
mkMboxUpdate [Either (String, Integer) ([Attribute], String, String)]
untagged
       (ServerResponse, MboxUpdate, [([Attribute], String, String)])
-> Parser
     RespDerivs
     (ServerResponse, MboxUpdate, [([Attribute], String, String)])
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerResponse
resp, MboxUpdate
mboxUp, [([Attribute], String, String)]
listRes)

pLsub :: RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, [([Attribute], String, MailboxName)])
Parser RespDerivs
-> Result
     RespDerivs
     (ServerResponse, MboxUpdate, [([Attribute], String, String)])
pLsub =
    do [Either (String, Integer) ([Attribute], String, String)]
untagged <- Parser
  RespDerivs (Either (String, Integer) ([Attribute], String, String))
-> Parser
     RespDerivs [Either (String, Integer) ([Attribute], String, String)]
forall d v. Derivs d => Parser d v -> Parser d [v]
many (String
-> Parser
     RespDerivs (Either (String, Integer) ([Attribute], String, String))
forall a.
String
-> Parser RespDerivs (Either a ([Attribute], String, String))
pListLine String
"LSUB" Parser
  RespDerivs (Either (String, Integer) ([Attribute], String, String))
-> Parser
     RespDerivs (Either (String, Integer) ([Attribute], String, String))
-> Parser
     RespDerivs (Either (String, Integer) ([Attribute], String, String))
forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> Parser
  RespDerivs (Either (String, Integer) ([Attribute], String, String))
forall b. Parser RespDerivs (Either (String, Integer) b)
pOtherLine)
       ServerResponse
resp <- (RespDerivs -> Result RespDerivs ServerResponse)
-> Parser RespDerivs ServerResponse
forall d v. (d -> Result d v) -> Parser d v
Parser RespDerivs -> Result RespDerivs ServerResponse
pDone
       let (MboxUpdate
mboxUp, [([Attribute], String, String)]
listRes) = [Either (String, Integer) ([Attribute], String, String)]
-> (MboxUpdate, [([Attribute], String, String)])
forall b. [Either (String, Integer) b] -> (MboxUpdate, [b])
mkMboxUpdate [Either (String, Integer) ([Attribute], String, String)]
untagged
       (ServerResponse, MboxUpdate, [([Attribute], String, String)])
-> Parser
     RespDerivs
     (ServerResponse, MboxUpdate, [([Attribute], String, String)])
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerResponse
resp, MboxUpdate
mboxUp, [([Attribute], String, String)]
listRes)

pStatus :: RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, [(MailboxStatus, Integer)])
Parser RespDerivs
-> Result
     RespDerivs (ServerResponse, MboxUpdate, [(MailboxStatus, Integer)])
pStatus =
    do [Either (String, Integer) [(MailboxStatus, Integer)]]
untagged <- Parser
  RespDerivs (Either (String, Integer) [(MailboxStatus, Integer)])
-> Parser
     RespDerivs [Either (String, Integer) [(MailboxStatus, Integer)]]
forall d v. Derivs d => Parser d v -> Parser d [v]
many (Parser
  RespDerivs (Either (String, Integer) [(MailboxStatus, Integer)])
forall a. Parser RespDerivs (Either a [(MailboxStatus, Integer)])
pStatusLine Parser
  RespDerivs (Either (String, Integer) [(MailboxStatus, Integer)])
-> Parser
     RespDerivs (Either (String, Integer) [(MailboxStatus, Integer)])
-> Parser
     RespDerivs (Either (String, Integer) [(MailboxStatus, Integer)])
forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> Parser
  RespDerivs (Either (String, Integer) [(MailboxStatus, Integer)])
forall b. Parser RespDerivs (Either (String, Integer) b)
pOtherLine)
       ServerResponse
resp <- (RespDerivs -> Result RespDerivs ServerResponse)
-> Parser RespDerivs ServerResponse
forall d v. (d -> Result d v) -> Parser d v
Parser RespDerivs -> Result RespDerivs ServerResponse
pDone
       let (MboxUpdate
mboxUp, [[(MailboxStatus, Integer)]]
statRes) = [Either (String, Integer) [(MailboxStatus, Integer)]]
-> (MboxUpdate, [[(MailboxStatus, Integer)]])
forall b. [Either (String, Integer) b] -> (MboxUpdate, [b])
mkMboxUpdate [Either (String, Integer) [(MailboxStatus, Integer)]]
untagged
       (ServerResponse, MboxUpdate, [(MailboxStatus, Integer)])
-> Parser
     RespDerivs (ServerResponse, MboxUpdate, [(MailboxStatus, Integer)])
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerResponse
resp, MboxUpdate
mboxUp, [[(MailboxStatus, Integer)]] -> [(MailboxStatus, Integer)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(MailboxStatus, Integer)]]
statRes)

pExpunge :: RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, [Integer])
Parser RespDerivs
-> Result RespDerivs (ServerResponse, MboxUpdate, [Integer])
pExpunge =
    do [Either (String, Integer) (String, Integer)]
untagged <- Parser RespDerivs (Either (String, Integer) (String, Integer))
-> Parser RespDerivs [Either (String, Integer) (String, Integer)]
forall d v. Derivs d => Parser d v -> Parser d [v]
many ((do String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"* "
                             Integer
n <- Parser RespDerivs Integer
pExpungeLine
                             Either (String, Integer) (String, Integer)
-> Parser RespDerivs (Either (String, Integer) (String, Integer))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (String, Integer) (String, Integer)
 -> Parser RespDerivs (Either (String, Integer) (String, Integer)))
-> Either (String, Integer) (String, Integer)
-> Parser RespDerivs (Either (String, Integer) (String, Integer))
forall a b. (a -> b) -> a -> b
$ (String, Integer) -> Either (String, Integer) (String, Integer)
forall a b. b -> Either a b
Right (String
"EXPUNGE", Integer
n))
                         Parser RespDerivs (Either (String, Integer) (String, Integer))
-> Parser RespDerivs (Either (String, Integer) (String, Integer))
-> Parser RespDerivs (Either (String, Integer) (String, Integer))
forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> Parser RespDerivs (Either (String, Integer) (String, Integer))
forall b. Parser RespDerivs (Either (String, Integer) b)
pOtherLine)
       ServerResponse
resp <- (RespDerivs -> Result RespDerivs ServerResponse)
-> Parser RespDerivs ServerResponse
forall d v. (d -> Result d v) -> Parser d v
Parser RespDerivs -> Result RespDerivs ServerResponse
pDone
       let (MboxUpdate
mboxUp, [(String, Integer)]
expunges) = [Either (String, Integer) (String, Integer)]
-> (MboxUpdate, [(String, Integer)])
forall b. [Either (String, Integer) b] -> (MboxUpdate, [b])
mkMboxUpdate [Either (String, Integer) (String, Integer)]
untagged
       (ServerResponse, MboxUpdate, [Integer])
-> Parser RespDerivs (ServerResponse, MboxUpdate, [Integer])
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerResponse
resp, MboxUpdate
mboxUp, String -> [(String, Integer)] -> [Integer]
forall a b. Eq a => a -> [(a, b)] -> [b]
lookups String
"EXPUNGE" [(String, Integer)]
expunges)

pSearch :: RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, [UID])
Parser RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, [UID])
pSearch =
    do [Either (String, Integer) [UID]]
untagged <- Parser RespDerivs (Either (String, Integer) [UID])
-> Parser RespDerivs [Either (String, Integer) [UID]]
forall d v. Derivs d => Parser d v -> Parser d [v]
many (Parser RespDerivs (Either (String, Integer) [UID])
forall a. Parser RespDerivs (Either a [UID])
pSearchLine Parser RespDerivs (Either (String, Integer) [UID])
-> Parser RespDerivs (Either (String, Integer) [UID])
-> Parser RespDerivs (Either (String, Integer) [UID])
forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> Parser RespDerivs (Either (String, Integer) [UID])
forall b. Parser RespDerivs (Either (String, Integer) b)
pOtherLine)
       ServerResponse
resp <- (RespDerivs -> Result RespDerivs ServerResponse)
-> Parser RespDerivs ServerResponse
forall d v. (d -> Result d v) -> Parser d v
Parser RespDerivs -> Result RespDerivs ServerResponse
pDone
       let (MboxUpdate
mboxUp, [[UID]]
searchRes) = [Either (String, Integer) [UID]] -> (MboxUpdate, [[UID]])
forall b. [Either (String, Integer) b] -> (MboxUpdate, [b])
mkMboxUpdate [Either (String, Integer) [UID]]
untagged
       (ServerResponse, MboxUpdate, [UID])
-> Parser RespDerivs (ServerResponse, MboxUpdate, [UID])
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerResponse
resp, MboxUpdate
mboxUp, [[UID]] -> [UID]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[UID]]
searchRes)


pSelect :: RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, MailboxInfo)
Parser RespDerivs
-> Result RespDerivs (ServerResponse, MboxUpdate, MailboxInfo)
pSelect =
    do [MailboxInfo -> MailboxInfo]
untagged <- Parser RespDerivs (MailboxInfo -> MailboxInfo)
-> Parser RespDerivs [MailboxInfo -> MailboxInfo]
forall d v. Derivs d => Parser d v -> Parser d [v]
many (Parser RespDerivs (MailboxInfo -> MailboxInfo)
pSelectLine
                         Parser RespDerivs (MailboxInfo -> MailboxInfo)
-> Parser RespDerivs (MailboxInfo -> MailboxInfo)
-> Parser RespDerivs (MailboxInfo -> MailboxInfo)
forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> (do String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"* "
                                 Parser RespDerivs Char
forall d. Derivs d => Parser d Char
anyChar Parser RespDerivs Char
-> Parser RespDerivs String -> Parser RespDerivs String
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`manyTill` Parser RespDerivs String
forall d. Derivs d => Parser d String
crlfP
                                 (MailboxInfo -> MailboxInfo)
-> Parser RespDerivs (MailboxInfo -> MailboxInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return MailboxInfo -> MailboxInfo
forall a. a -> a
id))
       ServerResponse
resp <- (RespDerivs -> Result RespDerivs ServerResponse)
-> Parser RespDerivs ServerResponse
forall d v. (d -> Result d v) -> Parser d v
Parser RespDerivs -> Result RespDerivs ServerResponse
pDone
       let box :: MailboxInfo
box = case ServerResponse
resp of
                   OK Maybe StatusCode
writable String
_ ->
                       MailboxInfo
emptyBox { _isWritable :: Bool
_isWritable = Maybe StatusCode -> Bool
forall a. Maybe a -> Bool
isJust Maybe StatusCode
writable Bool -> Bool -> Bool
&& Maybe StatusCode -> StatusCode
forall a. HasCallStack => Maybe a -> a
fromJust Maybe StatusCode
writable StatusCode -> StatusCode -> Bool
forall a. Eq a => a -> a -> Bool
== StatusCode
READ_WRITE }
                   ServerResponse
_ -> MailboxInfo
emptyBox
       (ServerResponse, MboxUpdate, MailboxInfo)
-> Parser RespDerivs (ServerResponse, MboxUpdate, MailboxInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerResponse
resp, Maybe Integer -> Maybe Integer -> MboxUpdate
MboxUpdate Maybe Integer
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing, (MailboxInfo -> (MailboxInfo -> MailboxInfo) -> MailboxInfo)
-> MailboxInfo -> [MailboxInfo -> MailboxInfo] -> MailboxInfo
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((MailboxInfo -> MailboxInfo) -> MailboxInfo -> MailboxInfo)
-> MailboxInfo -> (MailboxInfo -> MailboxInfo) -> MailboxInfo
forall a b c. (a -> b -> c) -> b -> a -> c
flip (MailboxInfo -> MailboxInfo) -> MailboxInfo -> MailboxInfo
forall a b. (a -> b) -> a -> b
($)) MailboxInfo
box [MailboxInfo -> MailboxInfo]
untagged)
    where emptyBox :: MailboxInfo
emptyBox = String
-> Integer
-> Integer
-> [Flag]
-> [Flag]
-> Bool
-> Bool
-> UID
-> UID
-> MailboxInfo
MboxInfo String
"" Integer
0 Integer
0 [] [] Bool
False Bool
False UID
0 UID
0

pFetch :: RespDerivs -> Result RespDerivs (ServerResponse, MboxUpdate, [(Integer, [(String, String)])])
Parser RespDerivs
-> Result
     RespDerivs
     (ServerResponse, MboxUpdate, [(Integer, [(String, String)])])
pFetch =
    do [Either (String, Integer) (Integer, [(String, String)])]
untagged <- Parser
  RespDerivs (Either (String, Integer) (Integer, [(String, String)]))
-> Parser
     RespDerivs [Either (String, Integer) (Integer, [(String, String)])]
forall d v. Derivs d => Parser d v -> Parser d [v]
many (Parser
  RespDerivs (Either (String, Integer) (Integer, [(String, String)]))
forall a.
Parser RespDerivs (Either a (Integer, [(String, String)]))
pFetchLine Parser
  RespDerivs (Either (String, Integer) (Integer, [(String, String)]))
-> Parser
     RespDerivs (Either (String, Integer) (Integer, [(String, String)]))
-> Parser
     RespDerivs (Either (String, Integer) (Integer, [(String, String)]))
forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> Parser
  RespDerivs (Either (String, Integer) (Integer, [(String, String)]))
forall b. Parser RespDerivs (Either (String, Integer) b)
pOtherLine)
       ServerResponse
resp <- (RespDerivs -> Result RespDerivs ServerResponse)
-> Parser RespDerivs ServerResponse
forall d v. (d -> Result d v) -> Parser d v
Parser RespDerivs -> Result RespDerivs ServerResponse
pDone
       let (MboxUpdate
mboxUp, [(Integer, [(String, String)])]
fetchRes) = [Either (String, Integer) (Integer, [(String, String)])]
-> (MboxUpdate, [(Integer, [(String, String)])])
forall b. [Either (String, Integer) b] -> (MboxUpdate, [b])
mkMboxUpdate [Either (String, Integer) (Integer, [(String, String)])]
untagged
       (ServerResponse, MboxUpdate, [(Integer, [(String, String)])])
-> Parser
     RespDerivs
     (ServerResponse, MboxUpdate, [(Integer, [(String, String)])])
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerResponse
resp, MboxUpdate
mboxUp, [(Integer, [(String, String)])]
fetchRes)

pDone :: RespDerivs -> Result RespDerivs ServerResponse
Parser RespDerivs -> Result RespDerivs ServerResponse
pDone = do String
tag <- (RespDerivs -> Result RespDerivs String)
-> Parser RespDerivs String
forall d v. (d -> Result d v) -> Parser d v
Parser RespDerivs -> Result RespDerivs String
advTag
                  String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
tag Parser RespDerivs String
-> Parser RespDerivs Char -> Parser RespDerivs Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser RespDerivs Char
space
                  Maybe StatusCode -> String -> ServerResponse
respCode <- Parser RespDerivs (Maybe StatusCode -> String -> ServerResponse)
parseCode
                  Parser RespDerivs Char
space
                  Maybe StatusCode
stat <- Parser RespDerivs StatusCode
-> Parser RespDerivs (Maybe StatusCode)
forall d v. Derivs d => Parser d v -> Parser d (Maybe v)
optional (do StatusCode
s <- Parser RespDerivs StatusCode
parseStatusCode
                                       Parser RespDerivs Char
space Parser RespDerivs Char
-> Parser RespDerivs StatusCode -> Parser RespDerivs StatusCode
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StatusCode -> Parser RespDerivs StatusCode
forall (m :: * -> *) a. Monad m => a -> m a
return StatusCode
s)
                  String
body <- Parser RespDerivs Char
forall d. Derivs d => Parser d Char
anyChar Parser RespDerivs Char
-> Parser RespDerivs String -> Parser RespDerivs String
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`manyTill` Parser RespDerivs String
forall d. Derivs d => Parser d String
crlfP
                  ServerResponse -> Parser RespDerivs ServerResponse
forall (m :: * -> *) a. Monad m => a -> m a
return (ServerResponse -> Parser RespDerivs ServerResponse)
-> ServerResponse -> Parser RespDerivs ServerResponse
forall a b. (a -> b) -> a -> b
$ Maybe StatusCode -> String -> ServerResponse
respCode Maybe StatusCode
stat String
body
    where parseCode :: Parser RespDerivs (Maybe StatusCode -> String -> ServerResponse)
parseCode = [Parser RespDerivs (Maybe StatusCode -> String -> ServerResponse)]
-> Parser RespDerivs (Maybe StatusCode -> String -> ServerResponse)
forall d v. Derivs d => [Parser d v] -> Parser d v
choice ([Parser RespDerivs (Maybe StatusCode -> String -> ServerResponse)]
 -> Parser
      RespDerivs (Maybe StatusCode -> String -> ServerResponse))
-> [Parser
      RespDerivs (Maybe StatusCode -> String -> ServerResponse)]
-> Parser RespDerivs (Maybe StatusCode -> String -> ServerResponse)
forall a b. (a -> b) -> a -> b
$ [ String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"OK" Parser RespDerivs String
-> Parser RespDerivs (Maybe StatusCode -> String -> ServerResponse)
-> Parser RespDerivs (Maybe StatusCode -> String -> ServerResponse)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Maybe StatusCode -> String -> ServerResponse)
-> Parser RespDerivs (Maybe StatusCode -> String -> ServerResponse)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe StatusCode -> String -> ServerResponse
OK
                               , String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"NO" Parser RespDerivs String
-> Parser RespDerivs (Maybe StatusCode -> String -> ServerResponse)
-> Parser RespDerivs (Maybe StatusCode -> String -> ServerResponse)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Maybe StatusCode -> String -> ServerResponse)
-> Parser RespDerivs (Maybe StatusCode -> String -> ServerResponse)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe StatusCode -> String -> ServerResponse
NO
                               , String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"BAD" Parser RespDerivs String
-> Parser RespDerivs (Maybe StatusCode -> String -> ServerResponse)
-> Parser RespDerivs (Maybe StatusCode -> String -> ServerResponse)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Maybe StatusCode -> String -> ServerResponse)
-> Parser RespDerivs (Maybe StatusCode -> String -> ServerResponse)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe StatusCode -> String -> ServerResponse
BAD
                               , String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"PREAUTH" Parser RespDerivs String
-> Parser RespDerivs (Maybe StatusCode -> String -> ServerResponse)
-> Parser RespDerivs (Maybe StatusCode -> String -> ServerResponse)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Maybe StatusCode -> String -> ServerResponse)
-> Parser RespDerivs (Maybe StatusCode -> String -> ServerResponse)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe StatusCode -> String -> ServerResponse
PREAUTH
                               ]
          parseStatusCode :: Parser RespDerivs StatusCode
parseStatusCode =
              Parser RespDerivs Char
-> Parser RespDerivs Char
-> Parser RespDerivs StatusCode
-> Parser RespDerivs StatusCode
forall d vs ve v.
Derivs d =>
Parser d vs -> Parser d ve -> Parser d v -> Parser d v
between (Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'[') (Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
']') (Parser RespDerivs StatusCode -> Parser RespDerivs StatusCode)
-> Parser RespDerivs StatusCode -> Parser RespDerivs StatusCode
forall a b. (a -> b) -> a -> b
$
              [Parser RespDerivs StatusCode] -> Parser RespDerivs StatusCode
forall d v. Derivs d => [Parser d v] -> Parser d v
choice [ String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"ALERT" Parser RespDerivs String
-> Parser RespDerivs StatusCode -> Parser RespDerivs StatusCode
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StatusCode -> Parser RespDerivs StatusCode
forall (m :: * -> *) a. Monad m => a -> m a
return StatusCode
ALERT
                     , do { String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"BADCHARSET"
                          ; Maybe [String]
ws <- Parser RespDerivs [String] -> Parser RespDerivs (Maybe [String])
forall d v. Derivs d => Parser d v -> Parser d (Maybe v)
optional Parser RespDerivs [String]
parenWords
                          ; StatusCode -> Parser RespDerivs StatusCode
forall (m :: * -> *) a. Monad m => a -> m a
return (StatusCode -> Parser RespDerivs StatusCode)
-> StatusCode -> Parser RespDerivs StatusCode
forall a b. (a -> b) -> a -> b
$ [String] -> StatusCode
BADCHARSET ([String] -> StatusCode) -> [String] -> StatusCode
forall a b. (a -> b) -> a -> b
$ [String] -> Maybe [String] -> [String]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [String]
ws }
                     , do { String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"CAPABILITY"
                          ; Parser RespDerivs Char
space
                          ; [String]
ws <- (Parser RespDerivs Char -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d [v]
many1 (Parser RespDerivs Char -> Parser RespDerivs String)
-> Parser RespDerivs Char -> Parser RespDerivs String
forall a b. (a -> b) -> a -> b
$ String -> Parser RespDerivs Char
forall d. Derivs d => String -> Parser d Char
noneOf String
" ]") Parser RespDerivs String
-> Parser RespDerivs Char -> Parser RespDerivs [String]
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`sepBy1` Parser RespDerivs Char
space
                          ; StatusCode -> Parser RespDerivs StatusCode
forall (m :: * -> *) a. Monad m => a -> m a
return (StatusCode -> Parser RespDerivs StatusCode)
-> StatusCode -> Parser RespDerivs StatusCode
forall a b. (a -> b) -> a -> b
$ [String] -> StatusCode
CAPABILITY_sc [String]
ws }
                     , String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"PARSE" Parser RespDerivs String
-> Parser RespDerivs StatusCode -> Parser RespDerivs StatusCode
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StatusCode -> Parser RespDerivs StatusCode
forall (m :: * -> *) a. Monad m => a -> m a
return StatusCode
PARSE
                     , do { String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"PERMANENTFLAGS" Parser RespDerivs String
-> Parser RespDerivs Char -> Parser RespDerivs Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser RespDerivs Char
space Parser RespDerivs Char
-> Parser RespDerivs Char -> Parser RespDerivs Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'('
                          ; [Flag]
fs <- Parser RespDerivs Flag
pFlag Parser RespDerivs Flag
-> Parser RespDerivs String -> Parser RespDerivs [Flag]
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`sepBy1` Parser RespDerivs String
spaces1
                          ; Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
')'
                          ; StatusCode -> Parser RespDerivs StatusCode
forall (m :: * -> *) a. Monad m => a -> m a
return (StatusCode -> Parser RespDerivs StatusCode)
-> StatusCode -> Parser RespDerivs StatusCode
forall a b. (a -> b) -> a -> b
$ [Flag] -> StatusCode
PERMANENTFLAGS [Flag]
fs }
                     , String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"READ-ONLY" Parser RespDerivs String
-> Parser RespDerivs StatusCode -> Parser RespDerivs StatusCode
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StatusCode -> Parser RespDerivs StatusCode
forall (m :: * -> *) a. Monad m => a -> m a
return StatusCode
READ_ONLY
                     , String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"READ-WRITE" Parser RespDerivs String
-> Parser RespDerivs StatusCode -> Parser RespDerivs StatusCode
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StatusCode -> Parser RespDerivs StatusCode
forall (m :: * -> *) a. Monad m => a -> m a
return StatusCode
READ_WRITE
                     , String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"TRYCREATE" Parser RespDerivs String
-> Parser RespDerivs StatusCode -> Parser RespDerivs StatusCode
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StatusCode -> Parser RespDerivs StatusCode
forall (m :: * -> *) a. Monad m => a -> m a
return StatusCode
TRYCREATE
                     , do { String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"UNSEEN" Parser RespDerivs String
-> Parser RespDerivs Char -> Parser RespDerivs Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser RespDerivs Char
space
                          ; String
num <- Parser RespDerivs Char -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d [v]
many1 Parser RespDerivs Char
forall d. Derivs d => Parser d Char
digit
                          ; StatusCode -> Parser RespDerivs StatusCode
forall (m :: * -> *) a. Monad m => a -> m a
return (StatusCode -> Parser RespDerivs StatusCode)
-> StatusCode -> Parser RespDerivs StatusCode
forall a b. (a -> b) -> a -> b
$ Integer -> StatusCode
UNSEEN_sc (Integer -> StatusCode) -> Integer -> StatusCode
forall a b. (a -> b) -> a -> b
$ String -> Integer
forall a. Read a => String -> a
read String
num }
                     , do { String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"UIDNEXT" Parser RespDerivs String
-> Parser RespDerivs Char -> Parser RespDerivs Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser RespDerivs Char
space
                          ; String
num <- Parser RespDerivs Char -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d [v]
many1 Parser RespDerivs Char
forall d. Derivs d => Parser d Char
digit
                          ; StatusCode -> Parser RespDerivs StatusCode
forall (m :: * -> *) a. Monad m => a -> m a
return (StatusCode -> Parser RespDerivs StatusCode)
-> StatusCode -> Parser RespDerivs StatusCode
forall a b. (a -> b) -> a -> b
$ UID -> StatusCode
UIDNEXT_sc (UID -> StatusCode) -> UID -> StatusCode
forall a b. (a -> b) -> a -> b
$ String -> UID
forall a. Read a => String -> a
read String
num }
                     , do { String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"UIDVALIDITY" Parser RespDerivs String
-> Parser RespDerivs Char -> Parser RespDerivs Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser RespDerivs Char
space
                          ; String
num <- Parser RespDerivs Char -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d [v]
many1 Parser RespDerivs Char
forall d. Derivs d => Parser d Char
digit
                          ; StatusCode -> Parser RespDerivs StatusCode
forall (m :: * -> *) a. Monad m => a -> m a
return (StatusCode -> Parser RespDerivs StatusCode)
-> StatusCode -> Parser RespDerivs StatusCode
forall a b. (a -> b) -> a -> b
$ UID -> StatusCode
UIDVALIDITY_sc (UID -> StatusCode) -> UID -> StatusCode
forall a b. (a -> b) -> a -> b
$ String -> UID
forall a. Read a => String -> a
read String
num }
                     ]
          parenWords :: Parser RespDerivs [String]
parenWords = Parser RespDerivs Char
-> Parser RespDerivs Char
-> Parser RespDerivs [String]
-> Parser RespDerivs [String]
forall d vs ve v.
Derivs d =>
Parser d vs -> Parser d ve -> Parser d v -> Parser d v
between (Parser RespDerivs Char
space Parser RespDerivs Char
-> Parser RespDerivs Char -> Parser RespDerivs Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'(') (Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
')')
                         (Parser RespDerivs Char -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d [v]
many1 (String -> Parser RespDerivs Char
forall d. Derivs d => String -> Parser d Char
noneOf String
" )") Parser RespDerivs String
-> Parser RespDerivs Char -> Parser RespDerivs [String]
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`sepBy1` Parser RespDerivs Char
space)

pFlag :: Parser RespDerivs Flag
pFlag :: Parser RespDerivs Flag
pFlag = do Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'\\'
           [Parser RespDerivs Flag] -> Parser RespDerivs Flag
forall d v. Derivs d => [Parser d v] -> Parser d v
choice [ String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"Seen"     Parser RespDerivs String
-> Parser RespDerivs Flag -> Parser RespDerivs Flag
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Flag -> Parser RespDerivs Flag
forall (m :: * -> *) a. Monad m => a -> m a
return Flag
Seen
                  , String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"Answered" Parser RespDerivs String
-> Parser RespDerivs Flag -> Parser RespDerivs Flag
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Flag -> Parser RespDerivs Flag
forall (m :: * -> *) a. Monad m => a -> m a
return Flag
Answered
                  , String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"Flagged"  Parser RespDerivs String
-> Parser RespDerivs Flag -> Parser RespDerivs Flag
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Flag -> Parser RespDerivs Flag
forall (m :: * -> *) a. Monad m => a -> m a
return Flag
Flagged
                  , String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"Deleted"  Parser RespDerivs String
-> Parser RespDerivs Flag -> Parser RespDerivs Flag
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Flag -> Parser RespDerivs Flag
forall (m :: * -> *) a. Monad m => a -> m a
return Flag
Deleted
                  , String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"Draft"    Parser RespDerivs String
-> Parser RespDerivs Flag -> Parser RespDerivs Flag
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Flag -> Parser RespDerivs Flag
forall (m :: * -> *) a. Monad m => a -> m a
return Flag
Draft
                  , String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"Recent"   Parser RespDerivs String
-> Parser RespDerivs Flag -> Parser RespDerivs Flag
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Flag -> Parser RespDerivs Flag
forall (m :: * -> *) a. Monad m => a -> m a
return Flag
Recent
                  , Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'*'          Parser RespDerivs Char
-> Parser RespDerivs Flag -> Parser RespDerivs Flag
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Flag -> Parser RespDerivs Flag
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Flag
Keyword String
"*")
                  , Parser RespDerivs Char -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d [v]
many1 Parser RespDerivs Char
forall d. Derivs d => Parser d Char
atomChar    Parser RespDerivs String
-> (String -> Parser RespDerivs Flag) -> Parser RespDerivs Flag
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Flag -> Parser RespDerivs Flag
forall (m :: * -> *) a. Monad m => a -> m a
return (Flag -> Parser RespDerivs Flag)
-> (String -> Flag) -> String -> Parser RespDerivs Flag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Flag
Keyword ]
    Parser RespDerivs Flag
-> Parser RespDerivs Flag -> Parser RespDerivs Flag
forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> (Parser RespDerivs Char -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d [v]
many1 Parser RespDerivs Char
forall d. Derivs d => Parser d Char
atomChar Parser RespDerivs String
-> (String -> Parser RespDerivs Flag) -> Parser RespDerivs Flag
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Flag -> Parser RespDerivs Flag
forall (m :: * -> *) a. Monad m => a -> m a
return (Flag -> Parser RespDerivs Flag)
-> (String -> Flag) -> String -> Parser RespDerivs Flag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Flag
Keyword)

pParenFlags :: RespDerivs -> Result RespDerivs [Flag]
Parser RespDerivs -> Result RespDerivs [Flag]
pParenFlags = do Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'('
                        [Flag]
fs <- Parser RespDerivs Flag
pFlag Parser RespDerivs Flag
-> Parser RespDerivs Char -> Parser RespDerivs [Flag]
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`sepBy` Parser RespDerivs Char
space
                        Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
')'
                        [Flag] -> Parser RespDerivs [Flag]
forall (m :: * -> *) a. Monad m => a -> m a
return [Flag]
fs

atomChar :: Derivs d => Parser d Char
atomChar :: Parser d Char
atomChar = String -> Parser d Char
forall d. Derivs d => String -> Parser d Char
noneOf String
" (){%*\"\\]"

pNumberedLine :: String -> Parser RespDerivs Integer
pNumberedLine :: String -> Parser RespDerivs Integer
pNumberedLine String
str = do String
num <- Parser RespDerivs Char -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d [v]
many1 Parser RespDerivs Char
forall d. Derivs d => Parser d Char
digit
                       Parser RespDerivs Char
space
                       String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
str
                       Parser RespDerivs String
forall d. Derivs d => Parser d String
crlfP
                       Integer -> Parser RespDerivs Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Parser RespDerivs Integer)
-> Integer -> Parser RespDerivs Integer
forall a b. (a -> b) -> a -> b
$ String -> Integer
forall a. Read a => String -> a
read String
num

pExistsLine, pRecentLine, pExpungeLine :: Parser RespDerivs Integer
pExistsLine :: Parser RespDerivs Integer
pExistsLine  = String -> Parser RespDerivs Integer
pNumberedLine String
"EXISTS"
pRecentLine :: Parser RespDerivs Integer
pRecentLine  = String -> Parser RespDerivs Integer
pNumberedLine String
"RECENT"
pExpungeLine :: Parser RespDerivs Integer
pExpungeLine = String -> Parser RespDerivs Integer
pNumberedLine String
"EXPUNGE"

pOtherLine :: Parser RespDerivs (Either (String, Integer) b)
pOtherLine :: Parser RespDerivs (Either (String, Integer) b)
pOtherLine = do String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"* "
                [Parser RespDerivs (Either (String, Integer) b)]
-> Parser RespDerivs (Either (String, Integer) b)
forall d v. Derivs d => [Parser d v] -> Parser d v
choice [ Parser RespDerivs Integer
pExistsLine Parser RespDerivs Integer
-> (Integer -> Parser RespDerivs (Either (String, Integer) b))
-> Parser RespDerivs (Either (String, Integer) b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
n -> Either (String, Integer) b
-> Parser RespDerivs (Either (String, Integer) b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((String, Integer) -> Either (String, Integer) b
forall a b. a -> Either a b
Left (String
"EXISTS", Integer
n))
                       , Parser RespDerivs Integer
pRecentLine Parser RespDerivs Integer
-> (Integer -> Parser RespDerivs (Either (String, Integer) b))
-> Parser RespDerivs (Either (String, Integer) b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
n -> Either (String, Integer) b
-> Parser RespDerivs (Either (String, Integer) b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((String, Integer) -> Either (String, Integer) b
forall a b. a -> Either a b
Left (String
"RECENT", Integer
n))
                       , Parser RespDerivs String
blankLine Parser RespDerivs String
-> Parser RespDerivs (Either (String, Integer) b)
-> Parser RespDerivs (Either (String, Integer) b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Either (String, Integer) b
-> Parser RespDerivs (Either (String, Integer) b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((String, Integer) -> Either (String, Integer) b
forall a b. a -> Either a b
Left (String
"", Integer
0))]
    where blankLine :: Parser RespDerivs String
blankLine = Parser RespDerivs Char
forall d. Derivs d => Parser d Char
anyChar Parser RespDerivs Char
-> Parser RespDerivs String -> Parser RespDerivs String
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`manyTill` Parser RespDerivs String
forall d. Derivs d => Parser d String
crlfP


pCapabilityLine :: Parser RespDerivs (Either a [String])
pCapabilityLine :: Parser RespDerivs (Either a [String])
pCapabilityLine = do String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"* CAPABILITY "
                     [String]
ws <- Parser RespDerivs Char -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d [v]
many1 (String -> Parser RespDerivs Char
forall d. Derivs d => String -> Parser d Char
noneOf String
" \r") Parser RespDerivs String
-> Parser RespDerivs Char -> Parser RespDerivs [String]
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`sepBy` Parser RespDerivs Char
space
                     Parser RespDerivs String
forall d. Derivs d => Parser d String
crlfP
                     Either a [String] -> Parser RespDerivs (Either a [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a [String] -> Parser RespDerivs (Either a [String]))
-> Either a [String] -> Parser RespDerivs (Either a [String])
forall a b. (a -> b) -> a -> b
$ [String] -> Either a [String]
forall a b. b -> Either a b
Right [String]
ws

pListLine :: String
          -> Parser RespDerivs (Either a ([Attribute], String, MailboxName))
pListLine :: String
-> Parser RespDerivs (Either a ([Attribute], String, String))
pListLine String
list =
    do String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"* " Parser RespDerivs String
-> Parser RespDerivs String -> Parser RespDerivs String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
list Parser RespDerivs String
-> Parser RespDerivs Char -> Parser RespDerivs Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser RespDerivs Char
space
       [Attribute]
attrs <- Parser RespDerivs [Attribute]
parseAttrs
       String
sep <- Parser RespDerivs String
parseSep
       String
mbox <- Parser RespDerivs String
parseMailbox
       Either a ([Attribute], String, String)
-> Parser RespDerivs (Either a ([Attribute], String, String))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a ([Attribute], String, String)
 -> Parser RespDerivs (Either a ([Attribute], String, String)))
-> Either a ([Attribute], String, String)
-> Parser RespDerivs (Either a ([Attribute], String, String))
forall a b. (a -> b) -> a -> b
$ ([Attribute], String, String)
-> Either a ([Attribute], String, String)
forall a b. b -> Either a b
Right ([Attribute]
attrs, String
sep, String
mbox)
    where parseAttr :: Parser RespDerivs Attribute
parseAttr =
              do Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'\\'
                 [Parser RespDerivs Attribute] -> Parser RespDerivs Attribute
forall d v. Derivs d => [Parser d v] -> Parser d v
choice [ String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"Noinferior" Parser RespDerivs String
-> Parser RespDerivs Attribute -> Parser RespDerivs Attribute
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Attribute -> Parser RespDerivs Attribute
forall (m :: * -> *) a. Monad m => a -> m a
return Attribute
Noinferiors
                        , String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"Noselect" Parser RespDerivs String
-> Parser RespDerivs Attribute -> Parser RespDerivs Attribute
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Attribute -> Parser RespDerivs Attribute
forall (m :: * -> *) a. Monad m => a -> m a
return Attribute
Noselect
                        , String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"Marked" Parser RespDerivs String
-> Parser RespDerivs Attribute -> Parser RespDerivs Attribute
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Attribute -> Parser RespDerivs Attribute
forall (m :: * -> *) a. Monad m => a -> m a
return Attribute
Marked
                        , String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"Unmarked" Parser RespDerivs String
-> Parser RespDerivs Attribute -> Parser RespDerivs Attribute
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Attribute -> Parser RespDerivs Attribute
forall (m :: * -> *) a. Monad m => a -> m a
return Attribute
Unmarked
                        , Parser RespDerivs Char -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d [v]
many Parser RespDerivs Char
forall d. Derivs d => Parser d Char
atomChar Parser RespDerivs String
-> (String -> Parser RespDerivs Attribute)
-> Parser RespDerivs Attribute
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Attribute -> Parser RespDerivs Attribute
forall (m :: * -> *) a. Monad m => a -> m a
return (Attribute -> Parser RespDerivs Attribute)
-> (String -> Attribute) -> String -> Parser RespDerivs Attribute
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Attribute
OtherAttr
                        ]
          parseAttrs :: Parser RespDerivs [Attribute]
parseAttrs = do Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'('
                          [Attribute]
attrs <- Parser RespDerivs Attribute
parseAttr Parser RespDerivs Attribute
-> Parser RespDerivs Char -> Parser RespDerivs [Attribute]
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`sepBy` Parser RespDerivs Char
space
                          Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
')'
                          [Attribute] -> Parser RespDerivs [Attribute]
forall (m :: * -> *) a. Monad m => a -> m a
return [Attribute]
attrs
          parseSep :: Parser RespDerivs String
parseSep = Parser RespDerivs Char
space Parser RespDerivs Char
-> Parser RespDerivs Char -> Parser RespDerivs Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'"' Parser RespDerivs Char
-> Parser RespDerivs String -> Parser RespDerivs String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser RespDerivs Char
forall d. Derivs d => Parser d Char
anyChar Parser RespDerivs Char
-> Parser RespDerivs Char -> Parser RespDerivs String
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`manyTill` Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'"'
          parseMailbox :: Parser RespDerivs String
parseMailbox = do Parser RespDerivs Char
space
                            Maybe Char
q <- Parser RespDerivs Char -> Parser RespDerivs (Maybe Char)
forall d v. Derivs d => Parser d v -> Parser d (Maybe v)
optional (Parser RespDerivs Char -> Parser RespDerivs (Maybe Char))
-> Parser RespDerivs Char -> Parser RespDerivs (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'"'
                            case Maybe Char
q of
                                Just Char
_  -> do String
mbox <- Parser RespDerivs Char
forall d. Derivs d => Parser d Char
anyChar Parser RespDerivs Char
-> Parser RespDerivs Char -> Parser RespDerivs String
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`manyTill` Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'"'
                                              Parser RespDerivs Char
forall d. Derivs d => Parser d Char
anyChar Parser RespDerivs Char
-> Parser RespDerivs String -> Parser RespDerivs String
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`manyTill` Parser RespDerivs String
forall d. Derivs d => Parser d String
crlfP
                                              String -> Parser RespDerivs String
forall (m :: * -> *) a. Monad m => a -> m a
return String
mbox
                                Maybe Char
Nothing -> Parser RespDerivs Char
forall d. Derivs d => Parser d Char
anyChar Parser RespDerivs Char
-> Parser RespDerivs String -> Parser RespDerivs String
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`manyTill` Parser RespDerivs String
forall d. Derivs d => Parser d String
crlfP

pStatusLine :: Parser RespDerivs (Either a [(MailboxStatus, Integer)])
pStatusLine :: Parser RespDerivs (Either a [(MailboxStatus, Integer)])
pStatusLine =
    do String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"* STATUS "
       String
_ <- Parser RespDerivs Char
forall d. Derivs d => Parser d Char
anyChar Parser RespDerivs Char
-> Parser RespDerivs Char -> Parser RespDerivs String
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`manyTill` Parser RespDerivs Char
space
       [(MailboxStatus, Integer)]
stats <- Parser RespDerivs Char
-> Parser RespDerivs Char
-> Parser RespDerivs [(MailboxStatus, Integer)]
-> Parser RespDerivs [(MailboxStatus, Integer)]
forall d vs ve v.
Derivs d =>
Parser d vs -> Parser d ve -> Parser d v -> Parser d v
between (Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'(') (Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
')') (Parser RespDerivs (MailboxStatus, Integer)
parseStat Parser RespDerivs (MailboxStatus, Integer)
-> Parser RespDerivs Char
-> Parser RespDerivs [(MailboxStatus, Integer)]
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`sepBy1` Parser RespDerivs Char
space)
       Parser RespDerivs String
forall d. Derivs d => Parser d String
crlfP
       Either a [(MailboxStatus, Integer)]
-> Parser RespDerivs (Either a [(MailboxStatus, Integer)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a [(MailboxStatus, Integer)]
 -> Parser RespDerivs (Either a [(MailboxStatus, Integer)]))
-> Either a [(MailboxStatus, Integer)]
-> Parser RespDerivs (Either a [(MailboxStatus, Integer)])
forall a b. (a -> b) -> a -> b
$ [(MailboxStatus, Integer)] -> Either a [(MailboxStatus, Integer)]
forall a b. b -> Either a b
Right [(MailboxStatus, Integer)]
stats
    where parseStat :: Parser RespDerivs (MailboxStatus, Integer)
parseStat =
              do MailboxStatus
cons <- [Parser RespDerivs MailboxStatus]
-> Parser RespDerivs MailboxStatus
forall d v. Derivs d => [Parser d v] -> Parser d v
choice [ String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"MESSAGES"    Parser RespDerivs String
-> (String -> Parser RespDerivs MailboxStatus)
-> Parser RespDerivs MailboxStatus
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MailboxStatus -> Parser RespDerivs MailboxStatus
forall (m :: * -> *) a. Monad m => a -> m a
return (MailboxStatus -> Parser RespDerivs MailboxStatus)
-> (String -> MailboxStatus)
-> String
-> Parser RespDerivs MailboxStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> MailboxStatus
forall a. Read a => String -> a
read
                                , String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"RECENT"      Parser RespDerivs String
-> (String -> Parser RespDerivs MailboxStatus)
-> Parser RespDerivs MailboxStatus
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MailboxStatus -> Parser RespDerivs MailboxStatus
forall (m :: * -> *) a. Monad m => a -> m a
return (MailboxStatus -> Parser RespDerivs MailboxStatus)
-> (String -> MailboxStatus)
-> String
-> Parser RespDerivs MailboxStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> MailboxStatus
forall a. Read a => String -> a
read
                                , String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"UIDNEXT"     Parser RespDerivs String
-> (String -> Parser RespDerivs MailboxStatus)
-> Parser RespDerivs MailboxStatus
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MailboxStatus -> Parser RespDerivs MailboxStatus
forall (m :: * -> *) a. Monad m => a -> m a
return (MailboxStatus -> Parser RespDerivs MailboxStatus)
-> (String -> MailboxStatus)
-> String
-> Parser RespDerivs MailboxStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> MailboxStatus
forall a. Read a => String -> a
read
                                , String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"UIDVALIDITY" Parser RespDerivs String
-> (String -> Parser RespDerivs MailboxStatus)
-> Parser RespDerivs MailboxStatus
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MailboxStatus -> Parser RespDerivs MailboxStatus
forall (m :: * -> *) a. Monad m => a -> m a
return (MailboxStatus -> Parser RespDerivs MailboxStatus)
-> (String -> MailboxStatus)
-> String
-> Parser RespDerivs MailboxStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> MailboxStatus
forall a. Read a => String -> a
read
                                , String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"UNSEEN"      Parser RespDerivs String
-> (String -> Parser RespDerivs MailboxStatus)
-> Parser RespDerivs MailboxStatus
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MailboxStatus -> Parser RespDerivs MailboxStatus
forall (m :: * -> *) a. Monad m => a -> m a
return (MailboxStatus -> Parser RespDerivs MailboxStatus)
-> (String -> MailboxStatus)
-> String
-> Parser RespDerivs MailboxStatus
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> MailboxStatus
forall a. Read a => String -> a
read
                                ]
                 Parser RespDerivs Char
space
                 Integer
num <- Parser RespDerivs Char -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d [v]
many1 Parser RespDerivs Char
forall d. Derivs d => Parser d Char
digit Parser RespDerivs String
-> (String -> Parser RespDerivs Integer)
-> Parser RespDerivs Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Integer -> Parser RespDerivs Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Parser RespDerivs Integer)
-> (String -> Integer) -> String -> Parser RespDerivs Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Integer
forall a. Read a => String -> a
read
                 (MailboxStatus, Integer)
-> Parser RespDerivs (MailboxStatus, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (MailboxStatus
cons, Integer
num)

pSearchLine :: Parser RespDerivs (Either a [UID])
pSearchLine :: Parser RespDerivs (Either a [UID])
pSearchLine = do String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"* SEARCH "
                 [String]
nums <- (Parser RespDerivs Char -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d [v]
many1 Parser RespDerivs Char
forall d. Derivs d => Parser d Char
digit) Parser RespDerivs String
-> Parser RespDerivs Char -> Parser RespDerivs [String]
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`sepBy` Parser RespDerivs Char
space
                 Parser RespDerivs String
forall d. Derivs d => Parser d String
crlfP
                 Either a [UID] -> Parser RespDerivs (Either a [UID])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a [UID] -> Parser RespDerivs (Either a [UID]))
-> Either a [UID] -> Parser RespDerivs (Either a [UID])
forall a b. (a -> b) -> a -> b
$ [UID] -> Either a [UID]
forall a b. b -> Either a b
Right ([UID] -> Either a [UID]) -> [UID] -> Either a [UID]
forall a b. (a -> b) -> a -> b
$ (String -> UID) -> [String] -> [UID]
forall a b. (a -> b) -> [a] -> [b]
map String -> UID
forall a. Read a => String -> a
read [String]
nums

pSelectLine :: Parser RespDerivs (MailboxInfo -> MailboxInfo)
pSelectLine :: Parser RespDerivs (MailboxInfo -> MailboxInfo)
pSelectLine =
    do String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"* "
       [Parser RespDerivs (MailboxInfo -> MailboxInfo)]
-> Parser RespDerivs (MailboxInfo -> MailboxInfo)
forall d v. Derivs d => [Parser d v] -> Parser d v
choice [ Parser RespDerivs Integer
pExistsLine Parser RespDerivs Integer
-> (Integer -> Parser RespDerivs (MailboxInfo -> MailboxInfo))
-> Parser RespDerivs (MailboxInfo -> MailboxInfo)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
n -> (MailboxInfo -> MailboxInfo)
-> Parser RespDerivs (MailboxInfo -> MailboxInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (\MailboxInfo
mbox -> MailboxInfo
mbox { _exists :: Integer
_exists = Integer
n })
              , Parser RespDerivs Integer
pRecentLine Parser RespDerivs Integer
-> (Integer -> Parser RespDerivs (MailboxInfo -> MailboxInfo))
-> Parser RespDerivs (MailboxInfo -> MailboxInfo)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
n -> (MailboxInfo -> MailboxInfo)
-> Parser RespDerivs (MailboxInfo -> MailboxInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (\MailboxInfo
mbox -> MailboxInfo
mbox { _recent :: Integer
_recent = Integer
n })
              , Parser RespDerivs [Flag]
pFlags  Parser RespDerivs [Flag]
-> ([Flag] -> Parser RespDerivs (MailboxInfo -> MailboxInfo))
-> Parser RespDerivs (MailboxInfo -> MailboxInfo)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Flag]
fs -> (MailboxInfo -> MailboxInfo)
-> Parser RespDerivs (MailboxInfo -> MailboxInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (\MailboxInfo
mbox -> MailboxInfo
mbox { _flags :: [Flag]
_flags = [Flag]
fs })
              , String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"OK " Parser RespDerivs String
-> Parser RespDerivs (MailboxInfo -> MailboxInfo)
-> Parser RespDerivs (MailboxInfo -> MailboxInfo)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser RespDerivs (MailboxInfo -> MailboxInfo)
okResps ]
    where pFlags :: Parser RespDerivs [Flag]
pFlags = do String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"FLAGS "
                      Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'('
                      [Flag]
fs <- Parser RespDerivs Flag
pFlag Parser RespDerivs Flag
-> Parser RespDerivs Char -> Parser RespDerivs [Flag]
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`sepBy` Parser RespDerivs Char
space
                      Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
')' Parser RespDerivs Char
-> Parser RespDerivs String -> Parser RespDerivs String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser RespDerivs String
forall d. Derivs d => Parser d String
crlfP
                      [Flag] -> Parser RespDerivs [Flag]
forall (m :: * -> *) a. Monad m => a -> m a
return [Flag]
fs
          okResps :: Parser RespDerivs (MailboxInfo -> MailboxInfo)
okResps =
              do Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'['
                 MailboxInfo -> MailboxInfo
v <- [Parser RespDerivs (MailboxInfo -> MailboxInfo)]
-> Parser RespDerivs (MailboxInfo -> MailboxInfo)
forall d v. Derivs d => [Parser d v] -> Parser d v
choice [ do { String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"UNSEEN "
                                  ; Parser RespDerivs Char -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d [v]
many1 Parser RespDerivs Char
forall d. Derivs d => Parser d Char
digit
                                  ; (MailboxInfo -> MailboxInfo)
-> Parser RespDerivs (MailboxInfo -> MailboxInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return MailboxInfo -> MailboxInfo
forall a. a -> a
id }
                             , do { String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"PERMANENTFLAGS ("
                                  ; [Flag]
fs <- Parser RespDerivs Flag
pFlag Parser RespDerivs Flag
-> Parser RespDerivs Char -> Parser RespDerivs [Flag]
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`sepBy` Parser RespDerivs Char
space
                                  ; Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
')'
                                  ; (MailboxInfo -> MailboxInfo)
-> Parser RespDerivs (MailboxInfo -> MailboxInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MailboxInfo -> MailboxInfo)
 -> Parser RespDerivs (MailboxInfo -> MailboxInfo))
-> (MailboxInfo -> MailboxInfo)
-> Parser RespDerivs (MailboxInfo -> MailboxInfo)
forall a b. (a -> b) -> a -> b
$ \MailboxInfo
mbox ->
                                      MailboxInfo
mbox { _isFlagWritable :: Bool
_isFlagWritable =
                                               String -> Flag
Keyword String
"*" Flag -> [Flag] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Flag]
fs
                                           , _permanentFlags :: [Flag]
_permanentFlags =
                                               (Flag -> Bool) -> [Flag] -> [Flag]
forall a. (a -> Bool) -> [a] -> [a]
filter (Flag -> Flag -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> Flag
Keyword String
"*") [Flag]
fs } }
                             , do { String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"UIDNEXT "
                                  ; String
n <- Parser RespDerivs Char -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d [v]
many1 Parser RespDerivs Char
forall d. Derivs d => Parser d Char
digit
                                  ; (MailboxInfo -> MailboxInfo)
-> Parser RespDerivs (MailboxInfo -> MailboxInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MailboxInfo -> MailboxInfo)
 -> Parser RespDerivs (MailboxInfo -> MailboxInfo))
-> (MailboxInfo -> MailboxInfo)
-> Parser RespDerivs (MailboxInfo -> MailboxInfo)
forall a b. (a -> b) -> a -> b
$ \MailboxInfo
mbox ->
                                      MailboxInfo
mbox { _uidNext :: UID
_uidNext = String -> UID
forall a. Read a => String -> a
read String
n } }
                             , do { String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"UIDVALIDITY "
                                  ; String
n <- Parser RespDerivs Char -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d [v]
many1 Parser RespDerivs Char
forall d. Derivs d => Parser d Char
digit
                                  ; (MailboxInfo -> MailboxInfo)
-> Parser RespDerivs (MailboxInfo -> MailboxInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return ((MailboxInfo -> MailboxInfo)
 -> Parser RespDerivs (MailboxInfo -> MailboxInfo))
-> (MailboxInfo -> MailboxInfo)
-> Parser RespDerivs (MailboxInfo -> MailboxInfo)
forall a b. (a -> b) -> a -> b
$ \MailboxInfo
mbox ->
                                      MailboxInfo
mbox { _uidValidity :: UID
_uidValidity = String -> UID
forall a. Read a => String -> a
read String
n } }
                             ]
                 Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
']'
                 Parser RespDerivs Char
forall d. Derivs d => Parser d Char
anyChar Parser RespDerivs Char
-> Parser RespDerivs String -> Parser RespDerivs String
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`manyTill` Parser RespDerivs String
forall d. Derivs d => Parser d String
crlfP
                 (MailboxInfo -> MailboxInfo)
-> Parser RespDerivs (MailboxInfo -> MailboxInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return MailboxInfo -> MailboxInfo
v

pFetchLine :: Parser RespDerivs (Either a (Integer, [(String, String)]))
pFetchLine :: Parser RespDerivs (Either a (Integer, [(String, String)]))
pFetchLine =
    do String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
"* "
       String
num <- Parser RespDerivs Char -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d [v]
many1 Parser RespDerivs Char
forall d. Derivs d => Parser d Char
digit
       String -> Parser RespDerivs String
forall d. Derivs d => String -> Parser d String
string String
" FETCH" Parser RespDerivs String
-> Parser RespDerivs String -> Parser RespDerivs String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser RespDerivs String
spaces
       Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'('
       [(String, String)]
pairs <- Parser RespDerivs (String, String)
pPair Parser RespDerivs (String, String)
-> Parser RespDerivs Char -> Parser RespDerivs [(String, String)]
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`manyTill` Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
')'
       Parser RespDerivs String
forall d. Derivs d => Parser d String
crlfP
       Either a (Integer, [(String, String)])
-> Parser RespDerivs (Either a (Integer, [(String, String)]))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (Integer, [(String, String)])
 -> Parser RespDerivs (Either a (Integer, [(String, String)])))
-> Either a (Integer, [(String, String)])
-> Parser RespDerivs (Either a (Integer, [(String, String)]))
forall a b. (a -> b) -> a -> b
$ (Integer, [(String, String)])
-> Either a (Integer, [(String, String)])
forall a b. b -> Either a b
Right ((Integer, [(String, String)])
 -> Either a (Integer, [(String, String)]))
-> (Integer, [(String, String)])
-> Either a (Integer, [(String, String)])
forall a b. (a -> b) -> a -> b
$ (String -> Integer
forall a. Read a => String -> a
read String
num, [(String, String)]
pairs)
    where pPair :: Parser RespDerivs (String, String)
pPair = do String
key <- (do String
k  <- Parser RespDerivs Char
forall d. Derivs d => Parser d Char
anyChar Parser RespDerivs Char
-> Parser RespDerivs Char -> Parser RespDerivs String
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`manyTill` Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'['
                                String
ps <- Parser RespDerivs Char
forall d. Derivs d => Parser d Char
anyChar Parser RespDerivs Char
-> Parser RespDerivs Char -> Parser RespDerivs String
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`manyTill` Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
']'
                                Parser RespDerivs Char
space
                                String -> Parser RespDerivs String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
kString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"["String -> String -> String
forall a. [a] -> [a] -> [a]
++String
psString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"]"))
                        Parser RespDerivs String
-> Parser RespDerivs String -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> Parser RespDerivs Char
forall d. Derivs d => Parser d Char
anyChar Parser RespDerivs Char
-> Parser RespDerivs Char -> Parser RespDerivs String
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`manyTill` Parser RespDerivs Char
space
                     String
value <- (do Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'('
                                  [String]
v <- Parser RespDerivs String
pParen Parser RespDerivs String
-> Parser RespDerivs Char -> Parser RespDerivs [String]
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`sepBy` Parser RespDerivs Char
space
                                  Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
')'
                                  String -> Parser RespDerivs String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"("String -> String -> String
forall a. [a] -> [a] -> [a]
++[String] -> String
unwords [String]
vString -> String -> String
forall a. [a] -> [a] -> [a]
++String
")"))
                          Parser RespDerivs String
-> Parser RespDerivs String -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> (do Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'{'
                                  Int
num <- Parser RespDerivs Char -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d [v]
many1 Parser RespDerivs Char
forall d. Derivs d => Parser d Char
digit Parser RespDerivs String
-> (String -> Parser RespDerivs Int) -> Parser RespDerivs Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Parser RespDerivs Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Parser RespDerivs Int)
-> (String -> Int) -> String -> Parser RespDerivs Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall a. Read a => String -> a
read
                                  Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'}' Parser RespDerivs Char
-> Parser RespDerivs String -> Parser RespDerivs String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser RespDerivs String
forall d. Derivs d => Parser d String
crlfP
                                  [Parser RespDerivs Char] -> Parser RespDerivs String
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Parser RespDerivs Char] -> Parser RespDerivs String)
-> [Parser RespDerivs Char] -> Parser RespDerivs String
forall a b. (a -> b) -> a -> b
$ Int -> Parser RespDerivs Char -> [Parser RespDerivs Char]
forall a. Int -> a -> [a]
replicate Int
num Parser RespDerivs Char
forall d. Derivs d => Parser d Char
anyChar)
                          Parser RespDerivs String
-> Parser RespDerivs String -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> (do Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'"'
                                  String
v <- String -> Parser RespDerivs Char
forall d. Derivs d => String -> Parser d Char
noneOf String
"\"" Parser RespDerivs Char
-> Parser RespDerivs Char -> Parser RespDerivs String
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`manyTill` Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'"'
                                  String -> Parser RespDerivs String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"\""String -> String -> String
forall a. [a] -> [a] -> [a]
++String
vString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\""))
                          Parser RespDerivs String
-> Parser RespDerivs String -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> Parser RespDerivs Char -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d [v]
many1 Parser RespDerivs Char
forall d. Derivs d => Parser d Char
atomChar
                     Parser RespDerivs String
spaces
                     (String, String) -> Parser RespDerivs (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
key, String
value)
          pParen :: Parser RespDerivs String
pParen = (do Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'"'
                       String
v <- String -> Parser RespDerivs Char
forall d. Derivs d => String -> Parser d Char
noneOf String
"\"" Parser RespDerivs Char
-> Parser RespDerivs Char -> Parser RespDerivs String
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`manyTill` Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'"'
                       String -> Parser RespDerivs String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"\""String -> String -> String
forall a. [a] -> [a] -> [a]
++String
vString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\""))
               Parser RespDerivs String
-> Parser RespDerivs String -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> (do Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'('
                       [String]
v <- Parser RespDerivs String
pParen Parser RespDerivs String
-> Parser RespDerivs Char -> Parser RespDerivs [String]
forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`sepBy` Parser RespDerivs Char
space
                       Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
')'
                       String -> Parser RespDerivs String
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"("String -> String -> String
forall a. [a] -> [a] -> [a]
++[String] -> String
unwords [String]
vString -> String -> String
forall a. [a] -> [a] -> [a]
++String
")"))
               Parser RespDerivs String
-> Parser RespDerivs String -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> (do Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
'\\'
                       String
v <- Parser RespDerivs Char -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d [v]
many1 Parser RespDerivs Char
forall d. Derivs d => Parser d Char
atomChar
                       String -> Parser RespDerivs String
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:String
v))
               Parser RespDerivs String
-> Parser RespDerivs String -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> Parser RespDerivs Char -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d [v]
many1 Parser RespDerivs Char
forall d. Derivs d => Parser d Char
atomChar

----------------------------------------------------------------------
-- auxiliary parsers
space :: Parser RespDerivs Char
space :: Parser RespDerivs Char
space   = Char -> Parser RespDerivs Char
forall d. Derivs d => Char -> Parser d Char
char Char
' '

spaces, spaces1 :: Parser RespDerivs String
spaces :: Parser RespDerivs String
spaces  = Parser RespDerivs Char -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d [v]
many Parser RespDerivs Char
space
spaces1 :: Parser RespDerivs String
spaces1 = Parser RespDerivs Char -> Parser RespDerivs String
forall d v. Derivs d => Parser d v -> Parser d [v]
many1 Parser RespDerivs Char
space

crlf :: String
crlf :: String
crlf = String
"\r\n"

crlfP :: Derivs d => Parser d String
crlfP :: Parser d String
crlfP = String -> Parser d String
forall d. Derivs d => String -> Parser d String
string String
crlf

lookups :: Eq a => a -> [(a, b)] -> [b]
lookups :: a -> [(a, b)] -> [b]
lookups a
_ [] = []
lookups a
k ((a
k', b
v):[(a, b)]
tl) | a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
k'   = b
v b -> [b] -> [b]
forall a. a -> [a] -> [a]
: a -> [(a, b)] -> [b]
forall a b. Eq a => a -> [(a, b)] -> [b]
lookups a
k [(a, b)]
tl
                       | Bool
otherwise = a -> [(a, b)] -> [b]
forall a b. Eq a => a -> [(a, b)] -> [b]
lookups a
k [(a, b)]
tl

---- Either handling
catRights :: [Either a b] -> [b]
catRights :: [Either a b] -> [b]
catRights []           = []
catRights (Right b
r:[Either a b]
tl) = b
r b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [Either a b] -> [b]
forall a b. [Either a b] -> [b]
catRights [Either a b]
tl
catRights (Either a b
_:[Either a b]
tl)       = [Either a b] -> [b]
forall a b. [Either a b] -> [b]
catRights [Either a b]
tl

catLefts :: [Either a b] -> [a]
catLefts :: [Either a b] -> [a]
catLefts []           = []
catLefts (Left a
r:[Either a b]
tl) = a
r a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [Either a b] -> [a]
forall a b. [Either a b] -> [a]
catLefts [Either a b]
tl
catLefts (Either a b
_:[Either a b]
tl)       = [Either a b] -> [a]
forall a b. [Either a b] -> [a]
catLefts [Either a b]
tl