{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-} module Resource.Book where import Database.HDBC (toSql) import Text.ParserCombinators.Parsec (parse) import Data.Generics import Text.CxML hiding (title) import RESTng.System import Resource.Author(Author) data Book = Book { book_id :: Integer, title :: String, pages :: Integer, author_id :: Integer } deriving (Data, Typeable) bookProxy :: Proxy Book bookProxy = undefined instance Resource Book where resourceType _ = "Book" key = book_id setKey res k = res {book_id = k} userFields _ = ["title", "pages", "author_id"] instance RelationalResource Book where userFieldsToSql res = [toSql $ title res, toSql $ pages res, toSql $ author_id res] -- sqlUserFieldsParser :: SystemFields -> SqlValueParser a sqlUserFieldsParser (k, _) = do (title, pages, aid) <- sqlRecordParser return (Book k title pages aid) instance PersistableResource Book where persistableFunctions = persistableFromRelational instance WebResource Book where userFieldValues res = [showField $ title res, showField $ pages res, showField $ author_id res] userFieldValuesParser (k, _) = do ti <- parseNotEmpty "title" pa <- parseField "pages" aid <- parseField "author_id" return (Book k ti pa aid) showShortHtml (Book k title pages aid) = t title showHtml b@(Book k title pages aid) = (showShortURLHtml b)^^.mediumTextRls +++ p /- [t $ "(" ++ show pages ++ " pages)"] instance InGridResource Book where listView = listInBoxesView ------------------------- -- belongsTo Author ------------------------- instance RelationalOneToMany Author Book where -- requires FlexibleInstances & MultiParamTypeClasses --fkValue :: Proxy a -> Comment -> Integer fkValue _ = author_id fkName _ _ = "author_id" instance AssocOneToMany Author Book where -- requires FlexibleInstances & MultiParamTypeClasses oneToManyFunctions = oneToManyFromRelational mediumTextRls :: CssInlineDecl mediumTextRls = ("mediumText", [ --("clear","left"), ("font-size","1.5em"), ("font-weight","bolder"), --("margin","0pt 0pt 0pt 20px"), --("padding-left","8px"), ("top","5px") ] )