[Haskell-cafe] web-routes and forms
Jeremy Shaw
jeremy at n-heptane.com
Tue Jan 25 05:42:34 CET 2011
Hello,
I think you should just be able to use showURL to convert the url type
into a String that you can use with blaze-html:
data SiteURL = Post_Login | etc
loginForm :: RoutedNomicServer Html
loginForm = do
actionURL <- showURL Post_Login
ok $ H.form ! A.method "POST" ! A.action actionURL ! enctype
"multipart/form-data;charset=UTF-8" $ do
H.label ! for "login" $ "Login"
input ! type_ "text" ! name "login" ! A.id "login" ! tabindex
"1" ! accesskey "L"
H.label ! for "password" $ "Password"
input ! type_ "text" ! name "password" ! A.id "password" !
tabindex "2" ! accesskey "P"
input ! type_ "submit" ! tabindex "3" ! accesskey "S" ! value
"Enter Nomic!"
Using the HSP stuff you can avoid the explicit call to showURL and do:
<form method=Post_Login enctype="multipart/form-data;charset=utf-8">
... </form>
But HSP is a fair bit more complex than blaze-html.
If blaze-html provide an HtmlT monad that was a real monad transformer
then you could do something similar using blaze. But they decided to
trade-off functionality for speed.
- jeremy
On Sat, Jan 22, 2011 at 3:19 PM, Corentin Dupont
<corentin.dupont at gmail.com> wrote:
> Hello Jeremy,
> Yes it would be fine to use solution 1, but I just don't figured how to mix
> web routes and forms.
>
> My forms are like that:
> loginForm :: RoutedNomicServer Html
> loginForm = do
> ok $ H.form ! A.method "POST" ! A.action "/postLogin" ! enctype
> "multipart/form-data;charset=UTF-8" $ do
> H.label ! for "login" $ "Login"
> input ! type_ "text" ! name "login" ! A.id "login" ! tabindex "1" !
> accesskey "L"
> H.label ! for "password" $ "Password"
> input ! type_ "text" ! name "password" ! A.id "password" ! tabindex
> "2" ! accesskey "P"
> input ! type_ "submit" ! tabindex "3" ! accesskey "S" ! value "Enter
> Nomic!"
>
> And are decoded using a FromData:
>
> instance FromData LoginPass where
> fromData = do
> login <- look "login" `mplus` (error "need login")
> password <- look "password" `mplus` (error "need password")
> return $ LoginPass login password
>
> How this can go inside web routes? I cannot pass the parameters in the URL
> (here login and password), can I?
>
> Thanks,
> Corentin
>
> On Sat, Jan 22, 2011 at 9:49 PM, Jeremy Shaw <jeremy at n-heptane.com> wrote:
>>
>> Hello,
>>
>> I believe you problem is because you are trying to use 'dir' inside
>> RouteT after you have already consumed and decode the path info using
>> implSite.
>>
>> There are two solutions here:
>>
>> 1. just use web-routes for all your URLs instead of using a mixture
>> of type-safe routes and 'dir'.
>> 2. put the calls to dir outside the call to implSite.
>>
>> For example, something like,
>>
>> simpleHTTP nullConf $ msum [ dir "Login" $ loginPage,
>> , dir "postLogin" $
>> postLogin
>> , implSite
>> "http://localhost:8000/" "" (nomicSite sh)
>> ]
>>
>> You to do that, you would also need to modified loginPage and
>> postLogin to not be in the RoutedNomicServer monad. Since they do not
>> appear to use the RouteT stuff anyway, that should not be hard ?
>>
>> But, personally, I would just choose option #1. Can you explain why
>> you thought it was better to mix the web-routes stuff with the 'dir'
>> style guards? Maybe there is a short coming in web-routes that needs
>> to be addressed ?
>>
>> - jeremy
>>
>> On Fri, Jan 21, 2011 at 2:33 PM, Corentin Dupont
>> <corentin.dupont at gmail.com> wrote:
>> > Hello Jeremy,
>> > I'm still trying to integrate web routes, but there is one thing I don't
>> > understand:
>> > how to deal with multiple forms?
>> >
>> > In my former application, each forms used to redirect to a subdirectory
>> > of
>> > the web site, and an appropriate handler was waiting there.
>> > But now with web routes I don't see how to do that.
>> > I've tried to push down the decision over subdirectories (with the guard
>> > "dir") inside the RouteT monad:
>> >
>> > type NomicServer = ServerPartT IO
>> > type RoutedNomicServer = RouteT PlayerCommand NomicServer
>> >
>> > nomicSite :: ServerHandle -> Site PlayerCommand (NomicServer Html)
>> > nomicSite sh = setDefault (Noop 0) Site {
>> > handleSite = \f url -> unRouteT (routedNomicHandle sh url)
>> > f
>> > , formatPathSegments = \u -> (toPathSegments u, [])
>> > , parsePathSegments = parseSegments fromPathSegments
>> > }
>> >
>> > routedNomicHandle :: ServerHandle -> PlayerCommand -> RoutedNomicServer
>> > Html
>> > routedNomicHandle sh pc = do
>> > d <- liftRouteT $ liftIO getDataDir
>> > msum [dir "Login" $ loginPage,
>> > dir "postLogin" $ postLogin,
>> > --nullDir >> fileServe [] d,
>> > dir "NewRule" $ newRule sh,
>> > dir "NewGame" $ newGameWeb sh,
>> > dir "Nomic" $ routedNomicCommands sh pc]
>> >
>> >
>> > routedNomicCommands :: ServerHandle -> PlayerCommand ->
>> > RoutedNomicServer
>> > Html
>> > routedNomicCommands sh (Noop pn) = nomicPageComm pn sh
>> > (return ())
>> > routedNomicCommands sh (JoinGame pn game) = nomicPageComm pn sh
>> > (joinGame game pn)
>> > routedNomicCommands sh (LeaveGame pn) = nomicPageComm pn sh
>> > (leaveGame pn)
>> > routedNomicCommands sh (SubscribeGame pn game) = nomicPageComm pn sh
>> > (subscribeGame game pn)
>> > routedNomicCommands sh (UnsubscribeGame pn game) = nomicPageComm pn sh
>> > (unsubscribeGame game pn)
>> > routedNomicCommands sh (Amend pn) = nomicPageComm pn sh
>> > (amendConstitution pn)
>> > routedNomicCommands sh (DoAction pn an ar) = nomicPageComm pn sh
>> > (doAction' an ar pn)
>> > routedNomicCommands sh (NewRule pn name text code) = nomicPageComm pn sh
>> > (submitRule name text code pn)
>> > routedNomicCommands sh (NewGame pn game) = nomicPageComm pn sh
>> > (newGame game pn)
>> >
>> >
>> > loginPage :: RoutedNomicServer Html
>> > loginPage = do
>> > l <- loginForm
>> > ok $ H.html $ do
>> > H.head $ do
>> > H.title (H.string "Login to Nomic")
>> > H.link ! rel "stylesheet" ! type_ "text/css" ! href
>> > "/static/css/nomic.css"
>> > H.meta ! A.httpEquiv "Content-Type" ! content
>> > "text/html;charset=utf-8"
>> > H.meta ! A.name "keywords" ! A.content "Nomic, game, rules,
>> > Haskell,
>> > auto-reference"
>> > H.body $ do
>> > H.div ! A.id "container" $ do
>> > H.div ! A.id "header" $ "Login to Nomic"
>> > H.div ! A.id "login" $ l
>> > H.div ! A.id "footer" $ "footer"
>> >
>> > loginForm :: RoutedNomicServer Html
>> > loginForm = do
>> > ok $ H.form ! A.method "POST" ! A.action "/postLogin" ! enctype
>> > "multipart/form-data;charset=UTF-8" $ do
>> > H.label ! for "login" $ "Login"
>> > input ! type_ "text" ! name "login" ! A.id "login" ! tabindex "1"
>> > !
>> > accesskey "L"
>> > H.label ! for "password" $ "Password"
>> > input ! type_ "text" ! name "password" ! A.id "password" !
>> > tabindex
>> > "2" ! accesskey "P"
>> > input ! type_ "submit" ! tabindex "3" ! accesskey "S" ! value
>> > "Enter
>> > Nomic!"
>> >
>> > postLogin :: RoutedNomicServer Html
>> > postLogin = do
>> > methodM POST -- only accept a post method
>> > mbEntry <- getData -- get the data
>> > case mbEntry of
>> > Nothing -> error $ "error: postLogin"
>> > Just (LoginPass login password) -> do
>> > mpn <- liftRouteT $ liftIO $ newPlayerWeb login password
>> > case mpn of
>> > Just pn -> do
>> > link <- showURL $ Noop pn
>> > seeOther link $ string "Redirecting..."
>> > Nothing -> seeOther ("/Login?status=fail" :: String) $ string
>> > "Redirecting..."
>> >
>> > launchWebServer :: ServerHandle -> IO ()
>> > launchWebServer sh = do
>> > putStrLn "Starting web server...\nTo connect, drive your browser to
>> > \"http://localhost:8000/Login\""
>> > simpleHTTP nullConf $ implSite "http://localhost:8000/" "" (nomicSite
>> > sh)
>> >
>> >
>> > But when I drive my browser to "http://localhost:8000/Login/", happstack
>> > tell me there is nothing here.
>> > Am I doing it right? If yes, I must have made a mistake.
>> > (as you can see I'm still far from putting in disgestive functors ;)
>> >
>> > If you need, the complete application can be found here (see file
>> > Web.hs):
>> > https://github.com/cdupont/Nomic
>> >
>> > Thanks,
>> > Corentin
>> >
>> > On Wed, Jan 19, 2011 at 5:12 PM, Corentin Dupont
>> > <corentin.dupont at gmail.com>
>> > wrote:
>> >>
>> >> Thanks Jeremy.
>> >> I had it to work now ;)
>> >>
>> >> Corentin
>> >>
>> >> On Tue, Jan 18, 2011 at 6:01 PM, Jeremy Shaw <jeremy at n-heptane.com>
>> >> wrote:
>> >>>
>> >>> Hello,
>> >>>
>> >>> trhsx will be installed in ~/.cabal/bin, so you will need to add that
>> >>> to your PATH.
>> >>>
>> >>> In order to use the demo code I provided you would need the latest
>> >>> happstack from darcs because it contains a few differences in the API.
>> >>> The code can be made to work with what is on hackage though.
>> >>>
>> >>> The submit issue is actually a bug in digestive-functors-blaze. The
>> >>> return type should be, Form m i e BlazeFormHtml (). jaspervdj is going
>> >>> to patch it and upload a new version.
>> >>>
>> >>> - jeremy
>> >>>
>> >>>
>> >>> On Thu, Jan 13, 2011 at 2:40 PM, Corentin Dupont
>> >>> <corentin.dupont at gmail.com> wrote:
>> >>> > Hello,
>> >>> >
>> >>> > I'm using the combination happstack + digestive-functors +
>> >>> > web-routes +
>> >>> > blazeHTML.
>> >>> > I'm not finding any examples on the net...
>> >>> >
>> >>> > I've tried to adapt your example (thanks):
>> >>> >
>> >>> > type NomicForm a = HappstackForm IO String BlazeFormHtml a
>> >>> >
>> >>> > demoForm :: NomicForm (Text, Text)
>> >>> > demoForm =
>> >>> > (,) <$> ((TDB.label "greeting: " ++> inputNonEmpty Nothing) <*
>> >>> > br)
>> >>> > <*> ((TDB.label "noun: " ++> inputNonEmpty Nothing) <*
>> >>> > br)
>> >>> > <* (submit "submit")
>> >>> > where
>> >>> > br :: NomicForm ()
>> >>> > br = view H.br
>> >>> > -- make sure the fields are not blank, show errors in line if
>> >>> > they are
>> >>> > inputNonEmpty :: Maybe Text -> NomicForm Text
>> >>> > inputNonEmpty v =
>> >>> > (inputText v `validate` (TD.check "You can not leave this
>> >>> > field
>> >>> > blank." (not . T.null)) <++ errors)
>> >>> >
>> >>> >
>> >>> > But I've got a problem on submit and inputText. I don't see how they
>> >>> > are
>> >>> > compatible with HappstackForm.
>> >>> > NomicForm a reduces to:
>> >>> > Form (ServerPartT IO) Input String BlazeFormHtml a
>> >>> >
>> >>> > whereas the type of submit is:
>> >>> >
>> >>> > submit :: Monad m
>> >>> >
>> >>> > => String -- ^ Text on the submit
>> >>> > button
>> >>> >
>> >>> > -> Form m String e BlazeFormHtml () -- ^ Submit button
>> >>> >
>> >>> >
>> >>> > Maybe I miss some instance?
>> >>> >
>> >>> > BTW, I also tried to execute your exemple, but I can't install some
>> >>> > packages.
>> >>> >
>> >>> >> cabal install digestive-functors-hsp
>> >>> >
>> >>> > cabal: Unknown build tool trhsx
>> >>> >
>> >>> > Whereas trhsx is in my PATH (under linux).
>> >>> >
>> >>> > You said I need the latest happstack from darcs, why?
>> >>> >
>> >>> > Cheers,
>> >>> > Corentin
>> >>> >
>> >>> > On Sun, Jan 9, 2011 at 8:36 PM, Jeremy Shaw <jeremy at n-heptane.com>
>> >>> > wrote:
>> >>> >>
>> >>> >> Hello,
>> >>> >>
>> >>> >> newRule also needs to have the type, RoutedNomicServer. The
>> >>> >> transformation of RoutedNomicServer into NomicServer is done in the
>> >>> >> handleSite function. Something like this:
>> >>> >>
>> >>> >>
>> >>> >> nomicSpec :: ServerHandle -> Site Route (ServerPartT IO Response)
>> >>> >> nomicSpec sh =
>> >>> >> Site { handleSite = \f url -> unRouteT (nomicSite sh
>> >>> >> url) f
>> >>> >> ...
>> >>> >>
>> >>> >> main =
>> >>> >> do ...
>> >>> >> simpleHTTP nullConf $ siteImpl (nomicSpec sh)
>> >>> >>
>> >>> >> Or something like that -- it's hard to tell exactly what is going
>> >>> >> on
>> >>> >> in your app based on the snippets you provided.
>> >>> >>
>> >>> >> Also, I highly recommend using digestive functors instead of
>> >>> >> formlets.
>> >>> >> It is the successor to formlets. Same core idea, better
>> >>> >> implementation
>> >>> >> and actively maintained.
>> >>> >>
>> >>> >> I have attached a quick demo of using:
>> >>> >>
>> >>> >> happstack+digestive-functors+web-routes+HSP
>> >>> >>
>> >>> >> To use it you will need the latest happstack from darcs plus:
>> >>> >>
>> >>> >> hsp
>> >>> >> web-routes
>> >>> >> web-routes-hsp
>> >>> >> web-routes-happstack
>> >>> >> web-routes-mtl
>> >>> >> digestive-functors
>> >>> >> digestive-functors-hsp
>> >>> >>
>> >>> >> I plan to clean up this example and document it better in the crash
>> >>> >> course for the upcoming release. Clearly things like the FormInput
>> >>> >> instance and the formPart function belong a library.
>> >>> >>
>> >>> >> let me know if you have more questions.
>> >>> >> - jeremy
>> >>> >>
>> >>> >> On Sat, Jan 8, 2011 at 6:44 PM, Corentin Dupont
>> >>> >> <corentin.dupont at gmail.com> wrote:
>> >>> >> > Hello,
>> >>> >> >
>> >>> >> > I have difficulties mixing web-routes and forms:
>> >>> >> > I have put routes in all my site, except for forms which remains
>> >>> >> > with
>> >>> >> > the
>> >>> >> > type ServerPartT IO Response.
>> >>> >> > How to make them work together?
>> >>> >> >
>> >>> >> > I have:
>> >>> >> > type NomicServer = ServerPartT IO
>> >>> >> > type RoutedNomicServer = RouteT PlayerCommand NomicServer
>> >>> >> >
>> >>> >> > newRule :: ServerHandle -> NomicServer Response
>> >>> >> > newRule sh = do
>> >>> >> > methodM POST -- only accept a post method
>> >>> >> > mbEntry <- getData -- get the data
>> >>> >> > case mbEntry of
>> >>> >> > Nothing -> error $ "error: newRule"
>> >>> >> > Just (NewRule name text code pn) -> do
>> >>> >> > html <- nomicPageComm pn sh (submitRule name text code
>> >>> >> > pn))
>> >>> >> > ok $ toResponse html
>> >>> >> >
>> >>> >> >
>> >>> >> > nomicPageComm :: PlayerNumber -> ServerHandle -> Comm () ->
>> >>> >> > RoutedNomicServer Html
>> >>> >> > nomicPageComm pn sh comm =
>> >>> >> > (..)
>> >>> >> >
>> >>> >> >
>> >>> >> > launchWebServer :: ServerHandle -> IO ()
>> >>> >> > launchWebServer sh = do
>> >>> >> > putStrLn "Starting web server...\nTo connect, drive your
>> >>> >> > browser
>> >>> >> > to
>> >>> >> > \"http://localhost:8000/Login\""
>> >>> >> > d <- liftIO getDataDir
>> >>> >> > simpleHTTP nullConf $ mconcat [dir "postLogin" $ postLogin,
>> >>> >> > fileServe [] d,
>> >>> >> > dir "Login" $ ok $ toResponse $
>> >>> >> > loginPage,
>> >>> >> > dir "NewRule" $ newRule sh,
>> >>> >> > dir "NewGame" $ newGameWeb sh,
>> >>> >> > dir "Nomic" $ do
>> >>> >> > html <- implSite
>> >>> >> > "http://localhost:8000/Nomic/" "" (nomicSite sh)
>> >>> >> > ok $ toResponse html
>> >>> >> > ]
>> >>> >> >
>> >>> >> >
>> >>> >> > The red line doesn't compile. I don't know how to transform a
>> >>> >> > RoutedNomicServer into a NomicServer.
>> >>> >> >
>> >>> >> > For the future I intend to use formlets: is these some examples
>> >>> >> > of
>> >>> >> > programs
>> >>> >> > using happstack + web-routes + formlets?
>> >>> >> >
>> >>> >> > Thanks,
>> >>> >> > Corentin
>> >>> >> >
>> >>> >> >
>> >>> >> >
>> >>> >> >
>> >>> >> > On Fri, Jan 7, 2011 at 5:10 PM, Jeremy Shaw
>> >>> >> > <jeremy at n-heptane.com>
>> >>> >> > wrote:
>> >>> >> >>
>> >>> >> >> Hello,
>> >>> >> >>
>> >>> >> >> The [(String, String)] argument is for adding query parameters.
>> >>> >> >>
>> >>> >> >> > encodePathInfo ["foo", "bar", "baz"] [("key","value")]
>> >>> >> >>
>> >>> >> >> "foo/bar/baz?key=value"
>> >>> >> >>
>> >>> >> >> Instead of showURL you would use showURLParams.
>> >>> >> >>
>> >>> >> >> hope this helps!d
>> >>> >> >> - jeremy
>> >>> >> >>
>> >>> >> >> On Fri, Jan 7, 2011 at 8:12 AM, Corentin Dupont
>> >>> >> >> <corentin.dupont at gmail.com> wrote:
>> >>> >> >> > Hello Jeremy,
>> >>> >> >> > I'm using Web routes with happstack.
>> >>> >> >> > I'm following this tutorial:
>> >>> >> >> >
>> >>> >> >> > http://tutorialpedia.org/tutorials/Happstack+type+safe+URLs.html
>> >>> >> >> >
>> >>> >> >> > But It seems out of synch with the latest version of
>> >>> >> >> > web-routes:
>> >>> >> >> > 0.23.2.
>> >>> >> >> > The haddock documentation seems out of date also:
>> >>> >> >> >
>> >>> >> >> > encodePathInfo :: [String] -> [(String, String)] -> String
>> >>> >> >> >
>> >>> >> >> > For example:
>> >>> >> >> >
>> >>> >> >> > encodePathInfo [\"foo\", \"bar\", \"baz\"]
>> >>> >> >> >
>> >>> >> >> > "foo/bar/baz"
>> >>> >> >> >
>> >>> >> >> > And I can't figure out what this [(String, String)] is for ;)
>> >>> >> >> >
>> >>> >> >> > Thanks,
>> >>> >> >> >
>> >>> >> >> > Corentin
>> >>> >> >> >
>> >>> >> >
>> >>> >> >
>> >>> >
>> >>> >
>> >>
>> >
>> >
>
>
More information about the Haskell-Cafe
mailing list