module Rakka.Resource.SystemConfig
    ( resSystemConfig
    )
    where

import           Control.Arrow
import           Control.Arrow.ArrowIO
import           Control.Monad.Trans
import           Network.HTTP.Lucu
import           Rakka.Environment
import           Rakka.SystemConfig
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


resSystemConfig :: Environment -> ResourceDef
resSystemConfig env
    = ResourceDef {
        resUsesNativeThread = False
      , resIsGreedy         = False
      , resGet              = Just $ handleGet env
      , resHead             = Nothing
      , resPost             = Nothing
      , resPut              = Just $ handlePut env
      , resDelete           = Nothing
      }


{-
  <systemConfig>
    <value path="siteName">Rakka</value>
    <value path="defaultPage">MainPage</value>
  </systemConfig>
-}
handleGet :: Environment -> Resource ()
handleGet env
    = do setContentType $ read "text/xml"
         [xmlStr] <- liftIO $ runX ( setErrorMsgHandler False fail
                                     >>>
                                     mkSystemConfigTree env
                                     >>>
                                     writeDocumentToString [ (a_indent, v_1) ]
                                   )
         output xmlStr


mkSystemConfigTree :: (ArrowXml a, ArrowIO a) => Environment -> a b XmlTree
mkSystemConfigTree env
    = let sc = envSysConf env
      in 
        proc _
          -> do siteName    @ (SiteName    _) <- getSysConfA sc -< ()
                baseURI     @ (BaseURI     _) <- getSysConfA sc -< ()
                defaultPage @ (DefaultPage _) <- getSysConfA sc -< ()
                styleSheet  @ (StyleSheet  _) <- getSysConfA sc -< ()
                languages   @ (Languages   _) <- getSysConfA sc -< ()
                globalLock  @ (GlobalLock  _) <- getSysConfA sc -< ()

                ( eelem "/"
                  += ( eelem "systemConfig"
                       += ( eelem "value"
                            += sattr "path" (confPath siteName)
                            += txt (serialize siteName)
                          )
                       += ( eelem "value"
                            += sattr "path" (confPath baseURI)
                            += txt (serialize baseURI)
                          )
                       += ( eelem "value"
                            += sattr "path" (confPath defaultPage)
                            += txt (serialize defaultPage)
                          )
                       += ( eelem "value"
                            += sattr "path" (confPath styleSheet)
                            += txt (serialize styleSheet)
                          )
                       += ( eelem "value"
                            += sattr "path" (confPath languages)
                            += txt (serialize languages)
                          )
                       += ( eelem "value"
                            += sattr "path" (confPath globalLock)
                            += txt (serialize globalLock)
                          )
                     ) ) -<< ()


handlePut :: Environment -> Resource ()
handlePut _
    = fail "NOT IMPL"