module RESTng.RqHandlers.Response where

import Data.List(intercalate)
import Text.XHtml.Strict
import Control.Monad.Reader (ask)

import qualified Text.CxML as Cx
import Text.YuiGrid
import Network.HTTP.RedHandler

import RESTng.Utils (mapFst, mapSnd)
------------------------------------------------------------------
--------- Handler response types and combinators -----------------
------------------------------------------------------------------

type RESTngTitledRespBody = ([String], RESTngRespBody)
data RESTngRespBody =
                      CxMLResp (Cx.NonCxML)
                      | GridElems [GridElement ()]


type RESTngResp = HandlerRsp RESTngTitledRespBody

restngRespToRsp :: RESTngResp -> BasicRsp
restngRespToRsp = basicRspWith titledRespBodyToString

titledRespBodyToString :: RESTngTitledRespBody -> String
titledRespBodyToString (titlParts, bod) 
              = Cx.showNonCxmlStrict fullTitle cxmlBod
                where
                  cxmlBod = case bod of
                    GridElems gs -> gridPage gs
                    CxMLResp cx -> cx
                  fullTitle = intercalate " | " $  filter (not . null) titlParts -- HOOKME


withTitle :: Monad m => String -> RqHandlerT m (HandlerRsp ([String], a)) -> RqHandlerT m (HandlerRsp ([String], a))
withTitle t = fmap (addTitleToResp t)


-- combinators for responses with title
addTitleToResp :: String -> HandlerRsp ([String], a) -> HandlerRsp ([String], a)
addTitleToResp t resp = fmap (mapFst ((:) t)) resp

modTitledRespBod :: (a -> b) -> HandlerRsp ([String], a) -> HandlerRsp ([String], b)
modTitledRespBod f m = fmap (mapSnd f) m

--Response creation combinators
okRspWithTitle :: String -> a -> HandlerRsp ([String], a)
okRspWithTitle s x = return ([s], x)

okRspWithoutTitle :: a -> HandlerRsp ([String], a)
okRspWithoutTitle x = return ([], x)

okNonCxMLRsp :: Cx.NonCxML -> RESTngResp
okNonCxMLRsp = okRspWithoutTitle . CxMLResp

okNonCxMLStrRsp :: String -> RESTngResp
okNonCxMLStrRsp s = okRspWithTitle s (CxMLResp (Cx.h1 Cx./- [Cx.t s]))

okCxML :: Monad m => Cx.CxML RequestContext -> RqHandlerT m RESTngResp
okCxML cx = fmap (okNonCxMLRsp . Cx.runCxML cx) ask

htmlToCxML :: Html -> Cx.NonCxML
htmlToCxML = Cx.t . prettyHtmlFragment