module Rakka.Resource.Render
    ( resRender
    )
    where

import           Control.Arrow
import           Control.Arrow.ArrowIO
import           Control.Arrow.ArrowList
import           Control.Monad.Trans
import qualified Codec.Binary.UTF8.String as UTF8
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.Map as M
import           Network.HTTP.Lucu
import           Network.HTTP.Lucu.Utils
import           Rakka.Environment
import           Rakka.Page
import           Rakka.Wiki
import           Rakka.Wiki.Engine
import           Rakka.Wiki.Parser
import           Rakka.Wiki.Interpreter
import           Text.ParserCombinators.Parsec
import           Text.XML.HXT.Arrow.Namespace
import           Text.XML.HXT.Arrow.WriteDocument
import           Text.XML.HXT.Arrow.XmlArrow
import           Text.XML.HXT.Arrow.XmlIOStateArrow
import           Text.XML.HXT.DOM.TypeDefs
import           Text.XML.HXT.DOM.XmlKeywords


resRender :: Environment -> ResourceDef
resRender env
    = ResourceDef {
        resUsesNativeThread = False
      , resIsGreedy         = True
      , resGet              = Nothing
      , resHead             = Nothing
      , resPost             = Just $ getPathInfo >>= handleRender env . toPageName
      , resPut              = Nothing
      , resDelete           = Nothing
      }
    where
      toPageName :: [String] -> PageName
      toPageName = decodePageName . joinWith "/" 


{-
  --- Request ---
  POST /render/Foo/Bar HTTP/1.0
  Content-Type: text/x-rakka
  
  = foo =
  blah blah...
  
  --- Response ---
  HTTP/1.1 200 OK
  Content-Type: text/xml
  
  <renderResult xmlns:xhtml="http://www.w3.org/1999/xhtml"
                name="Foo/Bar">
    <xhtml:h1>foo</xhtml:h1>
    <xhtml:p>
      blah blah...
    </xhtml:p>
  </renderResult>
-}
handleRender :: Environment -> PageName -> Resource ()
handleRender env name
    = do cType <- guessTypeIfNeeded =<< getContentType
         bin   <- inputLBS defaultLimit

         setContentType $ read "text/xml"
         [xmlStr] <- liftIO $ runX ( setErrorMsgHandler False fail
                                     >>>
                                     constA (name, cType, bin)
                                     >>>
                                     render env
                                     >>>
                                     writeDocumentToString [ (a_indent, v_1) ]
                                   )
         output xmlStr
    where
      guessTypeIfNeeded :: Maybe MIMEType -> Resource MIMEType
      guessTypeIfNeeded (Just t) = return t
      guessTypeIfNeeded Nothing  = fail "not impl"


render :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
          Environment
       -> a (PageName, MIMEType, Lazy.ByteString) XmlTree
render env
    = proc (pName, pType, pBin)
    -> do pageBody <- listA (makePreviewXHTML (envStorage env) (envSysConf env) (envInterpTable env))
                      -< (pName, pType, pBin)

          ( eelem "/"
            += ( eelem "renderResult"
                 += sattr "name" pName
                 += constL pageBody
                 >>>
                 uniqueNamespacesFromDeclAndQNames
               ) ) -<< ()