{- |
Module      : $Header$
Description : Internalities of NNTP modules
Copyright   : (c) Maciej Piechotka
License     : LGPL 3 or later

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

This module contains internalities of NNTP library
-}
module Network.NNTP.Internal
    (
     -- * Types
     Article(..),
     Group(..),
     NntpT(..),
     NntpState(..),
     NntpConnection(..),
     NntpError(..),
     NntpParser,
     -- * Functions
     runNntpParser,
     nntpPutStr,
     nntpPutStrLn,
     nntpSendCommand,
     tryCommands
    )
where
import Control.Applicative hiding (empty)
import Control.Arrow
import Control.Monad.Error
import Control.Monad.State hiding (State)
import Data.ByteString.Lazy.Char8 hiding (foldl)
import Data.Monoid
import Text.Parsec hiding ((<|>), many)
import Text.Parsec.Pos

{- |
Represents a single article. Please note that except the splitting into header
and body no parsing is done.
-}
data Article = Article {
      -- | Returns the article ID
      articleID :: String,
      -- | Returns the article header. 'Data.Maybe.Nothing' indicates not
      -- fetched header.
      articleHeader :: Maybe ByteString,
      -- | Returns the article body. 'Data.Maybe.Nothing' indicates not
      -- fetched body.
      articleBody :: Maybe ByteString
    }

instance Show Article where
    show = ("Article "++) . articleID
instance Eq Article where
    (==) = curry (articleID *** articleID >>> uncurry (==))

{- | 
Represents a single group.
-}
data Group = Group {
      -- | Returns the group name.
      groupName :: String,
      -- | Returns the number of first article avaible.
      groupArticleFirst :: Integer,
      -- | Returns the number of last article avaible.
      groupArticleLast :: Integer
    }

instance Show Group where
    show = ("Group "++) . groupName
instance Eq Group where
    (==) = curry (groupName *** groupName >>> uncurry (==))

{- |
NntpConnection represents a connection in a NntpT monad.

Please note that for 'runNntpWithConnection' you need to supply both 'input'
and 'output' functions.
-}
data Monad m => NntpConnection m = NntpConnection {
      -- | Input is an stream which is from a server.
      input :: ByteString,
      -- | Output is a function which sends the data to a server.
      output :: ByteString -> m ()
    }
{- |
NntpState represents a state at given moment. Please note that this type is not
a part of stable API (when we will have one).
-}
data Monad m => NntpState m = NntpState {
      connection :: NntpConnection m
    }
{- |
NntpT represents a connection. Since some servers have short timeouts it is
recommended to keep the connections short.
-}
data Monad m => NntpT m a = NntpT {
      runNntpT :: StateT (NntpState m) (ErrorT NntpError m) a
    }

instance Monad m => Applicative (NntpT m) where
    pure = return
    (<*>) = ap
instance Monad m => Functor (NntpT m) where
    f `fmap` m = NntpT $ f <$> runNntpT m
instance Monad m => Monad (NntpT m) where
    m >>= f  = NntpT $ runNntpT m >>= runNntpT . f
    return = lift . return
instance MonadTrans NntpT where
    lift = NntpT . lift . lift
instance MonadIO m => MonadIO (NntpT m) where
    liftIO = lift . liftIO

{- |
Indicates an error of handling NNTP connection. Please note that this should
indicate client errors only (with the exception of 'ServiceDiscontinued', 
in some cases 'PostingFailed' and 'NoSuchCommand'. The last one if propagated
outside NNTP module indicates a bug in library or server.).
-}
data NntpError = NoSuchGroup
               -- ^ Indicates that operation was performed on group that does
               -- not exists.
               | NoSuchArticle
               -- ^ Indicates that operation was performed on article that does
               --  not exists.
               | PostingFailed
               -- ^ Indicates that posting operation failed for some reason.
               | PostingNotAllowed
               -- ^ Indicates that posting is not allowed.
               | ServiceDiscontinued
               -- ^ Indicates that service was discontinued.
               | NoSuchCommand
               -- ^ Indicates that command does not exists.
               deriving (Eq, Show, Read)
instance Error NntpError where
    noMsg = undefined
    strMsg = read

type NntpParser m a = ParsecT ByteString () (NntpT m) a
-- | Transforms "NntpParser" into "NntpT" monad taking care about input
-- position
runNntpParser :: Monad m => NntpParser m a -> NntpT m a
runNntpParser p = do s <- NntpT (gets $ input . connection)
                     r <- parserRep =<< runParsecT p
                                                   (State s (initialPos "") ())
                     case r of
                       Ok v (State i _ _) _ -> NntpT (modify $ pNI i) >>
                                               return v
                       Error e -> error $ show e
                  where parserRep (Consumed x) = x
                        parserRep (Empty x) = x
                        pNI i s = s {connection = (connection s) {input = i}}
-- | Puts an argument to output.
nntpPutStr :: Monad m => ByteString -> NntpT m ()
nntpPutStr s = lift . ($ s) =<< NntpT (gets $ output . connection)
-- | Puts an argument to output followed by end-of-line.
nntpPutStrLn :: Monad m => ByteString -> NntpT m ()
nntpPutStrLn = nntpPutStr . (`mappend` pack "\r\n")
-- | Sends a commad.
nntpSendCommand :: Monad m => String -- ^ Command.
                -> ByteString -- ^ Arguments.
                -> NntpParser m a -- ^ Parser of output.
                -> NntpT m a -- ^ Returned value from parser.
nntpSendCommand c a p = nntpPutStrLn (pack (c ++ " ") `mappend` a) >>
                        runNntpParser p
-- | Try commands one by one to check for existing command.
tryCommands :: Monad m => [NntpT m a] -- ^ Possible command.
            -> NntpT m a -- ^ Result
tryCommands = foldl (\a b -> NntpT $ runNntpT a `catchError`
                                     \e -> if e == NoSuchCommand
                                           then runNntpT b else throwError e)
                    (NntpT $ throwError NoSuchCommand)