module Network.HGopher (mainServer, GResponse(..), Item(..), Record(..)) where

import Network.Socket
import System.IO
import Control.Exception
import Control.Concurrent
import Control.Monad
import Data.ByteString (ByteString)
import Data.List (intercalate)

data Record = Record { name :: String
                     , selector :: String
                     , host :: String
                     , port :: PortNumber
                     , other :: [String] }

-- the field is the name of the resource
data Item = PlainText
          | Directory
          | CSOSearch
          | ErrorMess
          | BinHexTxt
          | BinaryArc
          | UUEncoded
          | SearchEng
          | TelnetPtr
          | BinaryFil
          | GIFImage 
          | HTMLFile 
          | Info     
          | Image    
          | Audio    
          | TN3270Ptr
          deriving Show

itemKey :: Item -> Char
itemKey PlainText = '0'
itemKey Directory = '1'
itemKey CSOSearch = '2'
itemKey ErrorMess = '3'
itemKey BinHexTxt = '4'
itemKey BinaryArc = '5'
itemKey UUEncoded = '6'
itemKey SearchEng = '7'
itemKey TelnetPtr = '8'
itemKey BinaryFil = '9'
itemKey GIFImage  = 'g'
itemKey HTMLFile  = 'h'
itemKey Info      = 'i'
itemKey Image     = 'l'
itemKey Audio     = 's'
itemKey TN3270Ptr = 'T'

data GResponse = GItems [(Item, Record)] -- ^ A listing
               | GFile ByteString -- ^ A raw response

formatResp :: GResponse -> String
formatResp (GItems xs) = intercalate ""
                       $ map (\s -> field s ++ "\r\n") xs
  where
    field (i, (Record n s h p os)) = intercalate "\t"
                                   $ [(itemKey i): n, s, h, show p] ++ os
formatResp (GFile bs) = show bs -- TODO: utf8 encode

-- | This function runs the server.
-- Provide a port number and a function to handle requests.
mainServer :: PortNumber -> (String -> IO GResponse) -> IO ()
mainServer port process = do
  sock <- socket AF_INET Stream 0
  setSocketOption sock ReuseAddr 1
  bindSocket sock (SockAddrInet port iNADDR_ANY)
  listen sock 1024
  mainLoop sock process

mainLoop :: Socket -> (String -> IO GResponse) -> IO ()
mainLoop sock process = do
  conn <- accept sock
  forkIO (runConn conn process)
  mainLoop sock process

runConn :: (Socket, SockAddr) -> (String -> IO GResponse) -> IO ()
runConn (sock, _) process = do
  hdl <- socketToHandle sock ReadWriteMode
  hSetBuffering hdl NoBuffering
  request <- hGetLine hdl
  putStrLn $ "Request: " ++ request
  response <- formatResp `fmap` process (strip request)
  hPutStr hdl response
  hPutStr hdl ".\r\n"
  hClose hdl

strip x
  | null x = x
  | last x == '\r' = init x
  | otherwise = x