module Network.HTTP.RedHandler.Response where

import Network.HTTP.RedHandler.HTTP_Fork.HTTP (Header(..), HasHeaders, getHeaders, setHeaders, insertHeaders,
                                                   Response(..), ResponseBody(..), HeaderName(..))
import Control.Monad (liftM)

---------------------------------------------------------------
--------- Parametric Handler response type --------------------
---------------------------------------------------------------

data HandlerRsp a = HandlerRsp {
                          hanRspHeaders :: [Header],
                          hanRspBody :: Either Non200Response a
                         }

data Non200Response = -- the 404 Not found response is not modeled here. The request handlers returns Nothing instead of a response if 
                      -- it is a not found scenario.
                      RedirectResp -- The redirect address is encoded on the headers
--                    | ErrorResp ErrorResp
--data ErrorResp = ForbiddenResp | ...

instance Monad HandlerRsp where
  return x = HandlerRsp [] (Right x)
  (HandlerRsp hdrs (Right x)) >>= f = insertHeaders hdrs $ f x
  (HandlerRsp hdrs (Left non200resp)) >>= f = (HandlerRsp hdrs (Left non200resp))

instance Functor HandlerRsp where
  fmap = liftM

instance HasHeaders (HandlerRsp a) where
    getHeaders = hanRspHeaders
    setHeaders rsp hdrs = rsp { hanRspHeaders = hdrs }

non200response :: Non200Response -> Response
non200response _ = redirectResponse

okHTTPStrResponse :: String -> Response
okHTTPStrResponse s = Response (2,0,0) "" [] (StringRespBody s)

redirectResponse :: Response
redirectResponse = Response (3,0,2) "" [] (StringRespBody "")

redirectToRsp ::String -> HandlerRsp a
redirectToRsp url = HandlerRsp [Header HdrLocation url] (Left RedirectResp)

---------------------------------------------------------------
--------- Basic response type and combinators -----------------
---------------------------------------------------------------
type BasicRsp = HandlerRsp BasicRspBody

data BasicRspBody = FileResp Integer{-size-} FilePath
                    | StrResp String

basicRspWith :: (a -> String) -> HandlerRsp a -> BasicRsp
basicRspWith f = fmap (StrResp . f)

fileRsp :: Integer -> FilePath -> BasicRsp
fileRsp i name = return (FileResp i name)

maybeBasicRspToResponse :: Maybe BasicRsp -> Response
maybeBasicRspToResponse Nothing = notFoundResponse
maybeBasicRspToResponse (Just rsp) = basicRspToResponse rsp

notFoundResponse :: Response
notFoundResponse = okHTTPStrResponse "File not found!"

basicRspToResponse :: BasicRsp -> Response
basicRspToResponse (HandlerRsp hrHeaders (Left resp)) = setHeaders (non200response resp) hrHeaders
basicRspToResponse (HandlerRsp hrHeaders (Right rspBd)) = setHeaders (basicRspBodyToResponse rspBd) hrHeaders

basicRspBodyToResponse :: BasicRspBody -> Response
basicRspBodyToResponse (StrResp s)       = Response (2,0,0) "" [] (StringRespBody s)
basicRspBodyToResponse (FileResp i path) = Response (2,0,0) "" [] (FileBody i path)
--FIXME: set content-type headers for FileResp? (for instance for pictures)