RESTng-0.1: Example/Common.hs

module Common where

import Prelude hiding (div,span)

import Data.List (intersperse)
import Control.Monad (liftM2)
import Database.HDBC (toSql)

import Text.CxML hiding (title)
import Text.YuiGrid
import Network.HTTP.RedHandler (RequestContext)

import RESTng.Resources (projectAndOrderByRatingQuery)
import RESTng.System

import Resource
import InLineCSS


-------------------------------------------
------ Most highly rated books ---------
-------------------------------------------

ratedBooksView :: [(Book,Double)] -> CxML RequestContext
ratedBooksView = concatCxML . intersperse br . map showBookAndRating
                    where
                      showBookAndRating (art,rating) = div /- [
                                                                  span /- [ t "Book:"],
                                                                  span /- [ showShortURLHtml art ]
                                                                 ] +++
                                                          div /- [
                                                                  span /- [ t "Rating:"],
                                                                  span /- [ t $ show rating ]  
                                                                 ]

-------------------------------
------ rated resources --------
-------------------------------

ratedResourcesData :: RelationalResource a => Proxy a -> SqlCommand -> RESTng [(a, Double)]
ratedResourcesData pr query = liftHDBC_0 $ runQueryN sqlRecordParser query

highlyRatedResourcesQuery :: RelationalResource a => Proxy a -> SqlCommand
highlyRatedResourcesQuery pr = projectAndOrderByRatingQuery pr $ sqlSelect [] [] pr


------------------------------
-------- showing authors ----
------------------------------
authorsShow :: [Author] -> CxML RequestContext
authorsShow = concatCxML . intersperse br . map showShortURLHtml

-------------------------------------------
------ Helper functions -------------------
-------------------------------------------

withTitleBox :: String -> GridElement a -> GridElement a
withTitleBox tit b = toContainer [nearTop $ mediumText $ smallMarginBottomCSS $ toBox (t tit), b]