content: module Network.IMAP.Parsers.Utils where
  
  import Network.IMAP.Types
  
  import           Data.Attoparsec.ByteString.Char8
  import qualified Data.Attoparsec.ByteString.Char8 as AP
  import qualified Data.Text as T
  import           Data.Text.Encoding (decodeUtf8)
  import qualified Data.ByteString.Char8 as BSC
  import           Data.Either.Combinators (rightToMaybe)
  import           Control.Monad (liftM)
  import           Control.Applicative ((<|>))
  
  import           Data.Set (Set)
  import qualified Data.Set as Set
  
  eatUntilClosingParen :: Parser BSC.ByteString
  eatUntilClosingParen = scan 0 hadClosedAllParens <* char ')'
  
  hadClosedAllParens :: Int -> Char -> Maybe Int
  hadClosedAllParens openingParenCount character
    | character == ')' =
      if openingParenCount == 1
        then Nothing
        else Just $ openingParenCount - 1
    | character == '(' = Just $ openingParenCount + 1
    | otherwise =  Just openingParenCount
  
  
  parseEmailList :: Parser [EmailAddress]
  parseEmailList = char '(' *> parseEmail `sepBy` char ' ' <* char ')'
  
  parseNString :: Parser T.Text
  parseNString = do
    char '"'
    nstring <- AP.takeWhile1 (/= '"')
    char '"'
    return $ decodeUtf8 nstring
  
  parseEmail :: Parser EmailAddress
  parseEmail = do
    char '('
    label <- nilOrValue $ parseNString
    char ' '
    route <- nilOrValue $ parseNString
    char ' '
  
    username <- nilOrValue $ parseNString
    char ' '
    domain <- nilOrValue $ parseNString
    char ')'
  
    return $ EmailAddress label route username domain
  
  nilOrValue :: Parser a -> Parser (Maybe a)
  nilOrValue parser = rightToMaybe <$> AP.eitherP (string "NIL") parser
  
  parseQuoted :: Parser BSC.ByteString
  parseQuoted =
    (string "\\\"" *> (BSC.init <$> AP.takeWhile1 (/= '"')) <* char '"')
      <|>
    (char '"' *> AP.takeWhile (/= '"') <* char '"')
  
  parseQuotedText :: Parser T.Text
  parseQuotedText = decodeUtf8 <$> parseQuoted
  
  parseNameAttribute :: Parser NameAttribute
  parseNameAttribute = do
    string "\\"
    name <- AP.takeWhile1 isAtomChar
    return $ case name of
            "Noinferiors" -> Noinferiors
            "Noselect" -> Noselect
            "Marked" -> Marked
            "Unmarked" -> Unmarked
            "HasNoChildren" -> HasNoChildren
            _ -> OtherNameAttr $ decodeUtf8 name
  
  parseListLikeResp :: BSC.ByteString -> Parser UntaggedResult
  parseListLikeResp prefix = do
    string prefix
    string " ("
    nameAttributes <- parseNameAttribute `sepBy` char ' '
  
    string ") \""
    delimiter <- liftM (decodeUtf8 . BSC.singleton) AP.anyChar
    string "\" "
    name <- liftM decodeUtf8 $ AP.takeWhile1 (/= '\r')
  
    let actualName = T.dropAround (== '"') name
    return $ ListR nameAttributes delimiter actualName
  
  atomSpecials :: Set Char
  atomSpecials = Set.fromList "(){ %*\\\n\r]\0"
  
  isAtomChar :: Char -> Bool
  isAtomChar = flip Set.notMember atomSpecials
  
  toInt :: BSC.ByteString -> Either ErrorMessage Integer
  toInt bs = if null parsed
      then Left errorMsg
      else Right . fst . head $ parsed
    where parsed = reads $ BSC.unpack bs
          errorMsg = T.concat ["Count not parse '", decodeUtf8 bs, "' as an integer"]
  
  parseNumber :: (Integer -> a) -> BSC.ByteString ->
    BSC.ByteString -> Parser (Either ErrorMessage a)
  parseNumber constructor prefix postfix = do
    if not . BSC.null $ prefix
      then string prefix <* char ' '
      else return BSC.empty
    parsedNumber <- takeWhile1 isDigit
    if not . BSC.null $ postfix
      then char ' ' *> string postfix
      else return BSC.empty
  
    return $ liftM constructor (toInt parsedNumber)
  
  parseLabel :: Parser BSC.ByteString
  parseLabel = parseQuoted <|>
               (char '\\' *> AP.takeWhile1 isAtomChar) <|>
               (AP.takeWhile1 isAtomChar)
  