-- | 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 :: forall r.
(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    -> forall a. HasCallStack => String -> a
error (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  = forall d v. v -> d -> ParseError -> Result d v
Parsed String
tagstr RespDerivs
d (forall d. Derivs d => d -> ParseError
nullError RespDerivs
d)
          chr :: Result RespDerivs Char
chr  = if ByteString -> Bool
BS.null ByteString
s
                 then forall d v. ParseError -> Result d v
NoParse (forall d. Derivs d => d -> ParseError
eofError RespDerivs
d)
                 else let (Char
c, ByteString
s') = (ByteString -> Char
BS.head ByteString
s, HasCallStack => ByteString -> ByteString
BS.tail ByteString
s)
                      in 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')
                           (forall d. Derivs d => d -> ParseError
nullError RespDerivs
d)

eval' :: (RespDerivs -> Result RespDerivs r) -> String -> String -> r
eval' :: forall r.
(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    -> forall a. HasCallStack => String -> a
error (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  = forall d v. v -> d -> ParseError -> Result d v
Parsed String
tagstr RespDerivs
d (forall d. Derivs d => d -> ParseError
nullError RespDerivs
d)
          chr :: Result RespDerivs Char
chr  = case String
s of
                   (Char
c:String
s') -> 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')
                               (forall d. Derivs d => d -> ParseError
nullError RespDerivs
d)
                   String
_      -> forall d v. ParseError -> Result d v
NoParse (forall d. Derivs d => d -> ParseError
eofError RespDerivs
d)

mkMboxUpdate :: [Either (String, Integer) b] -> (MboxUpdate, [b])
mkMboxUpdate :: forall b. [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' = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"EXISTS" forall a b. (a -> b) -> a -> b
$ forall a b. [Either a b] -> [a]
catLefts [Either (String, Integer) b]
untagged
          recent' :: Maybe Integer
recent' = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"RECENT" forall a b. (a -> b) -> a -> b
$ forall a b. [Either a b] -> [a]
catLefts [Either (String, Integer) b]
untagged
          others :: [b]
others = 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 <- forall d v. Derivs d => Parser d v -> Parser d [v]
many forall b. Parser RespDerivs (Either (String, Integer) b)
pOtherLine
       ServerResponse
resp <- forall d v. (d -> Result d v) -> Parser d v
Parser RespDerivs -> Result RespDerivs ServerResponse
pDone
       let (MboxUpdate
mboxUp, [Any]
_) = forall b. [Either (String, Integer) b] -> (MboxUpdate, [b])
mkMboxUpdate [Either (String, Integer) Any]
untagged
       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 <- forall d v. Derivs d => Parser d v -> Parser d [v]
many (forall a. Parser RespDerivs (Either a [String])
pCapabilityLine forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> forall b. Parser RespDerivs (Either (String, Integer) b)
pOtherLine)
       ServerResponse
resp <- forall d v. (d -> Result d v) -> Parser d v
Parser RespDerivs -> Result RespDerivs ServerResponse
pDone
       let (MboxUpdate
mboxUp, [[String]]
caps) = forall b. [Either (String, Integer) b] -> (MboxUpdate, [b])
mkMboxUpdate [Either (String, Integer) [String]]
untagged
       forall (m :: * -> *) a. Monad m => a -> m a
return (ServerResponse
resp, MboxUpdate
mboxUp, 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 <- forall d v. Derivs d => Parser d v -> Parser d [v]
many (forall a.
String
-> Parser RespDerivs (Either a ([Attribute], String, String))
pListLine String
"LIST" forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> forall b. Parser RespDerivs (Either (String, Integer) b)
pOtherLine)
       ServerResponse
resp <- forall d v. (d -> Result d v) -> Parser d v
Parser RespDerivs -> Result RespDerivs ServerResponse
pDone
       let (MboxUpdate
mboxUp, [([Attribute], String, String)]
listRes) = forall b. [Either (String, Integer) b] -> (MboxUpdate, [b])
mkMboxUpdate [Either (String, Integer) ([Attribute], String, String)]
untagged
       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 <- forall d v. Derivs d => Parser d v -> Parser d [v]
many (forall a.
String
-> Parser RespDerivs (Either a ([Attribute], String, String))
pListLine String
"LSUB" forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> forall b. Parser RespDerivs (Either (String, Integer) b)
pOtherLine)
       ServerResponse
resp <- forall d v. (d -> Result d v) -> Parser d v
Parser RespDerivs -> Result RespDerivs ServerResponse
pDone
       let (MboxUpdate
mboxUp, [([Attribute], String, String)]
listRes) = forall b. [Either (String, Integer) b] -> (MboxUpdate, [b])
mkMboxUpdate [Either (String, Integer) ([Attribute], String, String)]
untagged
       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 <- forall d v. Derivs d => Parser d v -> Parser d [v]
many (forall a. Parser RespDerivs (Either a [(MailboxStatus, Integer)])
pStatusLine forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> forall b. Parser RespDerivs (Either (String, Integer) b)
pOtherLine)
       ServerResponse
resp <- forall d v. (d -> Result d v) -> Parser d v
Parser RespDerivs -> Result RespDerivs ServerResponse
pDone
       let (MboxUpdate
mboxUp, [[(MailboxStatus, Integer)]]
statRes) = forall b. [Either (String, Integer) b] -> (MboxUpdate, [b])
mkMboxUpdate [Either (String, Integer) [(MailboxStatus, Integer)]]
untagged
       forall (m :: * -> *) a. Monad m => a -> m a
return (ServerResponse
resp, MboxUpdate
mboxUp, 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 <- forall d v. Derivs d => Parser d v -> Parser d [v]
many ((do forall d. Derivs d => String -> Parser d String
string String
"* "
                             Integer
n <- Parser RespDerivs Integer
pExpungeLine
                             forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (String
"EXPUNGE", Integer
n))
                         forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> forall b. Parser RespDerivs (Either (String, Integer) b)
pOtherLine)
       ServerResponse
resp <- forall d v. (d -> Result d v) -> Parser d v
Parser RespDerivs -> Result RespDerivs ServerResponse
pDone
       let (MboxUpdate
mboxUp, [(String, Integer)]
expunges) = forall b. [Either (String, Integer) b] -> (MboxUpdate, [b])
mkMboxUpdate [Either (String, Integer) (String, Integer)]
untagged
       forall (m :: * -> *) a. Monad m => a -> m a
return (ServerResponse
resp, MboxUpdate
mboxUp, 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 <- forall d v. Derivs d => Parser d v -> Parser d [v]
many (forall a. Parser RespDerivs (Either a [UID])
pSearchLine forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> forall b. Parser RespDerivs (Either (String, Integer) b)
pOtherLine)
       ServerResponse
resp <- forall d v. (d -> Result d v) -> Parser d v
Parser RespDerivs -> Result RespDerivs ServerResponse
pDone
       let (MboxUpdate
mboxUp, [[UID]]
searchRes) = forall b. [Either (String, Integer) b] -> (MboxUpdate, [b])
mkMboxUpdate [Either (String, Integer) [UID]]
untagged
       forall (m :: * -> *) a. Monad m => a -> m a
return (ServerResponse
resp, MboxUpdate
mboxUp, 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 <- forall d v. Derivs d => Parser d v -> Parser d [v]
many (Parser RespDerivs (MailboxInfo -> MailboxInfo)
pSelectLine
                         forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> (do forall d. Derivs d => String -> Parser d String
string String
"* "
                                 forall d. Derivs d => Parser d Char
anyChar forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`manyTill` forall d. Derivs d => Parser d String
crlfP
                                 forall (m :: * -> *) a. Monad m => a -> m a
return forall a. a -> a
id))
       ServerResponse
resp <- 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 = forall a. Maybe a -> Bool
isJust Maybe StatusCode
writable Bool -> Bool -> Bool
&& forall a. HasCallStack => Maybe a -> a
fromJust Maybe StatusCode
writable forall a. Eq a => a -> a -> Bool
== StatusCode
READ_WRITE }
                   ServerResponse
_ -> MailboxInfo
emptyBox
       forall (m :: * -> *) a. Monad m => a -> m a
return (ServerResponse
resp, Maybe Integer -> Maybe Integer -> MboxUpdate
MboxUpdate forall a. Maybe a
Nothing forall a. Maybe a
Nothing, forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 <- forall d v. Derivs d => Parser d v -> Parser d [v]
many (forall a.
Parser RespDerivs (Either a (Integer, [(String, String)]))
pFetchLine forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> forall b. Parser RespDerivs (Either (String, Integer) b)
pOtherLine)
       ServerResponse
resp <- forall d v. (d -> Result d v) -> Parser d v
Parser RespDerivs -> Result RespDerivs ServerResponse
pDone
       let (MboxUpdate
mboxUp, [(Integer, [(String, String)])]
fetchRes) = forall b. [Either (String, Integer) b] -> (MboxUpdate, [b])
mkMboxUpdate [Either (String, Integer) (Integer, [(String, String)])]
untagged
       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 <- forall d v. (d -> Result d v) -> Parser d v
Parser RespDerivs -> Result RespDerivs String
advTag
                  forall d. Derivs d => String -> Parser d String
string String
tag 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 <- forall d v. Derivs d => Parser d v -> Parser d (Maybe v)
optional (do StatusCode
s <- Parser RespDerivs StatusCode
parseStatusCode
                                       Parser RespDerivs Char
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return StatusCode
s)
                  String
body <- forall d. Derivs d => Parser d Char
anyChar forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`manyTill` forall d. Derivs d => Parser d String
crlfP
                  forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall d v. Derivs d => [Parser d v] -> Parser d v
choice forall a b. (a -> b) -> a -> b
$ [ forall d. Derivs d => String -> Parser d String
string String
"OK" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe StatusCode -> String -> ServerResponse
OK
                               , forall d. Derivs d => String -> Parser d String
string String
"NO" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe StatusCode -> String -> ServerResponse
NO
                               , forall d. Derivs d => String -> Parser d String
string String
"BAD" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe StatusCode -> String -> ServerResponse
BAD
                               , forall d. Derivs d => String -> Parser d String
string String
"PREAUTH" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe StatusCode -> String -> ServerResponse
PREAUTH
                               ]
          parseStatusCode :: Parser RespDerivs StatusCode
parseStatusCode =
              forall d vs ve v.
Derivs d =>
Parser d vs -> Parser d ve -> Parser d v -> Parser d v
between (forall d. Derivs d => Char -> Parser d Char
char Char
'[') (forall d. Derivs d => Char -> Parser d Char
char Char
']') forall a b. (a -> b) -> a -> b
$
              forall d v. Derivs d => [Parser d v] -> Parser d v
choice [ forall d. Derivs d => String -> Parser d String
string String
"ALERT" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return StatusCode
ALERT
                     , do { forall d. Derivs d => String -> Parser d String
string String
"BADCHARSET"
                          ; Maybe [String]
ws <- forall d v. Derivs d => Parser d v -> Parser d (Maybe v)
optional Parser RespDerivs [String]
parenWords
                          ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String] -> StatusCode
BADCHARSET forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [] Maybe [String]
ws }
                     , do { forall d. Derivs d => String -> Parser d String
string String
"CAPABILITY"
                          ; Parser RespDerivs Char
space
                          ; [String]
ws <- (forall d v. Derivs d => Parser d v -> Parser d [v]
many1 forall a b. (a -> b) -> a -> b
$ forall d. Derivs d => String -> Parser d Char
noneOf String
" ]") forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`sepBy1` Parser RespDerivs Char
space
                          ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String] -> StatusCode
CAPABILITY_sc [String]
ws }
                     , forall d. Derivs d => String -> Parser d String
string String
"PARSE" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return StatusCode
PARSE
                     , do { forall d. Derivs d => String -> Parser d String
string String
"PERMANENTFLAGS" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser RespDerivs Char
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall d. Derivs d => Char -> Parser d Char
char Char
'('
                          ; [Flag]
fs <- Parser RespDerivs Flag
pFlag forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`sepBy1` Parser RespDerivs String
spaces1
                          ; forall d. Derivs d => Char -> Parser d Char
char Char
')'
                          ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Flag] -> StatusCode
PERMANENTFLAGS [Flag]
fs }
                     , forall d. Derivs d => String -> Parser d String
string String
"READ-ONLY" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return StatusCode
READ_ONLY
                     , forall d. Derivs d => String -> Parser d String
string String
"READ-WRITE" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return StatusCode
READ_WRITE
                     , forall d. Derivs d => String -> Parser d String
string String
"TRYCREATE" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return StatusCode
TRYCREATE
                     , do { forall d. Derivs d => String -> Parser d String
string String
"UNSEEN" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser RespDerivs Char
space
                          ; String
num <- forall d v. Derivs d => Parser d v -> Parser d [v]
many1 forall d. Derivs d => Parser d Char
digit
                          ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer -> StatusCode
UNSEEN_sc forall a b. (a -> b) -> a -> b
$ forall a. Read a => String -> a
read String
num }
                     , do { forall d. Derivs d => String -> Parser d String
string String
"UIDNEXT" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser RespDerivs Char
space
                          ; String
num <- forall d v. Derivs d => Parser d v -> Parser d [v]
many1 forall d. Derivs d => Parser d Char
digit
                          ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ UID -> StatusCode
UIDNEXT_sc forall a b. (a -> b) -> a -> b
$ forall a. Read a => String -> a
read String
num }
                     , do { forall d. Derivs d => String -> Parser d String
string String
"UIDVALIDITY" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser RespDerivs Char
space
                          ; String
num <- forall d v. Derivs d => Parser d v -> Parser d [v]
many1 forall d. Derivs d => Parser d Char
digit
                          ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ UID -> StatusCode
UIDVALIDITY_sc forall a b. (a -> b) -> a -> b
$ forall a. Read a => String -> a
read String
num }
                     ]
          parenWords :: Parser RespDerivs [String]
parenWords = forall d vs ve v.
Derivs d =>
Parser d vs -> Parser d ve -> Parser d v -> Parser d v
between (Parser RespDerivs Char
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall d. Derivs d => Char -> Parser d Char
char Char
'(') (forall d. Derivs d => Char -> Parser d Char
char Char
')')
                         (forall d v. Derivs d => Parser d v -> Parser d [v]
many1 (forall d. Derivs d => String -> Parser d Char
noneOf 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 forall d. Derivs d => Char -> Parser d Char
char Char
'\\'
           forall d v. Derivs d => [Parser d v] -> Parser d v
choice [ forall d. Derivs d => String -> Parser d String
string String
"Seen"     forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Flag
Seen
                  , forall d. Derivs d => String -> Parser d String
string String
"Answered" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Flag
Answered
                  , forall d. Derivs d => String -> Parser d String
string String
"Flagged"  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Flag
Flagged
                  , forall d. Derivs d => String -> Parser d String
string String
"Deleted"  forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Flag
Deleted
                  , forall d. Derivs d => String -> Parser d String
string String
"Draft"    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Flag
Draft
                  , forall d. Derivs d => String -> Parser d String
string String
"Recent"   forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Flag
Recent
                  , forall d. Derivs d => Char -> Parser d Char
char Char
'*'          forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Flag
Keyword String
"*")
                  , forall d v. Derivs d => Parser d v -> Parser d [v]
many1 forall d. Derivs d => Parser d Char
atomChar    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Flag
Keyword ]
    forall d v. Derivs d => Parser d v -> Parser d v -> Parser d v
<|> (forall d v. Derivs d => Parser d v -> Parser d [v]
many1 forall d. Derivs d => Parser d Char
atomChar forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall d. Derivs d => Char -> Parser d Char
char Char
'('
                        [Flag]
fs <- Parser RespDerivs Flag
pFlag forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`sepBy` Parser RespDerivs Char
space
                        forall d. Derivs d => Char -> Parser d Char
char Char
')'
                        forall (m :: * -> *) a. Monad m => a -> m a
return [Flag]
fs

atomChar :: Derivs d => Parser d Char
atomChar :: forall d. Derivs d => Parser d Char
atomChar = 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 <- forall d v. Derivs d => Parser d v -> Parser d [v]
many1 forall d. Derivs d => Parser d Char
digit
                       Parser RespDerivs Char
space
                       forall d. Derivs d => String -> Parser d String
string String
str
                       forall d. Derivs d => Parser d String
crlfP
                       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 :: forall b. Parser RespDerivs (Either (String, Integer) b)
pOtherLine = do forall d. Derivs d => String -> Parser d String
string String
"* "
                forall d v. Derivs d => [Parser d v] -> Parser d v
choice [ Parser RespDerivs Integer
pExistsLine forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
n -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (String
"EXISTS", Integer
n))
                       , Parser RespDerivs Integer
pRecentLine forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
n -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (String
"RECENT", Integer
n))
                       , Parser RespDerivs String
blankLine forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left (String
"", Integer
0))]
    where blankLine :: Parser RespDerivs String
blankLine = forall d. Derivs d => Parser d Char
anyChar forall d v vend.
Derivs d =>
Parser d v -> Parser d vend -> Parser d [v]
`manyTill` forall d. Derivs d => Parser d String
crlfP


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

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

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

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

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

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

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

spaces, spaces1 :: Parser RespDerivs String
spaces :: Parser RespDerivs String
spaces  = forall d v. Derivs d => Parser d v -> Parser d [v]
many Parser RespDerivs Char
space
spaces1 :: Parser RespDerivs String
spaces1 = 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 :: forall d. Derivs d => Parser d String
crlfP = forall d. Derivs d => String -> Parser d String
string String
crlf

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

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

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