module Network.NNTP.Core
(
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)
]
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"