#{mr CrudMsgLinkCreate}
|]
@@ -312,6 +313,16 @@
widgetEnc <- liftHandlerT $ generateFormPost form
crudFormWidget CrudCreateR widgetEnc
+ -- | View entity details
+ crudViewWidget
+ :: Ent sub -> CrudM sub (CrudWidget sub)
+
+ crudViewWidget ent = do
+ objW <- crudShowHtml $ snd ent
+ return
+ [whamlet|^{objW}
+ |]
+
-- |Creates a widget to confirm deletion of an object. Override this if you
-- want to have a more sophisticated confirmation warning (such as showing
-- what other entities would be affected) or to change the delete button.
@@ -352,28 +363,30 @@
-- |Handler for @GET@ on the list route @CrudListR@, to display a list of all
-- objects. Primarily uses 'crudListWidget' and 'crudLayout', but also sets a
-- title based on 'CrudMsgEntities'.
- getCrudListR :: CrudHandler sub Html
+ getCrudListR :: CrudHandler sub TypedContent
getCrudListR = runCrudSubsite $ do
mr <- getMessenger
lw <- crudListWidget
- crudLayout $ do
+ res <- crudLayout $ do
setTitle . toHtml $ mr CrudMsgEntities
lw
+ return $ toTypedContent res
-- |Handler for @GET@ on the creation form @CrudCreateR@, to display an empty
-- form. Primarily uses 'crudMakeForm' and 'crudFormLayout'.
- getCrudCreateR :: CrudHandler sub Html
+ getCrudCreateR :: CrudHandler sub TypedContent
getCrudCreateR = runCrudSubsite $ do
form <- crudMakeForm Nothing
widgetEnc <- liftHandlerT $ generateFormPost form
- crudFormLayout CrudCreateR widgetEnc
+ res <- crudFormLayout CrudCreateR widgetEnc
+ return $ toTypedContent res
-- |Handler for @POST@ on @CrudCreateR@, to create a new object. On success,
-- it inserts the object and displays an alert on the next page. If the form
-- validation fails, it displays the form again with errors. (If the database
-- insertion itself fails, it still moves on to the next page and displays
-- the exception as an alert.)
- postCrudCreateR :: CrudHandler sub Html
+ postCrudCreateR :: CrudHandler sub TypedContent
postCrudCreateR = runCrudSubsite $ do
form <- crudMakeForm Nothing
((result, w), enc) <- liftHandlerT $ runFormPost form
@@ -387,28 +400,46 @@
crudAlert CrudCreateR (Right obj)
crudNextPage (Just objId) >>= redirect
_ -> pure ()
- crudFormLayout CrudCreateR (w, enc)
+ res <- crudFormLayout CrudCreateR (w, enc)
+ return $ toTypedContent res
+ -- |Handler for @GET@ on @CrudViewR@, an object's details request. It displays the
+ -- object and employs an empty Yesod form for return.
+ getCrudViewR :: ObjId sub -> CrudHandler sub TypedContent
+ getCrudViewR objId = runCrudSubsite $ do
+ mr <- getMessenger
+ obj <- crudGet objId >>= maybe404
+ objW <- crudViewWidget (objId, obj)
+ r2p <- getRouter
+ res <- crudLayout $ do
+ setTitle . toHtml . mr . CrudMsgTitleView $ mr CrudMsgEntity
+ [whamlet|
+ ^{objW}
+
#{mr CrudMsgViewLinkNext}
+ |]
+ return $ toTypedContent res
+
-- |Handler for @GET@ on @CrudDeleteR@, a deletion request. It displays the
-- object and employs an empty Yesod form for its CSRF token.
- getCrudDeleteR :: ObjId sub -> CrudHandler sub Html
+ getCrudDeleteR :: ObjId sub -> CrudHandler sub TypedContent
getCrudDeleteR objId = runCrudSubsite $ do
mr <- getMessenger
r2p <- getRouter
obj <- crudGet objId >>= maybe404
(tokenW, enc) <- generateFormPost . renderDivs $ pure ()
confirmW <- crudDeleteWidget (objId, obj)
- crudLayout $ do
+ res <- crudLayout $ do
setTitle . toHtml . mr . CrudMsgTitleDelete $ mr CrudMsgEntity
[whamlet|