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
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))
]
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"