{- |
Module      : $Header$
Description : NNTP commands from RFC977
Copyright   : (c) Maciej Piechotka
License     : LGPL 3 or later

Maintainer  : uzytkownik2@gmail.com
Stability   : none
Portability : portable

This module contains the common features and common interface.
-}
module Network.NNTP.Core
    (
     -- * Functions
     article,
     Network.NNTP.Core.head,
     body,
     stat,
     group,
     Network.NNTP.Core.last,
     list,
     newgroups,
     newnews,
     next,
     post
    )
where
import Control.Applicative hiding (empty)
import Control.Arrow
import Control.Monad.Error
import Data.ByteString.Lazy.Char8(ByteString, empty, pack)
import Data.Time
import Network.NNTP.Internal hiding (groupName)
import Network.NNTP.ParserHelpers
import System.Locale
import Text.Parsec hiding ((<|>))
article :: Monad m => ByteString -> NntpT m (Maybe Article)
article s = nntpSendCommand "ARTICLE" s $ articleCommon HeadAndBody
head :: Monad m => ByteString -> NntpT m (Maybe Article)
head s = nntpSendCommand "HEAD" s $ articleCommon Head
body :: Monad m => ByteString -> NntpT m (Maybe Article)
body s = nntpSendCommand "BODY" s $ articleCommon Body
stat :: Monad m => ByteString -> NntpT m (Maybe Article)
stat s = nntpSendCommand "STAT" s $ articleCommon Nil
group :: Monad m => ByteString -> NntpT m (Maybe Group)
group s = nntpSendCommand "GROUP" s $ do
            c <- code <* many1 spaces
            case c of
              211 -> do f <- (integer >> many1 spaces) *> integer <*
                             many1 spaces
                        l <- integer <* many1 spaces
                        g <- groupName <* line
                        return $ Just $ Group g f l
              411 -> return Nothing
              _ -> error "Unknown response"
last :: Monad m => NntpT m (Maybe Article)
last = nntpSendCommand "LAST" empty $ articleCommon Nil
list :: Monad m => (Group -> m a) -> NntpT m [a]
list f = nntpSendCommand "LIST" empty $ cNewsgroupList f
newgroups :: Monad m => UTCTime -> (Group -> m a) -> NntpT m [a]
newgroups t f = nntpSendCommand "NEWGROUPS" (pack $ sh t) $ cNewsgroupList f
                where sh = formatTime defaultTimeLocale "%y%m%d %H%M%S GMT"
newnews :: Monad m => UTCTime -> Group -> (Article -> m a) -> NntpT m [a]
newnews = undefined
next :: Monad m => NntpT m (Maybe Article)
next = nntpSendCommand "NEXT" empty $ articleCommon Nil
post :: Monad m => ByteString -> NntpT m ()
post p = do nntpPutStrLn $ pack "POST"
            l <- runNntpParser $ code <* line
            case l of
              340 -> return ()
              440 -> NntpT $ throwError PostingNotAllowed
              _ -> error "Unknown response"
            nntpPutStrLn p
            l' <- runNntpParser $ code <* line
            case l' of
              240 -> return ()
              441 -> NntpT $ throwError PostingFailed
              _ -> error "Unknown response"
data ArticleReq = HeadAndBody
                | Head
                | Body
                | Nil
articleCommon :: Monad m => ArticleReq -> NntpParser m (Maybe Article)
articleCommon r = do
  rn <- code
  case rn of
    412 -> error "No group selected"
    420 -> error "No current article"
    421 -> return Nothing
    422 -> return Nothing
    423 -> return Nothing
    430 -> return Nothing
    _ -> if not $ rn `elem` correct
         then error "Unknown response"
         else if articleReq2Int r /= rn
         then error "Incorrect response"
         else do
           many1 spaces >> integer >> many1 spaces
           i <- iD <* line
           case r of
             HeadAndBody -> Just <$> liftM (uncurry (Article i))
                                           ((Just *** Just) <$> cHeadAndBody)
             Head -> Just <$> liftM2 (Article i) (Just <$> text)
                                                 (pure Nothing)
             Body -> Just <$> liftM (Article i Nothing) (Just <$> text)
             Nil -> return $ Just $ Article i Nothing Nothing
         where correct = [220, 221, 222, 223]
               articleReq2Int HeadAndBody = 220
               articleReq2Int Head = 221
               articleReq2Int Body = 222
               articleReq2Int Nil = 223
cNewsgroupList :: Monad m => (Group -> m a) -> NntpParser m [a]
cNewsgroupList f = do c <- code <* line
                      case c of
                        215 -> readGroups
                        _ -> error "Unknown response"
                   where readGroups = try (string ".\r\n" >> return []) <|>
                                      liftM2 (:) (lift . lift . f =<<
                                                  (do n <- groupName <*
                                                           many1 space
                                                      l <- integer <*
                                                           many1 space
                                                      fi <- integer <* line
                                                      return $ Group n fi l))
                                                 readGroups
cHeadAndBody :: Monad m => NntpParser m (ByteString, ByteString)
cHeadAndBody = liftM2 (,) (pack <$> (anyChar `manyTill` try eoh)) text
               where eoh = string "\r\n\r\n"