{- |
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
import Network.NNTP.Internal.Article
import Network.NNTP.Internal.Group 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 $ \s -> return $! (s, Left PostingFailed))
                  ]),
          (440, lift $ NntpT $ \s -> return $! (s, Left 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"