Having trouble compiling yesod route after introducing a parameter - haskell

I am running a modified example of
http://www.yesodweb.com/book/blog-example-advanced
that previously did not use a parameter id of type DBEntitySchemaId.
Since introducing it, I am getting
Handler/Entity.hs:146:34:
Couldn't match type ‘DBEntitySchemaId -> Route App’
with ‘Route (HandlerSite (WidgetT App IO))’
Expected type: WidgetT
App IO ((DBEntitySchemaId -> Route App) -> [(Text, Text)] -> Text)
Actual type: WidgetT
App
IO
(Route (HandlerSite (WidgetT App IO)) -> [(Text, Text)] -> Text)
In the first argument of ‘(>>=)’, namely ‘getUrlRenderParams’
In a stmt of a 'do' block:
(getUrlRenderParams
>>=
(\ urender_akdM
-> (asWidgetT GHC.Base.. toWidget)
(toHtml (\ u_akdN -> urender_akdM u_akdN [] EntityR))))
which refers to the line using the defaultLayout.
The relevant code is:
getEntityR :: DBEntitySchemaId -> Handler Html
getEntityR id = do
oldEntities <- runDB $ selectList [DBEntityDbentitySchemaId ==. id] []
fields <- runDB $ selectList [DBFieldDbentitySchemaId ==. id, DBFieldFieldTypeId ==. (toSqlKey 1)] []
mauthId <- maybeAuthId
((res, widget), enctype) <- runFormPost (form fields)
case (mauthId,res) of
(Just userId, FormSuccess (attributeValues)) -> do
setMessageI $ MsgSubmittedKarma
let entity = DBEntity "Test" id
entId <- runDB $ insert entity
let fieldsNVals = zip fields attributeValues
let einfuegen field attributeValue = case (field, attributeValue) of
((Entity fldId _), (FormSuccess val)) -> do
a <- runDB $ insert (Attribute {attributeEntityId = entId, attributeDbfieldId = fldId, attributeStringValue = val})
return (Just a)
_ -> return Nothing
_ <- forM fieldsNVals (\(field, attributeValue) -> einfuegen field attributeValue)
redirect $ (EntityR id)
_ -> do
--render <- getUrlRenderParams
--return $ renderHtml $ [hamlet|
defaultLayout [whamlet|
$if null oldEntities
<p>There are no entities
$else
<ul>
$forall Entity entityId entity <- oldEntities
<li>
<p>#{dBEntityName entity}
$if mauthId == Nothing
<form method=post action=#{EntityR} enctype=#{enctype}>
<input type=submit value=_{MsgPleaseLogin}>
$else
<form method=post action=#{EntityR} enctype=#{enctype}>
^{widget}
<input type=submit>
|]
What I already tried was changing whamlet to hamlet and
adding some lines of code from here (commented out)
Trying to send an email in yesod using hamlet
and
changing
[whamlet|
to
[whamlet|#{getEntityR}/#{id}|
and
[whamlet||#?{urlParams id}|
and some variations of this inspired by
Render url with query parameters
https://groups.google.com/forum/#!topic/yesodweb/q1gtkOgM32I
I assume there is only a small modification to make. However my understanding of whamlet/hamlet is not too great. So I am posting this in case it is a trivial problem. I fully understand that I need to put in more work, I am just having trouble googling my problem. So please bear with me.

After modifying your route you forgot to pass newly added parameter into #{EntityR} interpolation, something like this: #{EntityR param}.

Related

How can I create a Yesod form where I can select from a dropdown list where the list is passed as an argument?

I would like to create a form in which I pass a [a] an an argument and get back an MForm Handler (FormResult a, Widget).
I have attempted to implement this using functions such as selectFieldList but have not been able to find a solution. I have not been able to find an answer anywhere on google. I have found many examples where dropdown lists have been used as individual fields in a larger form but none where the dropdown list is the entire form itself.
Edit:
I have managed to make a form that compiles. Unfortunately I am unable to tell if it works the way I would like because I cannot get it to render.
Here are the key functions I am working with (they all compile):
mkCityStringM :: [PG.DbCity] -> [(T.Text, PG.DbCity)]
mkCityStringM xs = zip (map (T.pack . showDbCity) xs) xs
data ContainCity =
ContainCity
{ getCity :: PG.DbCity
}
deriving (Show)
ambiguityForm :: [PG.DbCity] -> AForm Handler ContainCity
ambiguityForm cities = ContainCity
<$> areq (selectFieldList cityMap) "City" Nothing
where
cityMap :: [(T.Text, PG.DbCity)]
cityMap = W.mkCityStringM cities
The problem is when I try to actually use this table I run into issues. Here is code that works just fine for me:
locationForm :: Html -> MForm Handler (FormResult BasicLocation, Widget)
locationForm = renderDivs $ BasicLocation
<$> areq textField "City:" Nothing
<*> areq textField "Country:" (Just "United States")
postAmbiguityR :: [PG.DbCity] -> Handler Html
postAmbiguityR cs = do
(widget, enctype) <- generateFormPost locationForm
defaultLayout $ do
[whamlet|
<p>who cares
|]
On the other hand I have this code:
postAmbiguityR :: [PG.DbCity] -> Handler Html
postAmbiguityR cs = do
(widget, enctype) <- generateFormPost (ambiguityForm cs) --only difference
defaultLayout $ do
[whamlet|
<p> WHATEVER
|]
which throws me this error:
• Couldn't match expected type ‘blaze-markup-0.8.2.5:Text.Blaze.Internal.Markup
-> MForm (HandlerFor Base) (FormResult a0, xml0)’
with actual type ‘AForm Handler ContainCity’
• Possible cause: ‘ambiguityForm’ is applied to too many arguments
In the first argument of ‘generateFormPost’, namely
‘(ambiguityForm cs)’
In a stmt of a 'do' block:
(widget, enctype) <- generateFormPost (ambiguityForm cs)
In the expression:
do (widget, enctype) <- generateFormPost (ambiguityForm cs)
defaultLayout
$ do (do (asWidgetT . toWidget)
((blaze-markup-0.8.2.5:Text.Blaze.Internal.preEscapedText . T.pack)
"<html><header></header>
<form method="post" action="")
....)
|
132 | (widget, enctype) <- generateFormPost (ambiguityForm cs)
| ^^^^^^^^^^^^^^^^
This error message does not make sense to me. It says a possible cause is that ambiguity form is applied to too many arguments but does not seem to be the case as the form takes a list of PG.DbCity's and that is exactly what I supplied it.
The problem is that ambiguityForm is an AForm, but generateFormPost expects an MForm. To convert it to an MForm suitable for rendering, you need to use renderDivs, like you did in your locationForm example. You can either do this in the definition of ambiguityForm, which will change its type/defintion to look something like:
ambiguityForm :: [PG.DbCity] -> Html -> MForm Handler (FormResult ContainCity, Widget)
ambiguityForm cities = renderDivs $ ContainCity ...
or you can leave ambiguityForm unchanged and add renderDivs at the usage site:
postAmbiguityR :: [PG.DbCity] -> Handler Html
postAmbiguityR cs = do
(widget, enctype) <- generateFormPost (renderDivs (ambiguityForm cs))
defaultLayout $ do
[whamlet|
<p> WHATEVER
|]

Persisting an uploaded file in the database (Couldn't match type ‘ConduitM () ByteString (ResourceT IO) ()’ with ‘HandlerT App IO ByteString’)

Using yesod I am trying to persist an uploaded file in the database.
To do this, I want to extract the bytestring and persist it, but I still need the code to typecheck.
The actual problem is
Couldn't match type ‘ConduitM () ByteString (ResourceT IO) ()’
with ‘HandlerT App IO ByteString’
Expected type: HandlerT App IO ByteString
Actual type: Source (ResourceT IO) ByteString
In a stmt of a 'do' block: file <- (fileSourceRaw fileinfo)
In the expression:
do { setMessageI $ MsgUploadedImg;
uuidWrapped <- liftIO (U4.nextRandom);
let uuid = fromString $ U.toString $ uuidWrapped;
transactionId <- runDB $ insert $ Transaction userId;
.... }
The relevant part is this function (see: file <- (fileSourceRaw fileinfo)).
getImgR :: Handler Html
getImgR = do
oldImages <- runDB $ selectList [] []
mauthId <- maybeAuthId
((res, widget), enctype) <- runFormPost $ form Nothing Nothing ""
case (mauthId,res) of
(Just userId, FormSuccess (title,fileinfo)) -> do
transactionId <- runDB $ insert $ Transaction userId
file <- (fileSourceRaw fileinfo)
let newImg = Img {imgFile = Just file, imgTitle = title , imgDesc = Nothing, imgFiletype = Nothing, imgTransactionId = Just transactionId, imgUserId = Just userId}
_ <- runDB $ insert newImg
redirect $ ImgR
_ -> defaultLayout
[whamlet|
$if null oldImages
<p>There are no images
$else
<ul>
$forall Entity imgId img <- oldImages
<li>
<p>#{imgTitle img}
$if mauthId == Nothing
<form method=post action=#{ImgR} enctype=#{enctype}>
<input type=submit value=_{MsgPleaseLogin}>
$else
<form method=post action=#{ImgR} enctype=#{enctype}>
^{widget}
<input type=submit>
|]
Helper code:
type MyForm = Html -> MForm Handler (FormResult (Text, FileInfo), Widget)
form :: Maybe UserId -> Maybe TransactionId -> Text -> MyForm
form userId transactionId uuid = renderBootstrap $ (,)
<$> areq textField "Title" Nothing
<*> fileAFormReq "Image file"
Img
title Text
filetype Text Maybe
desc Textarea Maybe
file ByteString Maybe
transactionId TransactionId Maybe
userId UserId Maybe
deriving Show
Still going over the documentation, but I thought the use case was common enough to ask a question. The datatype of FileInfo is:
data FileInfo = FileInfo
{ fileName :: !Text
, fileContentType :: !Text
, fileSourceRaw :: !(Source (ResourceT IO) ByteString)
, fileMove :: !(FilePath -> IO ())
}
Thank you for your attention.
Edit: I assume the solution is contained in the documentation here
http://www.yesodweb.com/blog/2013/03/simpler-streaming-responses?
Update:
It looks like one of those links
How can I post FileInfo to a web service using Yesod and Http-Conduit?
https://www.schoolofhaskell.com/school/to-infinity-and-beyond/competition-winners/part-5
Yesod handlers, content of POSTed files
contain the solution.
Update2:
Using (Data.Conduit.Binary is DCB)
file <- runResourceT $ fileSource fileinfo $$ DCB.sinkLbs
leaves me with
Handler/Img.hs:62:42:
Couldn't match expected type ‘ByteString’
with actual type ‘Data.ByteString.Lazy.Internal.ByteString’
NB: ‘ByteString’ is defined in ‘Data.ByteString.Internal’
‘Data.ByteString.Lazy.Internal.ByteString’
is defined in ‘Data.ByteString.Lazy.Internal’
In the first argument of ‘Just’, namely ‘file’
In the ‘imgFile’ field of a record
Looks like the missing function is here:
Many types of String (ByteString)
The final code is
module Handler.Img where
import Import
import LambdaCms.Core -- for UserId
import Database.Persist.Sql (toSqlKey)
-- for uuids
import qualified Data.UUID as U
import qualified Data.UUID.V4 as U4
import Yesod.Core.Types
import qualified Data.Conduit.List as CL
import qualified Data.Conduit.Binary as DCB
import Data.ByteString as BS
import Data.ByteString.Lazy as LBS
type MyForm = Html -> MForm Handler (FormResult (Text, FileInfo), Widget)
form :: Maybe UserId -> Maybe TransactionId -> Text -> MyForm
form userId transactionId uuid = renderBootstrap $ (,)
<$> areq textField "Title" Nothing
<*> fileAFormReq "Image file"
lazyToStrictBS :: LBS.ByteString -> BS.ByteString
lazyToStrictBS x = BS.concat $ LBS.toChunks x
getImgR :: Handler Html
getImgR = do
oldImages <- runDB $ selectList [] []
mauthId <- maybeAuthId
((res, widget), enctype) <- runFormPost $ form Nothing Nothing ""
case (mauthId,res) of
(Just userId, FormSuccess (title,fileinfo)) -> do
setMessageI $ MsgUploadedImg
transactionId <- runDB $ insert $ Transaction userId
file <- runResourceT $ fileSource fileinfo $$ DCB.sinkLbs
let newImg = Img {imgFile = Just (lazyToStrictBS file), imgTitle = title , imgDesc = Nothing, imgFiletype = Nothing, imgTransactionId = Just transactionId, imgUserId = Just userId}
_ <- runDB $ insert newImg
redirect $ ImgR
_ -> defaultLayout
[whamlet|
$if Import.null oldImages
<p>There are no images
$else
<ul>
$forall Entity imgId img <- oldImages
<li>
<p>#{imgTitle img}
$if mauthId == Nothing
<form method=post action=#{ImgR} enctype=#{enctype}>
<input type=submit value=_{MsgPleaseLogin}>
$else
<form method=post action=#{ImgR} enctype=#{enctype}>
^{widget}
<input type=submit>
|]
postImgR :: Handler Html
postImgR = getImgR

generateForm post type error in Yesod form

I get the type error
Estuary0b.hs:112:53:
Couldn't match type `HandlerT Site IO' with `WidgetT Site IO'
Expected type: Text.Blaze.Internal.Markup
-> MForm (WidgetT Site IO) (FormResult Course, WidgetT Site IO ())
Actual type: Text.Blaze.Internal.Markup
-> Control.Monad.Trans.RWS.Lazy.RWST
(Maybe (Env, FileEnv), HandlerSite (HandlerT Site IO), [Lang])
Enctype
Ints
(HandlerT Site IO)
(FormResult Course, WidgetT (HandlerSite (HandlerT Site IO)) IO ())
In the first argument of `generateFormPost', namely
`add_course_form'
In a stmt of a 'do' block:
(form_widget, form_enctype) <- generateFormPost add_course_form
In the second argument of `($)', namely
`do { setTitle "Estuary - Courses";
(form_widget, form_enctype) <- generateFormPost add_course_form;
do { (Yesod.Core.Widget.asWidgetT . toWidget)
((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
"<h1>Courses</h1>\
\<table><tr><th>Name</th>\
\<th>Accreditation</th>\
\<th>Specification</th>\
\<th>Scheme of work</th>\
\<th>Past papers</th>\
\</tr>");
Data.Foldable.mapM_
(\ (Course cname_a5mw aname_a5mx __a5my __a5mz __a5mA) -> ...
)
courses;
.... } }'
When I try to compile the following:
data Course = Course {
_course_name :: !Text,
_accreditor :: !Text,
_spec :: !ByteString,
_sow :: !ByteString,
_past_exams :: ![ByteString]
}
deriving (Eq, Ord, Data, Typeable)
deriveSafeCopy 0 'base ''Course
mkYesod "Site" [parseRoutes|
/ Home GET
/courses Courses GET POST
|]
getHome :: Handler Html
getHome = do
defaultLayout [whamlet|<h1>Estuary|]
getCourses :: Handler Html
getCourses = do
site <- getYesod
courses <- fmap IxSet.toList $ query' (_db site) All_courses
defaultLayout $ do
setTitle "Estuary - Courses"
(form_widget, form_enctype) <- generateFormPost add_course_form
[whamlet|
<h1>Courses
<table>
<tr>
<th>Name
<th>Accreditation
<th>Specification
<th>Scheme of work
<th>Past papers
$forall (Course cname aname _ _ _) <- courses
<tr>
<td>#{cname}
<td>#{aname}
<td>Download
<td>Download
<h2>Add a new course
<form method=post action=#{Courses} enctype=#{form_enctype}>
^{form_widget}
<input type=submit value=Add_course>|]
add_course_form = renderDivs $ Course
<$> areq textField "Course name" Nothing
<*> areq textField "Accredditation" Nothing
<*> pure Bytes.empty
<*> pure Bytes.empty
<*> pure []
postCourses :: Handler Html
postCourses = do
((result, _), _) <- runFormPost add_course_form
case result of
FormSuccess course -> do
site <- getYesod
update' (_db site) (Add_course course)
_ -> return ()
redirect Courses
Can anyone help?
generateFormPost is intended to be run in the Handler monad, not the Widget monad. You can either:
Move the generate call outside of the defaultLayout block.
Add a handlerToWidget call in front of generateFormPost.

yesod how to solve this error?

I am just started with Yesod, I am following this tutorial:http://yannesposito.com/Scratch/en/blog/Yesod-tutorial-for-newbies/
I get this error:
Handler/Blog.hs:32:17:
Couldn't match type `handler' with `GHandler App App'
`handler' is a rigid type variable bound by
the type signature for postBlogR :: handler RepHtml
at Handler/Blog.hs:29:14
Expected type: handler [Entity Article]
Actual type: GHandler App App [Entity Article]
In a stmt of a 'do' block:
articles <- runDB $ selectList [] [Desc ArticleTitle]
In the expression:
do { articles <- runDB $ selectList [] [Desc ArticleTitle];
(articleWidget, enctype) <- generateFormPost entryForm;
defaultLayout $ do { $(widgetFile "articles") } }
In an equation for `postBlogR':
postBlogR
= do { articles <- runDB $ selectList [] [Desc ArticleTitle];
(articleWidget, enctype) <- generateFormPost entryForm;
defaultLayout $ do { ... } }
this is my Blog.hs:
module Handler.Blog
( getBlogR
, postBlogR
)
where
import Import
-- to use Html into forms
import Yesod.Form.Nic (YesodNic, nicHtmlField)
instance YesodNic App
entryForm :: Form Article
entryForm = renderDivs $ Article
<$> areq textField "Title" Nothing
<*> areq nicHtmlField "Content" Nothing
-- The view showing the list of articles
getBlogR :: Handler Html
getBlogR = do
-- Get the list of articles inside the database.
articles <- runDB $ selectList [] [Desc ArticleTitle]
-- We'll need the two "objects": articleWidget and enctype
-- to construct the form (see templates/articles.hamlet).
(articleWidget, enctype) <- generateFormPost entryForm
defaultLayout $ do
$(widgetFile "articles")
postBlogR :: handler RepHtml
postBlogR = do
-- Get the list of articles inside the database.
articles <- runDB $ selectList [] [Desc ArticleTitle]
-- We'll need the two "objects": articleWidget and enctype
-- to construct the form (see templates/articles.hamlet).
(articleWidget, enctype) <- generateFormPost entryForm
defaultLayout $ do
$(widgetFile "articles")
my routes:
/static StaticR Static getStatic
/auth AuthR Auth getAuth
/favicon.ico FaviconR GET
/robots.txt RobotsR GET
/ HomeR GET POST
/echo/#Text EchoR GET
/mirror MirrorR GET POST
/blog BlogR GET POST
/blog/#ArticleId ArticleR GET
and my models:
User
ident Text
password Text Maybe
UniqueUser ident
Email
email Text
user UserId Maybe
verkey Text Maybe
UniqueEmail email
Article
title Text
content Html
deriving
-- By default this file is used in Model.hs (which is imported by Foundation.hs)
I think, you just have to fix your type signature for postBlogR to Handler RepHtml. Names starting with lower case letters are reserved for type variables in type signatures, so it cannot be deduced right here.

Why does yesod require authorisation here?

I have a problem with yesod and authorization.
I get to the login page when trying to view blog posts when not logged in.
That is not what I want.
I want to be able to view blog posts even when not logged in.
I have tried to fix it but nothing has worked.
Here is the relevant sections of the code:
mkMessage "Blog" "messages" "en"
mkYesod "Blog" [parseRoutes|
/ RootR GET
/blog BlogR GET POST
/blog/#EntryId EntryR GET POST
/auth AuthR Auth getAuth
|]
instance Yesod Blog where
approot = ApprootStatic "http://localhost:3000"
defaultLayout = defLayout
authRoute _ = Just $ AuthR LoginR
isAuthorized BlogR True = do
mauth <- maybeAuth
case mauth of
Nothing -> return AuthenticationRequired
Just (Entity _ user)
| isAdmin user -> return Authorized
| otherwise -> unauthorizedI MsgNotAnAdmin
isAuthorized (EntryR _) True = do
mauth <- maybeAuth
case mauth of
Nothing -> return AuthenticationRequired
Just _ -> return Authorized
isAuthorized _ _ = return Authorized
isAdmin :: User -> Bool
isAdmin user = userEmail user == "email#something.com"
instance YesodPersist Blog where
type YesodPersistBackend Blog = SqlPersist
runDB f = do
master <- getYesod
let pool = connPool master
runSqlPool f pool
type Form x = Html -> MForm Blog Blog (FormResult x, Widget)
instance RenderMessage Blog FormMessage where
renderMessage _ _ = defaultFormMessage
instance YesodNic Blog
instance YesodAuth Blog where
type AuthId Blog = UserId
loginDest _ = RootR
logoutDest _ = RootR
authHttpManager = httpManager
authPlugins _ = [authBrowserId]
getAuthId creds = do
let email = credsIdent creds
user = User email
res <- runDB $ insertBy user
return $ Just $ either entityKey id res
getRootR :: Handler RepHtml
getRootR = defaultLayout $ do
setTitleI MsgHomepageTitle
[whamlet|
<p>_{MsgWelcomeHomepage}
<p>
<a href=#{BlogR}>_{MsgSeeArchive}
|]
entryForm :: Form Entry
entryForm = renderDivs $ Entry
<$> areq textField (fieldSettingsLabel MsgNewEntryTitle) Nothing
<*> aformM (liftIO getCurrentTime)
<*> areq nicHtmlField (fieldSettingsLabel MsgNewEntryContent)
Nothing
getBlogR :: Handler RepHtml
getBlogR = do
muser <- maybeAuth
entries <- runDB $ selectList [] [Desc EntryPosted]
(entryWidget, enctype) <- generateFormPost entryForm
defaultLayout $ do
setTitleI MsgBlogArchiveTitle
[whamlet|
$if null entries
<p>_{MsgNoEntries}
$else
<ul>
$forall Entity entryId entry <- entries
<li>
<a href=#{EntryR entryId}>#{entryTitle entry}
$maybe Entity _ user <- muser
$if isAdmin user
<form method=post enctype=#{enctype}>
^{entryWidget}
<div>
<input type=submit value=_{MsgNewEntry}>
$nothing
<p>
<a href=#{AuthR LoginR}>_{MsgLoginToPost}
|]
postBlogR :: Handler RepHtml
postBlogR = do
((res, entryWidget), enctype) <- runFormPost entryForm
case res of
FormSuccess entry -> do
entryId <- runDB $ insert entry
setMessageI $ MsgEntryCreated $ entryTitle entry
redirect $ EntryR entryId
_ -> defaultLayout $ do
setTitleI MsgPleaseCorrectEntry
[whamlet|
<form method=post enctype=#{enctype}>
^{entryWidget}
<div>
<input type=submit value=_{MsgNewEntry}>
|]
-- comment form
commentForm :: EntryId -> Form Comment
commentForm entryId = renderDivs $ Comment
<$> pure entryId
<*> aformM (liftIO getCurrentTime)
<*> aformM requireAuthId
<*> areq textField (fieldSettingsLabel MsgCommentName) Nothing
<*> areq textareaField (fieldSettingsLabel MsgCommentText) Nothing
getEntryR :: EntryId -> Handler RepHtml
getEntryR entryId = do
(entry, comments) <- runDB $ do
entry <- get404 entryId
comments <- selectList [] [Asc CommentPosted]
return (entry, map entityVal comments)
muser <- maybeAuth
(commentWidget, enctype) <- generateFormPost (commentForm entryId)
defaultLayout $ do
setTitleI $ MsgEntryTitle $ entryTitle entry
[whamlet|
<h1>#{entryTitle entry}
<article>#{entryContent entry}
<section .comments>
<h1>_{MsgCommentsHeading}
$if null comments
<p>_{MsgNoComments}
$else
$forall Comment _entry posted _user name text <- comments
<div .comment>
<span .by>#{name}
<span .at>#{show posted}
<div .content>#{text}
<section>
<h1>_{MsgAddCommentHeading}
$maybe Entity _ user <- muser
<form method=post enctype=#{enctype}>
^{commentWidget}
<div>
<input type=submit value=_{MsgAddCommentButton}>
$nothing
<p>
<a href=#{AuthR LoginR}>_{MsgLoginToComment}
|]
How do i fix it?
Ok, I found the problem myself.
This line gave me problems:
<*> aformM requireAuthId
I also had to remove references to the user id field where it was being used in the application.
I don't know why this problem existed in the first place because the widget should only be shown when a user is logged in.
I would however like to have the user id of the user who posted the comment is there another way to do it without reintroducing the problem I had?
Or do you think this is an error within yesod?
(This would be a comment if I was allowed to)
I'm currently learning Yesod myself so this may not be the best way to do it, but you can avoid requireAuthId in the form and still record the user id in a persist field under the comment Entity if you make your form of a different type. Instead of
commentForm :: EntryId -> Form Comment
Which is a shorthand for
commentForm :: EntryId -> Html -> MForm Blog Blog (FormResult Comment, Widget)
You could rearrange the fields and have
commentForm :: EntryId -> Html -> MForm Blog Blog (FormResult (UserId -> Comment), Widget)
and supply the user id in the POST handler.
You could even strip down the form to just
commentForm :: Html -> MForm Blog Blog (FormResult (Text, Textarea), Widget)
commentForm = renderDivs $ (,)
<$> areq textField (fieldSettingsLabel MsgCommentName) Nothing
<*> areq textareaField (fieldSettingsLabel MsgCommentText) Nothing
and supply everything else in the POST handler.
Alternatively you could probably put generateFormPost under a case branching so the form isn't generated when you aren't logged in, instead of apparently merely not being shown.

Resources