module Rakka.Wiki.Engine
    ( formatPage
    )
    where

import           Control.Arrow
import           Control.Arrow.ArrowIO
import           Control.Arrow.ArrowTree
import           Data.Encoding
import           Data.Encoding.UTF8
import           Network.HTTP.Lucu
import           Rakka.Environment
import           Rakka.Page
import           Rakka.SystemConfig
import           Rakka.Wiki.Parser
import           Rakka.Wiki.Formatter
import           Text.ParserCombinators.Parsec
import           Text.XML.HXT.Arrow.XmlArrow
import           Text.XML.HXT.DOM.TypeDefs


formatPage :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
              Environment
           -> a Page XmlTree
formatPage env
    = proc page
    -> do tree <- case pageType page of
                    MIMEType "text" "x-rakka" _
                        -> formatWikiPage env -< page
          attachXHtmlNs -< tree


formatWikiPage :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
                  Environment
               -> a Page XmlTree
formatWikiPage env
    = proc page
    -> do let source = decodeLazy UTF8 (pageContent page)
          case parse wikiPage "" source of
            Left  err
                -> formatParseError -< err

            Right elems
                -> do BaseURI baseURI <- getSysConfA (envSysConf env) (BaseURI undefined) -< ()
                      formatWikiElements -< (baseURI, elems)


formatParseError :: ArrowXml a => a ParseError XmlTree
formatParseError 
    = proc err -> (eelem "pre" += txt (show err)) -<< ()


attachXHtmlNs :: ArrowXml a => a XmlTree XmlTree
attachXHtmlNs = processBottomUp (changeQName attach')
    where
      attach' :: QName -> QName
      attach' qn = qn {
                     namePrefix   = "xhtml"
                   , namespaceUri = "http://www.w3.org/1999/xhtml"
                   }