-- | NNTP client fudget (RFC 3977)
module NntpF(nntpF,nntpF',
             NntpRequest(..),NntpResponse(..),Part(..),Group(..),
             GroupName,ArticleNr,ArticleId) where
import Fudgets
import Utils2(trim)
import NntpIO

data NntpRequest = GetGroup GroupName
                 | GetArticle [Part] GroupName ArticleNr
		 | GetArticleWithId [Part] ArticleId
                 | GetHeadersRange HeaderName (ArticleNr,ArticleNr)
		 deriving (Show)

data NntpResponse = Group Group
                  | Article [Part] ArticleNr ArticleId [String]
                       -- ^ parts  #         id        lines
                  | Headers [(ArticleNr,String)]
                  | NntpError String
		  deriving (Show)

type HeaderName = String
type GroupName = String
type ArticleNr = Int
type ArticleId = String

type Group = (String,Int,Int,Int) -- ^ (name,cnt,first,last)

data Part = Head | Body deriving (Show)

-- | Connect to the NNTP server on the standard host and port
nntpF = nntpF' (nntpHost,nntpPort)

nntpHost = argKey "nntphost" "news"
nntpPort = argReadKey "nntpport" 119

-- | Connect to the NNTP server on the specified host and port
nntpF' = loopThroughRightF (absF nntpSP0) . nntpIOF

nntpSP0 =
  getNntp $ \ msg ->
  nntpSP ""

nntpSP group =
  getCmd $ \cmd ->
  execNntpCmd group cmd $ \ group' resp ->
  putResp resp $
  nntpSP group'

putNntp cmd = putSP (Left cmd)
putResp resp = putSP (Right resp)

execNntpCmd group cmd cont =
  case cmd of
    GetGroup group' ->
      nntpCmd ("GROUP "++group') $
      cont group'
    GetArticle parts group' n ->
      (if group'==group
       then id
       else nntpCmd ("GROUP "++group') . const) $
      nntpCmd (unwords [partCmd parts,show n]) $
      cont group'
    GetArticleWithId parts id ->
      nntpCmd (unwords [partCmd parts,id]) $
      cont group
    GetHeadersRange hdr (from,to) ->
      nntpCmd (unwords ["HDR",hdr,show from++"-"++show to]) $
      cont group

partCmd [] = "STAT"
partCmd [Head] = "HEAD"
partCmd [Body] = "BODY"
partCmd _ = "ARTICLE"

nntpCmd s cont =
  putNntp s $
  getNntp $ \ r ->
  cont (resp r)

resp (status:text) =
  case words status of
    "211":cnt:first:last:group:_ ->
      Group (group,read cnt,read first,read last)
    "220":n:id:_ ->
      Article [Head,Body] (read n) id text
    "221":n:id:_ ->
      Article [Head] (read n) id text
    "222":n:id:_ ->
      Article [Body] (read n) id text
    "223":n:id:_ ->
      Article [] (read n) id text
    "225":_ ->
      Headers [(nr,trim hdr) | line<-text, (nr,hdr)<-reads line]
    _ -> NntpError status