Book.hs

{-# 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")
                           ] )