RESTng-0.1: Example/Tags.hs

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