Fixed haddock script

This commit is contained in:
Michael Snoyman 2010-05-04 13:15:03 +03:00
parent 086b73ac59
commit f1fc97eda0
2 changed files with 6 additions and 16 deletions

View File

@ -63,11 +63,8 @@ class YesodSite a => Yesod a where
errorHandler _ = defaultErrorHandler errorHandler _ = defaultErrorHandler
-- | Applies some form of layout to the contents of a page. -- | Applies some form of layout to the contents of a page.
defaultLayout :: a defaultLayout :: PageContent (Routes a) -> GHandler sub a Content
-> PageContent (Routes a) defaultLayout p = hamletToContent $ [$hamlet|
-> Request
-> Hamlet (Routes a) IO ()
defaultLayout _ p _ = [$hamlet|
!!! !!!
%html %html
%head %head
@ -86,16 +83,12 @@ applyLayout :: Yesod master
=> String -- ^ title => String -- ^ title
-> Hamlet (Routes master) IO () -- ^ body -> Hamlet (Routes master) IO () -- ^ body
-> GHandler sub master RepHtml -> GHandler sub master RepHtml
applyLayout t b = do applyLayout t b =
let pc = PageContent RepHtml `fmap` defaultLayout PageContent
{ pageTitle = cs t { pageTitle = cs t
, pageHead = return () , pageHead = return ()
, pageBody = b , pageBody = b
} }
y <- getYesodMaster
rr <- getRequest
content <- hamletToContent $ defaultLayout y pc rr
return $ RepHtml content
-- | Provide both an HTML and JSON representation for a piece of data, using -- | Provide both an HTML and JSON representation for a piece of data, using
-- the default layout for the HTML output ('defaultLayout'). -- the default layout for the HTML output ('defaultLayout').
@ -106,14 +99,11 @@ applyLayoutJson :: Yesod master
-> (x -> Json (Routes master) ()) -> (x -> Json (Routes master) ())
-> GHandler sub master RepHtmlJson -> GHandler sub master RepHtmlJson
applyLayoutJson t x toH toJ = do applyLayoutJson t x toH toJ = do
let pc = PageContent html <- defaultLayout PageContent
{ pageTitle = cs t { pageTitle = cs t
, pageHead = return () , pageHead = return ()
, pageBody = toH x , pageBody = toH x
} }
y <- getYesodMaster
rr <- getRequest
html <- hamletToContent $ defaultLayout y pc rr
json <- jsonToContent $ toJ x json <- jsonToContent $ toJ x
return $ RepHtmlJson html json return $ RepHtmlJson html json

View File

@ -1,2 +1,2 @@
cabal haddock --hyperlink-source --html-location='http://hackage.haskell.org/packages/archive//latest/doc/html' cabal haddock --hyperlink-source --html-location='http://hackage.haskell.org/packages/archive//latest/doc/html'
scp -r dist/doc/html/ snoyberg_yesoddocs@ssh.phx.nearlyfreespeech.net:/home/public/haddock scp -r dist/doc/html/yesod snoyberg_yesoddocs@ssh.phx.nearlyfreespeech.net:/home/public/haddock/