module FrontPage ( frontPage ) where import Prelude hiding (div,span) import Data.List (intersperse) import Control.Monad (liftM2) import Text.ParserCombinators.Parsec (parse) import Database.HDBC (SqlValue, toSql) import Text.CxML hiding (title) import Text.YuiGrid import RESTng.RqHandlers import RESTng.System import RESTng.Resources --(tagLink) import Resource import InLineCSS import Common frontPage :: RqHandlerT RESTng RESTngResp frontPage = withDocName "index" $ okBoxesM [ return $ bigText $ smallMarginBottomCSS $ nearTop $ boxInMain $ t "This site is for ...", populatedTagsBox >>= return . nearRight . setColumnsVote 2 . commonLayoutHints, highlyRatedBooksBox >>= return . nearLeft . setColumnsVote 2 . commonLayoutHints ] where commonLayoutHints = smallMarginBottomCSS . giveBorderCSS . inMain ------------------------------------------- ---------- Most populated tags ------------ ------------------------------------------- populatedTagsBox :: RESTng (GridElement RequestContext) populatedTagsBox = do tagsData <- populatedTagsData return $ withTitleBox "Most populated tags:" (toBox $ listTagsData tagsData) where listTagsData :: [(Integer, String)] -> CxML RequestContext listTagsData dat = div /- map buildLink dat buildLink (qty, tagname) = tagLink' tagname (Just qty) +++ br populatedTagsData :: RESTng [(Integer, String)] populatedTagsData = liftHDBC_0 $ runQueryN sqlRecordParser populatedTagsQuery populatedTagsQuery :: SqlCommand populatedTagsQuery = setOrderDesc "1" $ projectAttrs ["tag"] $ countRows $ (sqlSelect [] [] exampleAppTagProxy) {groupBy = ["tag"]} ------------------------------------------- ------ Most highly rated books --------- ------------------------------------------- highlyRatedBooksBox :: RESTng (GridElement RequestContext) highlyRatedBooksBox = do booksAndRatings <- ratedResourcesData bookProxy $ highlyRatedResourcesQuery bookProxy return $ withTitleBox "Most highly rated books:" $ toBox (ratedBooksView booksAndRatings)