module Tags 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 (restrictByTagQuery) import Resource import InLineCSS import Common tagsHandler :: RqHandlerT RESTng RESTngResp tagsHandler = under "Tag" $ withDocNameString $ \tagname -> okBoxesM [ return $ bigText $ smallMarginBottomCSS $ nearTop $ boxInMain $ t ("Resources tagged with " ++ tagname), highlyRatedBooksWithTagBox tagname >>= return . nearLeft . setColumnsVote 2 . commonLayoutHints, recentBooksWithTagBox tagname >>= return . nearRight . setColumnsVote 2 . commonLayoutHints ] where commonLayoutHints = smallMarginBottomCSS . giveBorderCSS . inMain -------------------------------------------------------- --- Most highly rated books with specific tag ------- -------------------------------------------------------- highlyRatedBooksWithTagBox :: String -> RESTng (GridElement RequestContext) highlyRatedBooksWithTagBox tagname = do booksAndRatings <- ratedResourcesData bookProxy (highlyRatedResourcesWithTagQuery bookProxy tagname) return $ withTitleBox "Most highly rated books:" $ toBox (ratedBooksView booksAndRatings) highlyRatedResourcesWithTagQuery :: RelationalResource a => Proxy a -> String -> SqlCommand highlyRatedResourcesWithTagQuery pr tagname = restrictByTagQuery pr tagname (highlyRatedResourcesQuery pr) ------------------------------------------- --- Most recent books with this tag ---- ------------------------------------------- recentBooksWithTagBox :: String -> RESTng (GridElement RequestContext) recentBooksWithTagBox tagname = do books <- recentBooksWithTagData tagname return $ withTitleBox "Recent books:" $ toBox (booksShow books) recentBooksWithTagData :: String -> RESTng [Book] recentBooksWithTagData tagname = liftHDBC_0 $ runQueryN sqlRecordParser (recentBooksWithTagQuery tagname) recentBooksWithTagQuery :: String -> SqlCommand recentBooksWithTagQuery tagname = setOrderDesc (tableName bookProxy ++ ".id") $ restrictByTagQuery bookProxy tagname $ sqlSelect [] [] bookProxy booksShow :: [Book] -> CxML RequestContext booksShow = concatCxML . intersperse (br +++ br ) . map showShortURLHtml