{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeFamilies, UndecidableInstances #-} {-# OPTIONS_GHC -F -pgmFtrhsx #-} module Pages.AppTemplate where import Control.Applicative import Control.Monad.Trans import HSP (XMLGenT(..), EmbedAsChild(..), EmbedAsAttr(..), Attr(..), XML, genElement, genEElement, unXMLGenT) import HSP.Google.Analytics (analytics) import Happstack.State import Happstack.Server import Happstack.Server.HSP.HTML () import Happstack.Server.HSX () import HSP (XMLGenerator) import qualified HSX.XMLGenerator as HSX import SiteURL import Web.Routes import Web.Routes.XMLGenT import Web.Routes.Happstack appTemplate' :: ( Happstack m , XMLGenerator m , EmbedAsChild m headers , EmbedAsChild m body , EmbedAsAttr m (Attr String String) ) => String -- ^ title -> headers -- ^ extra tags to include in \ -> body -- ^ contents to put inside \ -> XMLGenT m (HSX.XML m) appTemplate' title headers body = do <% headers %> <% title %> <% body %> appTemplate :: ( Happstack m , ToMessage (HSX.XML m) , XMLGenerator m , EmbedAsChild m headers , EmbedAsChild m body , EmbedAsAttr m (Attr String String) ) => String -- ^ title -> headers -- ^ extra tags to include in \ -> body -- ^ contents to put inside \ -> m Response appTemplate title headers body = toResponse <$> (unXMLGenT (appTemplate' title headers body)) -- | move to happstack? queryJust :: (MonadIO m, WebMonad Response m, FilterMonad Response m, Show ev, QueryEvent ev (Maybe res)) => ev -> m res queryJust ev = do mr <- query ev case mr of Nothing -> escape $ internalServerError $ toResponse ("query returned Nothing: " ++ show ev) (Just r) -> return r