RESTng-0.1: Example/Search.hs

module Search where

import Prelude hiding (div,span)
import Data.List (intersperse)
import Control.Monad (liftM, 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 Resource
import InLineCSS
import Common (authorsShow, withTitleBox)
import Tags (booksShow)


searchForm :: CxML RequestContext
searchForm
           = form!("method","post")!("action","/search.html")
                /- [
                    textfield "search", 
                    button!("name","action")!("value","submit") /- [t "Search"]
                   ]

searchHandler :: RqHandlerT RESTng RESTngResp
searchHandler = --withDocName "search" $ withQueryField "search" $ \q ->
                withDocName "search" $ withPostField "search" $ \q ->
               okBoxesM [
                         return $ bigText $ smallMarginBottomCSS $ nearTop $ boxInMain $ t ("Found it in: "),

                         liftM (nearLeft . setColumnsVote 2 . commonLayoutHints) $ tagsMatchingBox q,
                         liftM (nearRight . setColumnsVote 2 . commonLayoutHints) $ booksMatchingBox q,
                         liftM (nearBottom . commonLayoutHints) $ authorsMatchingBox q
                        ]
             where
               commonLayoutHints = smallMarginBottomCSS . giveBorderCSS . inMain

-------------------------------
---------- Tags matching  -----
-------------------------------
tagsMatchingBox :: String -> RESTng (GridElement RequestContext)
tagsMatchingBox s = do tagListCxML <- listingResource exampleAppTagProxy [("tag",s)] []
                       return $ withTitleBox "Tags matching:" tagListCxML


-------------------------------
------ Books matching  -----
-------------------------------
booksMatchingBox :: String -> RESTng (GridElement RequestContext)
booksMatchingBox s = 
                         do books <- booksMatchingData s
                            return $ withTitleBox "Books matching:" $ toBox (booksShow books)


booksMatchingData :: String -> RESTng [Book]
booksMatchingData s = liftHDBC_0 $ runQueryN sqlRecordParser (booksMatchingQuery s)

booksMatchingQuery :: String -> SqlCommand
booksMatchingQuery s =    addCriterium (inBookExpr `or_` inAuthorExpr) $
                              sqlSelect [] [] bookProxy
                          where
                             inBookExpr = caseInsensitiveSearchExpr ["title"] s
                             inAuthorExpr = (tableName authorProxy ++ "_id") `in_` 
                                               (projectJustAttrs ["DISTINCT id"] $ authorsMatchingQuery s)

-------------------------------
------ Authors matching  -----
-------------------------------
authorsMatchingBox :: String -> RESTng (GridElement RequestContext)
authorsMatchingBox s =  do authors <- authorsMatchingData s
                           return $ withTitleBox "Authors:" $ toBox (authorsShow authors)

authorsMatchingData :: String -> RESTng [Author]
authorsMatchingData s = liftHDBC_0 $ runQueryN sqlRecordParser (authorsMatchingQuery s)
-- FIXME: in order to be more DRY, do some runQueryN' such that
-- authorsMatchingData s = runQueryN' (authorsMatchingQuery s)
-- so the function has type
-- runQueryN' :: SqlRecord a => SqlCommand -> RESTng [a]


authorsMatchingQuery :: String -> SqlCommand
authorsMatchingQuery s = addCriterium (caseInsensitiveSearchExpr ["name"] s) $
                            sqlSelect [] [] authorProxy

--FIXME: can search authors related to authorships containing s here also.