{- |
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 Control.Monad.Loops
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 $ articleHeadAndBody ++ articleStandard
head :: Monad m => ByteString -> NntpT m (Maybe Article)
head s = nntpSendCommand "HEAD" s $ articleHead ++ articleStandard
body :: Monad m => ByteString -> NntpT m (Maybe Article)
body s = nntpSendCommand "BODY" s $ Network.NNTP.Core.articleBody ++
                                    articleStandard
stat :: Monad m => ByteString -> NntpT m (Maybe Article)
stat s = nntpSendCommand "STAT" s $ articleStat ++ articleStandard
group :: Monad m => ByteString -> NntpT m (Maybe Group)
group s = nntpSendCommand "GROUP" s [
           (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)
          ]
last :: Monad m => NntpT m (Maybe Article)
last = nntpSendCommand "LAST" empty $ articleStat ++ articleCommon ++ [
        (422, many1 spaces *> return Nothing)]
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 $ articleStat ++ articleCommon ++ [
        (421, many1 spaces *> return Nothing)]
post :: Monad m => ByteString -> NntpT m ()
post p = nntpSendCommand "POST" empty [
          (340, nntpPSendText p [
                  (240, return ()),
                  (441, lift $ NntpT $ throwError PostingFailed)
                  ]),
          (440, lift $ NntpT $ throwError PostingNotAllowed)
         ]
-- Helpers
articleFirstLine :: Monad m => NntpParser m String
articleFirstLine =  many1 spaces *> integer *> many1 spaces *> iD <* line
articleHeadAndBody :: Monad m => [(Int, NntpParser m (Maybe Article))]
articleHeadAndBody = [(220, do i <- articleFirstLine
                               (h, b) <- (Just *** Just) <$> cHeadAndBody
                               return $ Just $ Article i h b)]
articleHead :: Monad m => [(Int, NntpParser m (Maybe Article))]
articleHead = [(221, do i <- articleFirstLine
                        h <- Just <$> text
                        return $ Just $ Article i h Nothing)]
articleBody :: Monad m => [(Int, NntpParser m (Maybe Article))]
articleBody = [(222, do i <- articleFirstLine
                        b <- Just <$> text
                        return $ Just $ Article i Nothing b)]
articleStat :: Monad m => [(Int, NntpParser m (Maybe Article))]
articleStat =
    [(223, (\i -> Just (Article i Nothing Nothing)) <$> articleFirstLine)]
articleCommon :: Monad m => [(Int, NntpParser m (Maybe Article))]
articleCommon = [(412, error "No group selected"),
                 (420, error "No current article")]
articleStandard :: Monad m => [(Int, NntpParser m (Maybe Article))]
articleStandard = articleCommon ++
                  [(423, many1 space *> return Nothing),
                   (430, many1 space *> return Nothing)]
cNewsgroupList :: Monad m => (Group -> m a) -> [(Int, NntpParser m [a])]
cNewsgroupList f =
    [(215, unfoldM ((try (string ".\r\n") >> return Nothing) <|>
                    (do n <- groupName <* many1 space
                        l <- integer <* many1 space
                        fi <- integer <* many1 space
                        v <- lift $ lift $ f $ Group n fi l
                        return $ Just v)))]
cHeadAndBody :: Monad m => NntpParser m (ByteString, ByteString)
cHeadAndBody = liftM2 (,) (pack <$> (anyChar `manyTill` try eoh)) text
               where eoh = string "\r\n\r\n"