module Rakka.Resource.Render
    ( resRender
    )
    where

import           Control.Arrow
import           Control.Arrow.ArrowIO
import           Control.Arrow.ArrowList
import           Control.Monad.Trans
import qualified Data.ByteString.Lazy as Lazy
import           Data.Maybe
import           Network.HTTP.Lucu
import           Network.HTTP.Lucu.Utils
import           OpenSSL.EVP.Base64
import           Rakka.Environment
import           Rakka.Page
import           Rakka.Utils
import           Rakka.Wiki.Engine
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 entity <- inputLBS defaultLimit
         cTypeM <- getContentType

         let (bin, cType) = case cTypeM of
                              Just (MIMEType "application" "x-rakka-base64-stream" _)
                                  -> let b = decodeBase64LBS entity
                                     in
                                       (b, guessMIMEType b)
                              Just t
                                  -> (entity, t)
                              Nothing
                                  -> (entity, guessMIMEType entity)

         setContentType $ read "text/xml"
         [xmlStr] <- liftIO $ runX ( setErrorMsgHandler False fail
                                     >>>
                                     constA (name, cType, bin)
                                     >>>
                                     render env
                                     >>>
                                     writeDocumentToString [ (a_indent, v_1) ]
                                   )
         output xmlStr


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
               ) ) -<< ()