{-# LANGUAGE FlexibleContexts, OverloadedStrings #-} {-# OPTIONS_GHC -F -pgmFhsx2hs #-} module Clckwrks.IrcBot.Page.Template where import Clckwrks import Clckwrks.Plugin import Control.Monad.State (get) import Clckwrks.IrcBot.Monad import Control.Monad.Reader import Data.Text (Text) import HSP.XML import HSP.XMLGenerator import Happstack.Server.HSP.HTML () import Web.Plugins.Core (Plugin(..), getPluginRouteFn, getTheme) template :: ( EmbedAsChild IrcBotM headers , EmbedAsChild IrcBotM body ) => Text -> headers -> body -> IrcBotM Response template ttl hdrs bdy = do p <- plugins <$> get mTheme <- getTheme p (Just clckShowFn) <- getPluginRouteFn p (pluginName clckPlugin) case mTheme of Nothing -> escape $ internalServerError $ toResponse $ ("No theme package is loaded." :: Text) (Just theme) -> do hdrXml <- fmap (map unClckChild) $ unXMLGenT $ asChild hdrs -- <%> <% hdrs %> bdyXml <- fmap (map unClckChild) $ unXMLGenT $ asChild bdy fmap toResponse $ mapClckT f $ ClckT $ withRouteT (\f -> clckShowFn) $ unClckT $ unXMLGenT $ (_themeTemplate theme ttl hdrXml bdyXml) where f :: ServerPartT IO (a, ClckState) -> ReaderT IrcBotConfig (ServerPartT IO) (a, ClckState) f m = ReaderT $ \_ -> m {- template :: ( EmbedAsChild IrcBotM headers , EmbedAsChild IrcBotM body ) => String -> headers -> body -> IrcBotM Response template ttl hdrs bdy = do pageTemplate <- ircBotPageTemplate <$> ask fmap toResponse $ unXMLGenT $ pageTemplate ttl <%> <% hdrs %> bdy -} {- template :: ( EmbedAsChild (Clck ClckURL) headers , EmbedAsChild (Clck ClckURL) body ) => String -> headers -> body -> IrcBotM Response template ttl hdrs bdy = do pageTemplate <- ircBotPageTemplate <$> ask fmap toResponse $ mapClckT lift $ unXMLGenT $ pageTemplate ttl hdrs bdy -}